ardim-
传统的空间数据往往采用图层文件方式，文件方式对数据管理安全性较差，存在着属性和图形分开管理的问题，不适合网络共享发展的需要，同时也给数据的安全带来一定的隐患。随着技术的进步，逐渐将属性数据移植到数据库平台上，图形数据和属性数据一起存放在关系数据库中这已成为GIS发展的主流。
（一）非空间数据的导入
1.实现思路
在SQL Server中，对于小8 000个字节的图像数据可以用二进制型来表示，但通常要保存的一些影像图片都会大于8 000个字节。SQL Server提供了一种机制，能存储每行大到2 GB的二进制大对象（Binary Large Object，BLOB）。BLOB是在SQL Server中作为一个单一实体存储的二进制数据集合，主要用于保存多媒体对象，如图像、视频和声音，还可以存储程序，甚至是代码片断。在SQL Server中，BLOB可以是Text、Ntext或者Image数据类型。Image数据类型存储的是长度不确定的二进制数据，最大长度是2GB。
BLOB数据在SQL Server系统中的存储方式不同于普通的数据类型，对于普通类型的数据系统直接在用户定义的字段上存储数据值，而对于BLOB类型数据，系统开辟新的存储页面来存放这些数据，表中BLOB类型数据字段存放的仅是一个16个字节的指针，该指针指向存放该条记录的BLOB数据的页面。
SQL Server 2000 允许多种方式导入Word文档、图片、录像等非空间数据。一种方式是先创建一个Image数据类型列，用于存放数据，再使用Textcopy.exe命令行工具将Imu2043age文件读入数据库，手工完成文档的导入操作。另一种方法是使用Microsoft Active X Directory Object（ADO）Stream 接口编写导入代码。Adodb.Stream是ADO的Stream对象，提供存取二进制数据或者文本流，从而实现对流的读、写和管理等操作。具体思路（如图8-8）是在VB 6.0环境下先引用ADO类型库，通过声明一个作为 New Adodb.RecordSet的变量，新建一Adodb RecordSet 对象。在创建了这个RecordSet对象后，建立一个存储非空间数据的空表，包括“ID”、“Name”、“Shade”3个字段，其中“Shade”的数据类型为 Image，存储二进制的文档多媒体数据。再创建一使用Adodb.Stream新对象，使用其ADOStream.Open及ADOStream.LoadFromFile方法来完成二进制数据的存取，当然第二次添加时要检测文件是否已存在，并提示是否覆盖。同时ADO Field对象提供了AppendChunk方法将二进制文件写入大字段，当读取数据时使用GetChunk方法即可。
图8-8 非空间数据导入流程图
2.关键代码
＇*************查找路径目录下文件*************
Function FindFilesAPI（path As String，SearchStr As String）As Collection
If GetFileAttributes（path ＆DirName）And FILE_ATTRIBUTE_DIRECTORY Then
Dim FileName As String ＇文件名
Dim DirName As String ＇子目录名
Dim dirNames（）As String ＇目录数组
Dim nDir As Integer ＇当前路径的目录数
Dim i As Integer ＇循环计数器变量
Dim hSearch As Long ＇搜索句柄变量
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Set FindFilesAPI＝New Collection
If Right（path，1）＜＞＂＼＂Then path＝path ＆＂＼＂
＇搜索子目录
nDir＝0
ReDim dirNames（nDir）
Cont＝True
hSearch＝FindFirstFile（path ＆＂*＂，＇WFD）FindFirstFile为Windows的API函数
If hSearch ＜＞INVALID_HANDLE_VALUE Then
Do While Cont
DirName＝StripNulls（WFD.cFileName）＇去除文件名空格函数
If（DirName ＜＞＂.＂）And（DirName ＜＞＂..＂）Then
＇GetFileAttributes为Windows的API函数
dirNames（nDir）＝ DirName
nDir＝nDir + 1
ReDim Preserve dirNames（nDir）
End If
End If
＇FindNextFile为Windows的API函数
Cont＝FindNextFile（hSearch，WFD）＇获取下一个子目录
Loop
Cont＝FindClose（hSearch）＇FindClose为Windows的API函数
End If
＇遍历目录并累计文件总数
hSearch＝FindFirstFile（path ＆ SearchStr，WFD）
Cont＝True
If hSearch ＜＞INVALID_HANDLE_VALUE Then
While Cont
FileName＝StripNulls（WFD.cFileName）
If（FileName ＜＞＂.＂）And（FileName ＜＞＂..＂）Then
FindFilesAPI.add path ＆ FileName
End If
Cont＝FindNextFile（hSearch，WFD）＇获取下一个文件
Wend
Cont＝FindClose（hSearch）
End If
End Function
＇************数据存储*************
Sub writerd（ts As TextStream，Cn As ADODB.Connection，FileName As String）
Dim rd As Recordset，i As Long，pathName As String
Dim NameWanted As String，kzm As String
On Error Resume Next
Set rd＝New ADODB.Recordset
Call SplitPath（FileName，pathName，NameWanted，kzm）
rd.Open＂select*from＂＆DocTable＆＂where name=＇＂＆NameWanted ＆＂＇and kam=＇＂＆ kam ＆＂＂,Cn,adOpenDynamic,adLokReadOnly
If returnRdEof（rd）＝ False Then
i＝MsgBox（＂是否替换＂＆ NameWanted ＆ kzm ＆＂？＂，vbYesNo + vbQuestion）
If i＝6 Then
Cn.Execute（＂delete from＂＆ DocTable ＆＂where name＝＂＇＆ NameWanted ＆＇＂and kzm＝ ＇＂＆ kzm ＆＇＂＂）
ts.WriteLine NameWanted ＆ kzm ＆＂，入库，更新，＂＆ Now
＇************导入操作*************
AddLog＂数据更新＂，NameWanted ＆ kzm ＆，＂成功＂
Else
ts.WriteLine NameWanted ＆ kzm ＆＂，入库，没更新，＂＆ Now
AddLog＂数据更新＂，NameWanted ＆ kzm ＆，＂不成功＂
Exit Sub
End If
Else
ts.WriteLine Name Wanted＆kzm＆＂，入库，成功，＂＆ Now
AddLog＂数据入库＂，NameWanted ＆ kzm ＆＂，成功＂
End If
adoStream.Type ＝1＇指定或返回的数据类型adTypeBinary
adoStream.Open＇打开对象
adoStream.LoadFromFile FileName＇将对象的内容写到FileName文件中
将二进制文件写入大字段
Set rd＝New ADODB.Recordset
rd.CursorType＝adOpenKeyset
rd.LockType＝adLockOptimistic
rd.Open DocTable，Cn，，，adCmdTable
rd.AddNew
rd！name＝NameWanted
rd！kzm＝kzm
＇读取指定长度的二进制内容追加到Shad字段
rd！Shade.AppendChunk adoStream.Read
rd.Update
End Sub
Sub WriteDoc（ts As TextStream，TmpCn As ADODB.Connection，docPath As String，ByVal Pgaload As MSComctlLib.ProgressBar）
Dim tFilecol As Collection，i As Long
Screen.MousePointer＝vbHourglass
CreateShadeTable TmpCn
Set tFilecol＝FindFilesAPI（docPath，＂*.*＂）
＇显示进度
Pgaload.Min＝0
Pgaload.Max＝tFilecol.Count
＇导入操作
For i＝1 To tFilecol.Count＇- 1
writerd ts，TmpCn，tFilecol（i）
DoEvents
Pgaload＝i
Next
Screen.MousePointer＝vbDefault
End Sub
（二）空间数据的导入
1.基本概念
AO组件是ESRI公司推出的ArcGIS家族中应用程序ArcMap、ArcCatalog和ArcScene的开发平台，是基于微软的组件对象模型（COM）技术开发的一系列COM组件集。它提供了1 800多个单独的基于COM的组件，几百个具有良好文档说明的接口和数千个方法。AO组件提供了3种类型的类：抽象类（Abstract Class）、组件类（CoClass）和类（Class）。抽象类是不能被创建的，只能作为其他类的父类。类也不能被创建，但该类的对象能被其他类所创建，并作为该类的一个属性，或者被其他类的对象实例化。组件类可以被创建。
为了支持一个不依赖于开发语言工具的组件集，关于ArcObjects库所有相关的数据都被打包进Esricore.olb的类型库，一个类型库被作为一个接口定义语言（IDL）文件的二进制版本，是一系列COM对象和接口的集合，并被编译进一个形如OLB、DLL或OCX这样的二进制文件中。EsriCore.olb几乎包含了除扩展模块外的所有功能。
2.程序实现
为了减轻系统管理维护工作量，应用AO组件提供的强大的GIS功能，自行开发数据导入系统，空间数据的导入即是将已有的不同格式类型的空间数据导入至SQL Server中，转换成由SDE 进行管理的GeoDatabase 的要素类。空间数据一般为Shape、Coverage、DXF/DWG（AUTOCAD）、MIF等格式。要将这些文件转换并导入到GeoDatabase 中，主要用到IFeatureDataConverter接口的ConvertFeatureClass方法。总体步骤和关键代码如下。
1）创建工程，引用AO核心库。在VB工程中引用入一个EsriCore.olb就可以得到ArcObjects。
2）连接数据库。先通过ADO判断是否连接上SQL Server中的数据库。
3）创建一源工作空间工厂名对象（WorkSpaceName），根据导入数据的格式类型（如Coverage），则将EsriCore.ArcInfoWorkSpaceFactory.1和输入的IPropertySet分别赋给工作空间工厂名的属性WorkSpaceFactoryProgID和ConnectionProperties，通过工作空间的OPEN方法建立连接并获得要导入的要素类。
4）同理建立目标工作空间工厂名（SdeWorkSpaceFactory），然后在SdeWorkSpace新建一要素类，把新建的FeatureClassName 与SdeWorkSpace建立关联以备转换。
5）最后利用IFeatureDataConverter的转换函数ConvertFeatureClass来实现FeatureClass到GeoDatabase转换，如果数据库中该文件已入库判断是否覆盖。
6）写入工作日志。
＇**********************************************************************
＇过程cmdLoadFC2F_Click是程序点击实现模块，其中调用函数据Startzh（）实现输入属性及输出属性的设置功能并调用ConvertData函数，在ConvertData函数中利用ArcObjects的IFeatureDataConverter.ConvertFeatureClass方法完成数据转换。关键代码及说明如下：
＇**********************************************************************
Private Sub cmdLoadFC2FC_Click（）
……
＇通过ADO判断是否连接SQL Server获得数据连接
getConnectDb.Open GetConStr，Tuser，tpass
Set DETargetAdodb＝getConnectDb（txtTargetUser，txtTargetPassword）
……
＇判断导入数据格式为Converage、shape、mif还是AutoCAD的dxf格式
If m_InDataType ＝convDataTypeShapefile Then
……
＇调用GetInProp子过程，获得相应的输入参数，在该子过程中通过pPropertySet.SetProperty＂DATABASE＂，GetPathName（m_Infile，0）对不同输入数据格式的数据的连接，通过WorkspaceFactory.Open（IPropertySet，0），返回一个工作空间 Workspace，这样就可以建立连接了.通过 Workspace 就可以获得该工作空间的 FeatureDataset 或 Featureclass 以备转换。
Call GetInProp
Call GetoutProp＇获得相应的输出参数，在该子过程中定义SDE 连接属性
With pPropertySet
.SetProperty＂Server＂，txtServer＇定义SDE 服务
.SetProperty＂Instance＂，txtport＇定义SDE 端口
.SetProperty＂Database，＂sde＂＇数据库名称
.SetProperty＂user＂，txtTargetUser.Text＇用户名
.SetProperty＂password＂，txtTargetPassword.Text＇登录密码
.SetProperty＂version＂，＂sde.DEFAULT＂＇SDE 版本
End With
＇通过WorkspaceFactory.Open（IPropertySet，0）建立连接以备导入
……
End if
……
Startzh（）＇调用开始转换函数
……
End Sub
Function Startzh（）＇开始转换函数，进行相应参数设置
Dim pInPropertySet As esriCore.IpropertySet ＇定义输入属性
Set pInPropertySet＝New esriCore.PropertySet
Dim pOutPropertySet As esriCore.IpropertySet ＇定义输出属性
Set pOutPropertySet＝New esriCore.PropertySet
Dim sInName As String，sOutName As String，sOutFDName As String，tmpname As String，tmpstr As String ＇其他输入输出参数
Dim startt As String，endt As String
……
Dim strResult As String
strResult＝pLoad.ConvertData（pInPropertySet，_＇调用AO转换函数“ConvertData”sInName，m_InDataType，pOutPropertySet，sOutName，sOutFDName，m_OutDataType，ts）……
End Function
Public Function ConvertData（pInPropertySet As IPropertySet，_
sInName As String，_
eInDataType As convDataType，_
pOutPropertySet As IPropertySet，_
sOutName As String，_
sOutFDName As String，_
eOutDataType As convDataType，_
ts As TextStream）As String
eOutDataType＝convDataTypeGDB 定义转换后的类型为GDB要素
On Error GoTo fileerr
＇设置输入工作空间
Dim pInWorkspaceName As IWorkspaceName
Set pInWorkspaceName＝New WorkspaceName
pInWorkspaceName.connectionProperties＝pInPropertySet
pInWorkspaceName.WorkspaceFactoryProgID＝GetProgID（eInDataType）
＇设置输出工作空间
Dim pOutWorkspaceName As IWorkspaceName
Set pOutWorkspaceName＝New WorkspaceName
pOutWorkspaceName.connectionProperties＝pOutPropertySet
pOutWorkspaceName.WorkspaceFactoryProgID＝GetProgID（eOutDataType）
＇设置输入的数据集名称
Dim pInDatasetName As IDatasetName
Set pInDatasetName＝New FeatureClassName
pInDatasetName.name＝sInName
Set pInDatasetName.WorkspaceName＝pInWorkspaceName
＇设置输出的要素数据集名称
Dim pOutFDName As IDatasetName
If sOutFDName ＝＂＂Then
Set pOutFDName＝Nothing
Else
Set pOutFDName＝New FeatureDatasetName
Set pOutFDName.WorkspaceName＝pOutWorkspaceName ＇建立关联
pOutFDName.name＝sOutFDName
End If
＇设置输出的数据集名称
Dim pOutDatasetName As IDatasetName
Set pOutDatasetName＝New FeatureClassName
If Not pOutFDName Is Nothing Then
Dim pFCName As IFeatureClassName
Set pFCName＝pOutDatasetName
Set pFCName.FeatureDatasetName＝pOutFDName
End If
Set pOutDatasetName.WorkspaceName＝pOutWorkspaceName＇建立关联
pOutDatasetName.name＝sOutName
＇打开为获得字段定义的输入表
Dim pName As IName
Dim pInTable As ITable
Set pName＝pInDatasetName
Set pInTable＝pName.Open
＇使字段名有效并报告错误
Dim pInFields As IFields
Set pInFields＝pInTable.Fields
Dim pFieldCheck As IFieldChecker
Set pFieldCheck＝New FieldChecker
Dim pOutFields As IFields
Dim pEnumFieldError As IEnumFieldError
pFieldCheck.Validate pInFields，pEnumFieldError，pOutFields
If Not pEnumFieldError Is Nothing Then
Dim strFldErr As String
strFldErr ＝＂有些字段将给新名称：＂
Dim pFieldError As IFieldError
Set pFieldError＝pEnumFieldError.Next
Do Until pFieldError Is Nothing
Dim pInField As IField
Dim pOutField As IField
Set pInField＝pInFields.Field（pFieldError.FieldIndex）
Set pOutField＝pOutFields.Field（pFieldError.FieldIndex）
Dim pFieldEdit As IFieldEdit
Set pFieldEdit＝pOutField
＇pFieldEdit.name ＝＂［＂＆ pInField.name ＆＂］＂
pFieldEdit.AliasName ＝＂［＂＆ pInField.name ＆＂］＂
Set pOutField＝pFieldEdit
strFldErr＝strFldErr ＆ vbNewLine ＆_
＂［＂＆ pOutField.name ＆＂］＂＆ vbTab ＆＂原因：［＂＆ pInField.name＆＂］＂＆_
GetFieldError（pFieldError.FieldError）
Set pFieldError＝pEnumFieldError.Next
Loop
strFldErr＝strFldErr ＆ vbNewLine ＆ vbNewLine ＆＂继续吗？＂
Dim iContinue As Integer
iContinue＝vbYes MsgBox（strFldErr，vbYesNo，＂字段 错误＂）
If iContinue＝vbNo Then
ConvertData ＝＂转换取消＂
Exit Function
End If
End If
如果转换为一个要素类建立输出几何定义
通过输出字段跳转寻找几何字段
Dim i As Long
Dim pGeoField As IField
For i＝0 To pOutFields.FieldCount
If pOutFields.Field（i）.Type＝esriFieldTypeGeometry Then
Set pGeoField＝pOutFields.Field（i）
Exit For
End If
Next i
获得几何字段的几何定义
Dim pOutFCGeoDef As IGeometryDef
Set pOutFCGeoDef＝pGeoField.GeometryDef
给出几何定义的空间索引的格子数和格子尺寸
Dim pOutFCGeoDefEdit As IGeometryDefEdit
Set pOutFCGeoDefEdit＝pOutFCGeoDef
pOutFCGeoDefEdit.GridCount＝1
pOutFCGeoDefEdit.GridSize（0）＝ DefaultIndexGrid（pInTable）
Set pOutFCGeoDefEdit.SpatialReference＝ProjMap_Arcobject（＂wgs＂，0，0）
＇执行转换
Dim pConverter As IFeatureDataConverter
Set pConverter＝New FeatureDataConverter
＇设置进度条
Set frmLoadToGDB.m_ActionObj＝pConverter
frmLoadToGDB.Show vbModeless
DoEvents
Dim pEnumErrors As IEnumInvalidObject
＇转换为要素类
Set pEnumErrors＝pConverter.ConvertFeatureClass（pInDatasetName，Nothing，pOutFDName，pOutDatasetName，pOutFCGeoDef，pOutFields，＂＂，1000，0）
＇如果未完全转换成功，显示错误报告
Dim pErrInfo As IInvalidObjectInfo
Set pErrInfo＝pEnumErrors.Next
If pErrInfo Is Nothing Then
ConvertData ＝＂转换完毕＂
Else
Load frmReport
frmReport.Caption ＝＂错误对象＂
frmReport.Visible＝True
Do Until pErrInfo Is Nothing
frmReport.lstReport.AddItem pErrInfo.InvalidObjectID ＆ vbTab ＆ pErrInfo.ErrorDescription
Set pErrInfo＝pEnumErrors.Next
Loop
ConvertData ＝＂转换出现错误＂
End If
Set pInWorkspaceName＝Nothing
ts.WriteLine sOutName ＆＂，入库，成功，＂＆ Now
AddLog＂数据入库＂，sOutName ＆，＂成功＂
Exit Function
fileerr：
ConvertData ＝＂源文件可能不是有效文件＂＆ vbNewLine ＆＂请检查＂
ts.WriteLine sOutName ＆＂，文件有问题，不成功，＂＆ Now
AddLog＂数据入库＂，sOutName ＆，＂不成功＂
End Function
分享好知识！