VB中超长OLE数据库字段的操纵方法
作者：程毅
现在，多数数据库都支持OLE类型的数据库字段，利用这种字段，可以存放Word文档和Excel表格等任何种类的文件，而且，使用OLEAutomation方法，可直接激活文件的原始编辑器，也就是它们的OLEServer。这样，我们就有了一个安全可靠的保存各类重要文件的方法。但是，因为这些文件常常是很大，几十K，甚至上百K，就要求我们有一种切实可行的操纵方法，实现对这种字段的存取。
VB为程序员提供了数据库控件Data，使用它，可以方便地操纵数据库，如浏览数据库，增加新记录，编辑且更新现存的记录，删除记录等。但这些功能是对普通的数据库而言的，当数据库中有超长的OLE字段时，仅仅使用Data则不能完成上述操作了。此时，需要解决二个问题：第一，如何存取OLE字段中的内容；第二，如何同步存取Data控件所显示记录中OLE字段与其它字段的内容。
针对上述二个问题，介绍一种解决方法。
第一、如何存取OLE字段中的内容。
VB提供了文件存取的方法，利用这种方法我们可以方便地存取OLE数据库字段。下面给出的函数就利用文件存取的方法，实现了对OLE数据库字段的存取操作。这里，使用Get、Put、Seek等语句，以二进制形式打开一个临时文件，把它作为OLE字段与OLE控件的中间缓冲器，当从OLE字段向OLE控件中读数据时，先将OLE字段的数据写入临时文件，再将临时文件用OLE控件的OLE_LOAD_FROM_FILE动作插入OLE控件；当把OLE控件的数据写入OLE字段时，则先用OLE控件的OLE_SAVE_TO_FILE动作，将其存入临时文件，再将临时文件写入OLE字段。这里，以固定块长的方式读写OLE字段和临时文件。这些函数都没有错误检测部分。
下面所有例子使用的都是Access2.0数据库。
变量声明：
OptionExplicit
ConstOLE_SAVE_TO_FILE=11'OLEAction常量
ConstOLE_LOAD_FROM_FILE=12'OLEAction常量
ConstCHUNK_SIZE=32000'文件读写块的大小
下面的函数将Access1.x数据库中OLE字段的内容取出并插入OLE2控件中。
FunctionAccessFieldToOLE
(oleObjectAsControl,fdObjectAsField)
DimeErrorAsInteger
DimiFileNumberAsInteger
DimwOffsetToObjectAsInteger
iFileNumber=FreeFile
'获取文件号
OpenApp.Path&"OLE.TMP"ForBinaryAsiFileNumber
'创建临时文件
eError=FieldToFileStream(iFileNumber,fdObject)
'将字段的内容写到文件中
GetiFileNumber,3,wOffsetToObject
'获得Object的偏移地址
SeekiFileNumber,wOffsetToObject+1
'到object的起始位置
oleObject.FileNumber=iFileNumber
'将OLEcontrol指向临时文件
oleObject.Action=OLE_LOAD_FROM_FILE
'从文件中取出OLEobject
CloseiFileNumber
'关闭临时文件
KillApp.Path&"OLE.TMP"
'删除临时文件
AccessFieldToOLE=0
'返回
EndFunction
下面的函数将OLE字段中的内容写到临时文件中。
FunctionFieldToFileStream
(iFileNumberAsInteger,fdObjectAsField)AsInteger
DimsChunkHolderAsString
DimlChunkCountAsLong
DimlChunkRemainderAsLong
DimIAsLong
lChunkCount=fdObject.FieldSize()CHUNK_SIZE
'获得文件的块数
lChunkRemainder=fdObject.FieldSize()ModCHUNK_SIZE
'整块后余下的数据
ForI=0TolChunkCount-1
sChunkHolder=fdObject.GetChunk
(I*CHUNK_SIZE,CHUNK_SIZE)
'取一块
PutiFileNumber,,sChunkHolder
'将块写入临时文件
Next
IflChunkRemainder>0Then
sChunkHolder=fdObject.GetChunk
(lChunkCount*CHUNK_SIZE,lChunkRemainder)
'取余下的数据
PutiFileNumber,,sChunkHolder
'将其写入临时文件
EndIf
FieldToFileStream=0
'返回
EndFunction
下面的函数将OLE2数据库字段的内容取出并插入OLE2控件中。
FunctionFieldToOLE
(oleObjectAsControl,fdObjectAsField)
DimeErrorAsInteger
DimiFileNumberAsInteger
iFileNumber=FreeFile
'获取文件号
OpenApp.Path&"OLE.TMP"ForBinaryAsiFileNumber
'创建临时文件
eError=FieldToFileStream(iFileNumber,fdObject)
'将字段的内容写到临时文件中
SeekiFileNumber,1
'到object的起始位置
oleObject.FileNumber=iFileNumber
'OLE控件指向临时文件
oleObject.Action=OLE_LOAD_FROM_FILE
'从文件中取出OLEobject
CloseiFileNumber
'关闭临时文件
KillApp.Path&"OLE.TMP"
'删除临时文件
FieldToOLE=0
'返回
EndFunction
下面的函数将临时文件写入数据库的OLE2字段中。
FunctionFileStreamToField
(iFileNumberAsInteger,fdObjectAsField)AsInteger
DimsChunkHolderAsString
DimlChunkCountAsLong
DimlChunkRemainderAsLong
DimIAsLong
sChunkHolder=Space$(CHUNK_SIZE)
'临时存贮块
lChunkCount=(LOF(iFileNumber)-Seek(iFileNumber)+1)
CHUNK_SIZE'取块数
lChunkRemainder=(LOF(iFileNumber)-Seek
(iFileNumber)+1)ModCHUNK_SIZE
'取整块后余下的数据
ForI=1TolChunkCount
GetiFileNumber,,sChunkHolder
'从文件中取出一块
fdObject.AppendChunk(sChunkHolder)
'将块写入字段中
Next
IflChunkRemainder>0Then
sChunkHolder=Space$(lChunkRemainder)
'临时存贮块
GetiFileNumber,,sChunkHolder
'取出该块
fdObject.AppendChunk(sChunkHolder)
'写入字段中
EndIf
FileStreamToField=0
'返回
EndFunction
下面的函数将OLE2Object从OLE2控件中取出，并存入数据库字段中。
FunctionOLEToField(oleObjectAsControl,
fdObjectAsField)AsInteger
DimeErrorAsInteger
DimiFileNumberAsInteger
iFileNumber=FreeFile
'获取文件号
OpenApp.Path&"OLE.TMP"ForBinaryAsiFileNumber
'创建临时文件
oleObject.FileNumber=iFileNumber
'OLE控件指向临时文件
oleObject.Action=OLE_SAVE_TO_FILE
'将字段的内容写到临时文件中
SeekiFileNumber,1
'到object的起始位置
fdObject=""清空OLE2字段
eError=FileStreamToField(iFileNumber,fdObject)
'将文件写入OLE2字段中
CloseiFileNumber
'关闭临时文件
KillApp.Path&"OLE.TMP"
'删除临时文件
OLEToField=0'返回
EndFunction
上述函数的调用方法十分简单，下面的两个子程序给出了调用例子。
将OLE2字段中的内容取出并插入OLE控件中
SubGetOLEObject()
DimeErrorAsInteger
'将OLE字段File_Cont中的内容取出并插入OLE控件OLE1中
eError=FieldToOLE(OLE1,tbOLEObjects("File_Cont"))
EndSub
将OLE2控件中的内容写入OLE2字段
SubPutOLEObject()
DimeErrorAsInteger
tbOLEObjects.Edit'修改OLEObjects的工作方式
eError=OLEToField(OLE1,tbOLEObjects("File_Cont"))
'保存OLE控件OLE1中的内容
tbOLEObjects.Update'更新tbOLEObjects
DoEvents
EndSub
因为Access1.x的OLE字段格式与OLE2字段的格式不同，所以，若是OLE2字段，在读取字段内容时，应使用FieldToOLE函数；若是Access1.x的OLE字段，应使用AccessFieldToOLE函数。这两种格式OLE字段的存贮过程是相同的。当使用Access2.0建立数据库并存贮OLE字段时，它是OLE2格式的，应使用FieldToOLE函数。用VB3编程时，系统中应安装VB/Access2.0兼容层，否则无法操纵Access2.0数据库。
第二、如何使Data控件显示的记录与OLE字段的内容同步。
这个问题是因为Data控件不支持超长的OLE字段引起的。对于普通的数据库字段，把显示该字段内容控件的DataSource和DataField属性分别置为Data控件和数据库的字段名，就可以由Data控件正确地显示数据库记录的字段内容。而用于显示OLE2字段内容的OLE控件的数据是无法用Data控件来存取的，必须用上面提供的函数来存取。这时，关键问题是使OLE控件显示的内容是Data控件所在记录中OLE字段的内容，也就是OLE控件要与Data控件同步。
实现方法：
声明一Dynaset类型的Object：tbOLEObjects。
在Form_Load事件的执行程序中，将Data1.RecordSet赋给tbOLEObjects，并记录tbOLEObjects中的记录数。
在Data1_Validate事件的执行程序中，使tbOLEObjects执行的动作与Data1一致，即：在Data1的Data1_Validate事件执行程序中，当Data1执行Data1.RecordSet.MoveNext或Data1.RecordSet.MoveFirst时，tbOLEObjects也要执行tbOLEObjects.MoveNext或tbOLEObjects.MoveFirst。实现时，先保存当前OLE控件中的内容，然后执行tbOLEObjects.MoveNext或tbOLEObjects.MoveFirst方法，再取出OLE字段中的内容，插入到OLE控件中。
当系统执行了一个SQL语句后，Data1显示的记录直接跳到某一记录，对tbOLEObjects来说，则要执行一查找过程，使得tbOLEObjects的当前记录与Data1的当前记录一致。实现时，先保存当前OLE控件中的内容，再在tbOLEObjects中查找Data1的当前记录，找到后，将其OLE字段中的内容取出并插入到OLE控件中。
下面给出的实现例子是从本人编写的一个软件中摘录出来的，它说明了具体的实现方法，但不可以直接使用，要结合自己的程序，加上其它必要的部分。例子中的数据库是一个公文数据库，保存用户的重要公文，其中的OLE字段保存的就是Word文档，名字为File_Cont，其它字段是文档的相关信息，如文档的标题(File_Title)、等级(File_Class)、关键字(File_Keyword)和ID号(File_ID)等。
变量说明：
OptionExplicit
DimtbOLEObjectsAsDynaset
DimnRecordCountAsInteger'tbOLEObjects的记录数
DimnRecordNumberAsInteger'tbOLEObjects的记录指针
DimbBusyAsInterger'防止重入标志
DimbUpdatedAsInteger'OLE控件的内容发生变化的标志
下面的过程要在窗口的Form_Load事件中执行，完成对tbOLEObjects赋值并计算出tbOLEObjects中的记录数。
SubRefreshForm()
DimeErrorAsInteger
NoRecord=False
Data1.RecordSource="SELECT*fromOwnFileorderbyFile_ID"
Data1.Refresh
SettbOLEObjects=Data1.Recordset.Clone()
'给tbOLEObjects赋值
'下面这两条语句是必须的，否则无法求出tbOLEObjects中的记录数
tbOLEObjects.MoveLast
tbOLEObjects.MoveFirst
nRecordCount=tbOLEObjects.RecordCount
'保存tbOLEObjects的记录数
nRecordNumber=1
'使记录的指针在第一个记录上
'设置各控件的DataField属性，以显示其字段的内容。
txtTitle.DataField="File_Title"
txtClass.DataField="File_Class"
txtFileID.DataField="File_ID"
txtKeyWord.DataField="File_KeyWord"
'将OLE字段File_Cont中的内容取出并插入OLE控件OLE1中
eError=FieldToOLE(OLE1,tbOLEObjects("File_Cont"))
'将Data1指向第一个记录
IfData1.Recordset.RecordCount>1ThenData1.Recordset.MoveFirst
EndSub
下面是如何在Data1_Validate事件中加入对tbOLEObjects操作代码的例子。
SubData1_Validate(ActionAsInteger,SaveAsInteger)
DimeErrorAsInteger
SelectCaseAction
Case1'Data1执行MoveFirst
IfNotbBusyThen
bBusy=True
Screen.MousePointer=11
DoEvents
IfbUpdatedThen
'如果OLE1中的内容发生了变化
CallPutOLEObject
'保存OLE1中的内容
DoEvents
bUpdated=False
EndIf
IfnRecordNumber>1Then
tbOLEObjects.MoveFirst'到Data1所指向的记录
nRecordNumber=1'修改tbOLEObjects的指针
'取出当前记录OLE字段的内容
eError=FieldToOLE(OLE1,tbOLEObjects("File_Cont"))
DoEvents
EndIf
Screen.MousePointer=0
bBusy=False
EndIf
Case2'Data1执行了MovePrevious
IfNotbBusyThen'用于防止程序重入
bBusy=True'
Screen.MousePointer=11
DoEvents
IfbUpdatedThen'如果OLE1中的内容发生变化
CallPutOLEObject'保存OLE1中的内容
DoEvents
bUpdated=False
EndIf
IfnRecordNumber>1Then
tbOLEObjects.MovePrevious'到Data1所指向的记录
nRecordNumber=nRecordNumber-1'修改tbOLEObjects的指针
'取出当前记录OLE字段的内容
eError=FieldToOLE(OLE1,tbOLEObjects("File_Cont"))
DoEvents
EndIf
Screen.MousePointer=0
bBusy=False
EndIf
Case3'MoveNext
......
Case4'MoveLast
......
Case5'增加一个新记录
IfNotbBusyThen
bBusy=True
Screen.MousePointer=11
DoEvents
IfbUpdatedThen
CallPutOLEObject
'保存当前OLE控件中的内容
DoEvents
bUpdated=False
EndIf
'执行tbOLEObjects.AddNew，修改tbOLEObjects的记录数、指针等
'本例子中未给出这部分代码，程序中在增加按钮的Click事件中执行
Screen.MousePointer=0
bBusy=False
EndIf
Case6'更新数据库
IfSave=TrueThen
IfMsgBox
("保存所做的修改?",MSGBOX_TYPE)<>YESThen
Action=0:Save=False
EndIf
Case7
'删除记录，与增加记录的过程作同样的考虑
......
Case8
......
Case9
......
Case10'关闭数据库
IfSave=TrueThen
IfMsgBox
("关闭数据库前,保存所做的修改?",MSGBOX_TYPE)
<>YESThen
Save=False
EndIf
EndSelect
EndSub
下面的过程是用户用Outline控件查找数据库中的Word文档，每一个记录对应一个Outline条目，当用户在Outline的某一条目上作Click动作时，系统就显示出该记录的所有内容，包括OLE字段的内容。这里，tbOLEObjects在查找记录时，使用的是顺序查找方法，读者若要加快查找的速度，可采用其它的查找方法。
SubOutline1_Click()
DimstLNameAsString,stTmp$,eError%
DimstFNameAsString
IfOutline1.Indent(Outline1.ListIndex)=2Then
stTmp$=Outline1.List(Outline1.ListIndex)
stLName=stGetToken$(stTmp$,",")'读取该记录的标志
IfnRecordCount>1Then
tbOLEObjects.MoveFirst
nRecordNumber=1'到第一个记录
DoWhileTrim$(tbOLEObjects!File_ID)<>stLName
'开始查找该记录
nRecordNumber=nRecordNumber+1
tbOLEObjects.MoveNext
Loop
Data1.Recordset.FindFirst"File_ID='"+stLName+"'"
'Data控件也要到该记录
eError=FieldToOLE(OLE1,tbOLEObjects("File_Cont"))
'取出OLE字段的内容
Outline1.SetFocus
'将焦点放在Outline控件上
ElseIfnRecordCount=1Then
Data1.Recordset.FindFirst"File_ID='"+stLName+"'"
eError=FieldToOLE(OLE1,tbOLEObjects("File_Cont"))
Outline1.SetFocus
EndIf
EndIf
EndSub
最后，说明一点：以上的程序都是在Windows3.2中文版和VB3环境下实现的，若在Windows环境下，用VB4编写这种程序，上面的程序要作改动，不能直接应用。