📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "通过Engine打开表格的例子"
ClientHeight = 4755
ClientLeft = 60
ClientTop = 450
ClientWidth = 8850
LinkTopic = "Form1"
ScaleHeight = 4755
ScaleWidth = 8850
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command1
Caption = "关于..."
Height = 525
Left = 6285
TabIndex = 9
Top = 75
Width = 1440
End
Begin VB.CommandButton OpenTableFromAccess
Caption = "从Access数据库中打开表---------DataSourcesOleDB "
Height = 495
Left = 5505
TabIndex = 8
Top = 1485
Width = 3090
End
Begin VB.ComboBox cmbFields
Height = 315
Left = 60
Style = 2 'Dropdown List
TabIndex = 6
Top = 840
Width = 4965
End
Begin VB.ListBox lstValue
Height = 3375
Left = 45
TabIndex = 5
Top = 1275
Width = 4980
End
Begin VB.CommandButton OpenFromEnterpriseDatabase
Caption = "从企业级数据库中打开表---------DataSourcesOleDB "
Height = 495
Left = 5505
TabIndex = 3
Top = 2220
Width = 3090
End
Begin VB.CommandButton OpenFromSde
Caption = "从Sde中打开表---------DataSourcesGDB "
Height = 495
Left = 5505
TabIndex = 2
Top = 3705
Width = 3090
End
Begin VB.CommandButton OpenFromPersonalGeodatabase
Caption = "从PersonalGeodatabase中打开表---------DataSourcesGDB "
Height = 495
Left = 5505
TabIndex = 1
Top = 2970
Width = 3090
End
Begin VB.CommandButton OpenFromFolder
Caption = "从文件夹中打开Table表（dBase）---------DataSourcesFile"
Height = 495
Left = 5505
TabIndex = 0
Top = 690
Width = 3090
End
Begin VB.Label Label2
Caption = "字段名："
Height = 300
Left = 90
TabIndex = 7
Top = 480
Width = 2910
End
Begin VB.Label Label1
Caption = "以各种方式打开表，通过ITable来获取这些表的信息"
Height = 360
Left = 30
TabIndex = 4
Top = 60
Width = 4755
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_Table As ITable
Private Sub DisplayTable(pTable As ITable)
'获取字段集合
Dim pFields As IFields
Set pFields = pTable.Fields
Dim lFieldCount As Long
Dim intFieldIndex As Integer
Dim pField As IField
lFieldCount = pFields.FieldCount
'显示表中的字段信息
cmbFields.Clear
For intFieldIndex = 0 To lFieldCount - 1
Set pField = pFields.Field(intFieldIndex)
If (pField.Name <> "Shape" And pField.Name <> "SHAPE") Then
cmbFields.AddItem pField.Name
End If
Next
If cmbFields.ListCount > 0 Then
cmbFields.ListIndex = 0
End If
End Sub
Private Function OpenTableFromFolder(strTableFolder As String, strTableName As String) As ITable
'目的：从文件夹中打开dBase表格
'作者：张伟锋 日期：05年1月24日 最后修改日期：05年1月24日
Dim pWorkspace As IWorkspace
Dim pWksFact As IWorkspaceFactory
Dim pFWorkspace As IFeatureWorkspace
Set pWksFact = New ShapefileWorkspaceFactory
Set pWorkspace = pWksFact.OpenFromFile(strTableFolder, 0)
Set pFWorkspace = pWorkspace
Set OpenTableFromFolder = pFWorkspace.OpenTable(strTableName)
End Function
Private Function OpenTableFromAccessDatabase(strConnection As String, strTableName As String) As ITable
'目的：从Access数据库中打开表
'作者：张伟锋 日期：05年1月25日 最后修改日期：05年1月25日
Dim pWksFact As IWorkspaceFactory
Dim pWorkspace As IWorkspace
Dim pFWorkspace As IFeatureWorkspace
'创建WorkspaceFactory，并且创建Workspace,并获取IFeatureWorkspace
Set pWksFact = New AccessWorkspaceFactory
Set pWorkspace = pWksFact.OpenFromFile(strConnection, 0)
Set pFWorkspace = pWorkspace
'打开Table表
Set OpenTableFromAccessDatabase = pFWorkspace.OpenTable(strTableName)
End Function
Private Function OpenTableByOLEDB(strConnection As String, strTableName As String) As ITable
'目的：从企业数据库中打开表，本例以SQL Server数据库为例
'作者：张伟锋 日期：05年1月24日 最后修改日期：05年1月24日
Dim pPropSet As IPropertySet
'创建属性对象
Set pPropSet = New PropertySet
pPropSet.SetProperty "CONNECTSTRING", strConnection
'创建WorkspaceFactory，并且创建Workspace
Dim pWksFact As IWorkspaceFactory
Dim pWorkspace As IWorkspace
Dim pFWorkspace As IFeatureWorkspace
Set pWksFact = New OLEDBWorkspaceFactory
Set pWorkspace = pWksFact.Open(pPropSet, 0)
Set pFWorkspace = pWorkspace
'打开Table表
Set OpenTableByOLEDB = pFWorkspace.OpenTable(strTableName)
End Function
Private Function OpenTableBySDE(strTableName As String, Server As String, Instance As String, User As String, _
Password As String, Optional Database As String = "", _
Optional version As String = "SDE.DEFAULT") As ITable
'目的：从sde中打开表，本例以SQL Server数据库为例
'作者：张伟锋 日期：05年1月25日 最后修改日期：05年1月25日
On Error GoTo EH
Set OpenTableBySDE = Nothing
Dim pPropSet As IPropertySet
Dim pSdeFact As IWorkspaceFactory
Dim pWorkspace As IWorkspace
Dim pFWorkspace As IFeatureWorkspace
'设置PropertySet的属性
Set pPropSet = New PropertySet
With pPropSet
.SetProperty "SERVER", Server
.SetProperty "INSTANCE", Instance
.SetProperty "DATABASE", Database
.SetProperty "USER", User
.SetProperty "PASSWORD", Password
.SetProperty "VERSION", version
End With
'创建WorkspaceFactory，并且创建Workspace,并获取IFeatureWorkspace
Set pSdeFact = New SdeWorkspaceFactory
Set pWorkspace = pSdeFact.Open(pPropSet, 0)
Set pFWorkspace = pWorkspace
'打开Table表
Set OpenTableBySDE = pFWorkspace.OpenTable(strTableName)
Exit Function
EH:
MsgBox Err.Description, vbInformation, "openSDEWorkspace"
End Function
Private Sub cmbFields_Click()
Dim strFieldName As String
Dim pFields As IFields
Dim lFieldIndex As Long
Dim pCursor As ICursor
Dim pRow As IRow
' Dim lRowCount As Long
' Dim lRowIndex As Integer
strFieldName = cmbFields.List(cmbFields.ListIndex)
Set pFields = m_Table.Fields
lFieldIndex = pFields.FindField(strFieldName)
' lRowCount = m_Table.RowCount(Nothing)
Debug.Print m_Table.HasOID
Set pCursor = m_Table.Search(Nothing, False)
'显示字段值信息
lstValue.Clear
Set pRow = pCursor.NextRow
Do While (Not pRow Is Nothing)
lstValue.AddItem pRow.Value(lFieldIndex)
Set pRow = pCursor.NextRow
Loop
End Sub
Private Sub Command1_Click()
Form2.Show
End Sub
Private Sub OpenFromEnterpriseDatabase_Click()
Dim strConnectionString As String
Dim strTableName As String
strConnectionString = "Provider=SQLOLEDB.1;User ID=sa;Password=110;Initial Catalog=traffic;Data Source=JOYCE"
strTableName = "JT_LINE_INFO"
Set m_Table = OpenTableByOLEDB(strConnectionString, strTableName)
If m_Table Is Nothing Then Exit Sub
Call DisplayTable(m_Table)
End Sub
Private Sub OpenFromFolder_Click()
Dim strTableFolder As String
Dim strTableName As String
strTableFolder = App.Path
strTableName = "区县.dbf"
Set m_Table = OpenTableFromFolder(strTableFolder, strTableName)
If m_Table Is Nothing Then Exit Sub
Call DisplayTable(m_Table)
End Sub
Private Sub OpenFromPersonalGeodatabase_Click()
Dim strConnection As String
Dim strTableName As String
strConnection = App.Path & "\test.mdb"
strTableName = "区县"
Set m_Table = OpenTableFromAccessDatabase(strConnection, strTableName)
If m_Table Is Nothing Then Exit Sub
Call DisplayTable(m_Table)
End Sub
Private Sub OpenFromSde_Click()
Dim strTableName As String
strTableName = "TAXI_COMOANY"
Set m_Table = OpenTableBySDE(strTableName, "JOYCE", "5151", "sde", "110", "sde")
If m_Table Is Nothing Then Exit Sub
Call DisplayTable(m_Table)
End Sub
Private Sub OpenTableFromAccess_Click()
Dim strConnection As String
Dim strTableName As String
strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\test\ArcEngine\OpenTable\test.mdb;"
strTableName = "区县"
Set m_Table = OpenTableByOLEDB(strConnection, strTableName)
If m_Table Is Nothing Then Exit Sub
Call DisplayTable(m_Table)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -