空间与非空间数据导入功能的实现

如题所述

传统的空间数据往往采用图层文件方式,文件方式对数据管理安全性较差,存在着属性和图形分开管理的问题,不适合网络共享发展的需要,同时也给数据的安全带来一定的隐患。随着技术的进步,逐渐将属性数据移植到数据库平台上,图形数据和属性数据一起存放在关系数据库中这已成为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命令行工具将Im⁃age文件读入数据库,手工完成文档的导入操作。另一种方法是使用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

温馨提示:答案为网友推荐,仅供参考