📄 frmsub.frm
字号:
VERSION 5.00
Begin VB.Form frmSub
Caption = "Form1"
ClientHeight = 6405
ClientLeft = 60
ClientTop = 450
ClientWidth = 6825
LinkTopic = "Form1"
ScaleHeight = 6405
ScaleWidth = 6825
Begin VB.CommandButton Command2
Caption = "加载sde"
Height = 495
Left = 3840
TabIndex = 17
Top = 5640
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "显示"
Height = 495
Left = 1920
TabIndex = 16
Top = 5640
Width = 1215
End
Begin VB.ComboBox Combo1
Height = 300
Left = 2400
TabIndex = 14
Top = 4320
Width = 3855
End
Begin VB.Frame frmsde
Caption = "SDE选项"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3495
Left = 0
TabIndex = 0
Top = 0
Width = 6975
Begin VB.TextBox Txtservice
Height = 375
Left = 4560
TabIndex = 7
Text = "esri_sde"
Top = 360
Width = 1935
End
Begin VB.TextBox Txtserver
Height = 375
Left = 1320
TabIndex = 6
Text = "lhb"
Top = 360
Width = 1935
End
Begin VB.TextBox Txtdb
Height = 375
Left = 1320
TabIndex = 5
Text = "upgis"
Top = 960
Width = 1935
End
Begin VB.TextBox Txtuser
Height = 375
Left = 1320
TabIndex = 4
Top = 1680
Width = 1935
End
Begin VB.TextBox Txtpassword
Height = 375
Left = 4560
TabIndex = 3
Top = 1680
Width = 1935
End
Begin VB.TextBox Txtversion
Height = 375
Left = 4560
TabIndex = 2
Top = 960
Width = 1935
End
Begin VB.CommandButton cmdconnect
Caption = "测试连接(&T)"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3840
TabIndex = 1
Top = 2640
Width = 1815
End
Begin VB.Label Label3
Caption = "服 务:"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3480
TabIndex = 13
Top = 360
Width = 975
End
Begin VB.Label Label2
Caption = "服务器:"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 12
Top = 360
Width = 975
End
Begin VB.Label Label4
Caption = "数据库:"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 11
Top = 960
Width = 975
End
Begin VB.Label Lbluser
Caption = "用 户:"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 10
Top = 1800
Width = 975
End
Begin VB.Label Lblpassword
Caption = "密 码:"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3480
TabIndex = 9
Top = 1680
Width = 975
End
Begin VB.Label Lblversion
Caption = "版 本:"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3480
TabIndex = 8
Top = 960
Width = 975
End
End
Begin VB.Label Label1
Caption = "入库栅格图像列表"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 15
Top = 4200
Width = 1815
End
End
Attribute VB_Name = "frmSub"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'设计思路;通过验证sde连接，之后把所有栅格图像显示在combo1上。点击按钮后就能显示图像
Option Explicit
Public strserver As String
Public strservice As String
Public strDB As String
Public struser As String
Public strPWD As String
Public strversion As String
Public Property Let Application(ByRef pApp As IApplication)
Set m_pApp = pApp
End Property
Public Sub cmdconnect_Click()
On Error GoTo errortip:
'以上为sde的信息
strserver = Txtserver.Text
strservice = Txtservice.Text
strDB = Txtdb.Text
struser = Txtuser.Text
strPWD = Txtpassword.Text
strversion = Txtversion.Text
Dim psdeppset As IPropertySet
Set psdeppset = New PropertySet
'设置信息
With psdeppset
.SetProperty "server", strserver
.SetProperty "instance", strservice
.SetProperty "user", struser
.SetProperty "database", strDB
.SetProperty "password", strPWD
.SetProperty "version", strversion
End With
Dim pFact As IWorkspaceFactory
Set pFact = New SdeWorkspaceFactory
Dim ws As IWorkspace
Set ws = pFact.Open(psdeppset, 0) 'ws是一个打开的数据库，传回的一个量
If ws Is Nothing Then
MsgBox "SDE连接失败!", vbInformation, "测试结果"
' cmdinput.Enabled = False
Else
MsgBox "SDE连接成功!", vbInformation, "测试结果"
End If
Exit Sub
errortip:
MsgBox "出错"
End Sub
Private Sub Command1_Click()
Dim pprop As IPropertySet
Set pprop = New PropertySet
With pprop '连接属性设置
.SetProperty "server", strserver
.SetProperty "instance", strservice
.SetProperty "user", struser
.SetProperty "database", strDB
.SetProperty "password", strPWD
.SetProperty "version", strversion
End With
Dim pFact As IWorkspaceFactory
Dim mfact As IWorkspaceFactory
Set mfact = New RasterWorkspaceFactory
Set pFact = New SdeWorkspaceFactory '实例化
Dim ws As IWorkspace
Set ws = pFact.Open(pprop, 0) '连接SDE数据库
Dim penumdataset As IEnumDataset '查询esriDTRasterDataset数据集枚举,检索是否已存在该数据集
Set penumdataset = ws.Datasets(esriDTRasterDataset)
Dim mrdataset As IRasterDataset
Set mrdataset = penumdataset.Next
Dim mdataset As IDataset
Do While Not mrdataset Is Nothing
Set mdataset = mrdataset
MsgBox mdataset.Name
Combo1.AddItem mdataset.Name
Set mrdataset = penumdataset.Next
Loop
End Sub
Private Sub Command2_Click()
Dim pRasterData As IRasterDataset
Set pRasterData = GetRasterFromSDE(strserver, strservice, strDB, struser, strPWD, "ABC")
MsgBox "A"
AddRasterLayer pRasterData
''
' Dim pSDEWs As IWorkspaceName
' Dim pSDEPropertySet As IPropertySet
' Dim pSDERasterDataset As IRasterDataset
' Dim pDsName As IDatasetName
' Dim pName As IName
' Dim sQualifiedName As String
''
'
' ' Get connection propertyset
' Set pSDEPropertySet = New PropertySet
' With pSDEPropertySet
' .SetProperty "server", strserver
' .SetProperty "instance", strservice
' .SetProperty "user", struser
' .SetProperty "database", strDB
' .SetProperty "password", strPWD
' .SetProperty "version", strversion
' End With
'
' ' **************************************
'' MsgBox "connection propertyset is ok"
'
' ' Get workspacename
' Set pSDEWs = New WorkspaceName
' pSDEWs.ConnectionProperties = pSDEPropertySet
' pSDEWs.WorkspaceFactoryProgID = "esricore.sdeworkspacefactory"
'
' ' **************************************
'' MsgBox "workspacename is ok"
'
' '??????????????????????????????下面是何意
' ' Get qualified ArcSDE raster name
'' If Len(strDB) > 0 Then
'' sQualifiedName = strDB + "." + struser + "." + "ABC"
'' Else
' sQualifiedName = struser + "." + "ABC"
'' End If
'
'
' ' Get raster dataset name
'
' Set pDsName = New RasterDatasetName
' pDsName.Name = sQualifiedName
' Set pDsName.WorkspaceName = pSDEWs
'
'
' Set pName = pDsName
'
'
'
' ' Open ArcSDE raster dataset
' Set pSDERasterDataset = pName.Open
' MsgBox "AAA"
'
' Set pRasterData = pSDERasterDataset
'' Cleanup
'
' Set pSDEWs = Nothing
' Set pSDERasterDataset = Nothing
' Set pSDEPropertySet = Nothing
' Set pName = Nothing
' Set pDsName = Nothing
'
' AddRasterLayer pRasterData
End Sub
Private Sub Form_Load()
strserver = Txtserver.Text
strservice = Txtservice.Text
strDB = Txtdb.Text
struser = Txtuser.Text
strPWD = Txtpassword.Text
strversion = Txtversion.Text
Txtserver.Text = "lhb"
Txtservice.Text = "esri_sde"
Txtdb.Text = "upgis"
Txtdb.ToolTipText = "本选项可以不进行输入"
Txtversion.Text = "sde.DEFAULT"
'If cmbRaster.Text <> "" Then
'cmdrefference.Enabled = False
'End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -