轻源码

  • QingYuanMa.com
  • 全球最大的互联网技术和资源下载平台
搜索
轻源码 门户 电脑主程序开源 查看主题

VB中超长OLE数据库字段的操纵方法

发布者: super_bean | 发布时间: 2018-2-14 14:00| 查看数: 2352| 评论数: 1|帖子模式

----现在,多数数据库都支持OLE类型的数据库字段,利用这种字段,可以存放Word文档和Excel表格等任何种类的文件,而且,使用OLE Automation方法,可直接激活文件的原始编辑器,也就是它们的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数据库。

----变量声明:

Option Explicit Const OLE_SAVE_TO_FILE = 11 'OLE Action 常 量
Const OLE_LOAD_FROM_FILE = 12 'OLE Action 常 量 Const CHUNK_SIZE = 32000 '文件读写块的大小

---- 下 面 的 函 数 将Access 1.x 数 据 库 中OLE 字 段 的 内 容 取 出 并 插 入OLE2 控 件 中。

Function AccessFieldToOLE (oleObject
As Control, fdObject As Field) Dim eError As Integer Dim iFileNumber As Integer
Dim wOffsetToObject As Integer iFileNumber = FreeFile '获取文件号 Open App.Path &
"\OLE.TMP" For Binary As iFileNumber '创建临时文件 eError = FieldToFileStream(iFileNumber,
fdObject) '将字段的内容写到文件中 Get iFileNumber, 3, wOffsetToObject '获得Object的偏移地址 Seek
iFileNumber, wOffsetToObject + 1 '到 object的起始位置 oleObject.FileNumber = iFileNumber
'将 OLE control指向临时文件 oleObject.Action = OLE_LOAD_FROM_FILE '从文件中取出 OLE object
Close iFileNumber '关闭临时文件 Kill App.Path & "\OLE.TMP" '删除临时文件 AccessFieldToOLE
= 0 '返回 End Function

---- 下 面 的 函 数 将OLE 字 段 中 的 内 容 写 到 临 时 文 件 中。

Function FieldToFileStream (iFileNumber As
Integer, fdObject As Field) As Integer Dim sChunkHolder As String Dim lChunkCount
As Long Dim lChunkRemainder As Long Dim i As Long lChunkCount = fdObject.FieldSize()
\ CHUNK_SIZE '获得文件的块数 lChunkRemainder = fdObject.FieldSize() Mod CHUNK_SIZE '整块后余下的数据
For i = 0 To lChunkCount - 1 sChunkHolder = fdObject.GetChunk (i * CHUNK_SIZE,
CHUNK_SIZE) '取一块 Put iFileNumber, , sChunkHolder '将块写入临时文件 Next If lChunkRemainder
> 0 Then sChunkHolder = fdObject.GetChunk (lChunkCount * CHUNK_SIZE, lChunkRemainder)
'取余下的数据 Put iFileNumber, , sChunkHolder '将其写入临时文件 End If FieldToFileStream = 0
'返回 End Function

---- 下 面 的 函 数 将OLE2 数 据 库 字 段 的 内 容 取 出 并 插 入OLE2 控 件 中。

Function FieldToOLE (oleObject As
Control, fdObject As Field) Dim eError As Integer Dim iFileNumber As Integer iFileNumber
= FreeFile '获取文件号 Open App.Path & "\OLE.TMP" For Binary As iFileNumber
'创建临时文件 eError = FieldToFileStream(iFileNumber, fdObject) '将字段的内容写到临时文件中 Seek
iFileNumber, 1 '到 object的起始位置 oleObject.FileNumber = iFileNumber 'OLE控件指向临时文件
oleObject.Action = OLE_LOAD_FROM_FILE '从文件中取出 OLE object Close iFileNumber '关闭临时文件
Kill App.Path & "\OLE.TMP" '删除临时文件 FieldToOLE = 0 '返回 End Function

---- 下 面 的 函 数 将 临 时 文 件 写 入 数 据 库 的OLE2 字 段 中。

Function FileStreamToField (iFileNumber As Integer, fdObject As
Field) As Integer Dim sChunkHolder As String Dim lChunkCount As Long Dim lChunkRemainder
As Long Dim i As Long sChunkHolder = Space$(CHUNK_SIZE) '临时存贮块 lChunkCount = (LOF(iFileNumber)
- Seek(iFileNumber) + 1) \ CHUNK_SIZE '取块数 lChunkRemainder = (LOF(iFileNumber)
- Seek(iFileNumber) + 1) Mod CHUNK_SIZE '取整块后余下的数据 For i = 1 To lChunkCount Get
iFileNumber, , sChunkHolder '从文件中取出一块 fdObject.AppendChunk (sChunkHolder) '将块写入字段中
Next If lChunkRemainder > 0 Then sChunkHolder = Space$(lChunkRemainder) '临时存贮块
Get iFileNumber, , sChunkHolder '取出该块 fdObject.AppendChunk (sChunkHolder)'写入字段中
End If FileStreamToField = 0 '返回 End Function

---- 下 面 的 函 数 将OLE2 Object 从OLE2 控 件 中 取 出, 并 存 入 数 据 库 字 段 中。

Function OLEToField
(oleObject As Control, fdObject As Field) As Integer Dim eError As Integer Dim
iFileNumber As Integer iFileNumber = FreeFile '获取文件号 Open App.Path & "\OLE.TMP"
For Binary As iFileNumber '创建临时文件 oleObject.FileNumber = iFileNumber 'OLE控件指向临时文件
oleObject.Action = OLE_SAVE_TO_FILE '将字段的内容写到临时文件中 Seek iFileNumber, 1 '到 object的起始位置
fdObject = "" 清空OLE2字段 eError = FileStreamToField (iFileNumber, fdObject)
'将文件写入OLE2字段中 Close iFileNumber '关闭临时文件 Kill App.Path & "\OLE.TMP"
'删除临时文件 OLEToField = 0 '返回 End Function

----上述函数的调用方法十分简单,下面的两个子程序给出了调用例子。

----1、将OLE2字段中的内容取出并插入OLE控件中

Sub GetOLEObject() Dim eError
As Integer '将OLE字段File_Cont中的内容取出并插入OLE控件OLE1中 eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
End Sub

---- 2、 将OLE2 控 件 中 的 内 容 写 入OLE2 字 段

Sub PutOLEObject() Dim eError As Integer tbOLEObjects.Edit '修改OLEObjects的工作方式
eError = OLEToField(OLE1, tbOLEObjects("File_Cont")) '保存OLE控件OLE1中的内容
tbOLEObjects.Update '更新tbOLEObjects DoEvents End Sub

----因为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控件同步。

----实现方法:

----1、声明一Dynaset类型的Object:tbOLEObjects。

----2、在Form_Load事件的执行程序中,将Data1.RecordSet赋给tbOLEObjects,并记录tbOLEObjects中的记录数。

----3、在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控件中。

----4、当系统执行了一个SQL语句后,Data1显示的记录直接跳到某一记录,对tbOLEObjects来说,则要执行一查找过程,使得tbOLEObjects的当前记录与Data1的当前记录一致。实现时,先保存当前OLE控件中的内容,再在tbOLEObjects中查找Data1的当前记录,找到后,将其OLE字段中的内容取出并插入到OLE控件中。

----下面给出的实现例子是从本人编写的一个软件中摘录出来的,它说明了具体的实现方法,但不可以直接使用,要结合自己的程序,加上其它必要的部分。例子中的数据库是一个公文数据库,保存用户的重要公文,其中的OLE字段保存的就是Word文档,名字为File_Cont,其它字段是文档的相关信息,如文档的标题(File_Title)、等级(File_Class)、关键字(File_Keyword)和ID号(File_ID)等。

----变量说明:

Option Explicit
Dim tbOLEObjects As Dynaset Dim nRecordCount As Integer 'tbOLEObjects的记录数 Dim
nRecordNumber As Integer 'tbOLEObjects的记录指针 Dim bBusy As Interger '防止重入标志 Dim
bUpdated As Integer 'OLE控件的内容发生变化的标志

----下面的过程要在窗口的Form_Load事件中执行,完成对tbOLEObjects赋值并计算出tbOLEObjects中的记录数。

Sub RefreshForm() Dim eError As Integer NoRecord = False Data1.RecordSource
= "SELECT * from OwnFile order by File_ID" Data1.Refresh Set tbOLEObjects
= 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指向第一个记录
If Data1.Recordset.RecordCount > 1 Then Data1.Recordset.MoveFirst End Sub

----下面是如何在Data1_Validate事件中加入对tbOLEObjects操作代码的例子。

Sub
Data1_Validate(Action As Integer, Save As Integer) Dim eError As Integer Select
Case Action Case 1 'Data1执行MoveFirst If Not bBusy Then bBusy = True Screen.MousePointer
= 11 DoEvents If bUpdated Then '如果OLE1中的内容发生了变化 Call PutOLEObject '保存OLE1中的内容
DoEvents bUpdated = False End If If nRecordNumber > 1 Then tbOLEObjects.MoveFirst
'到Data1所指向的记录 nRecordNumber = 1 '修改tbOLEObjects的指针 '取出当前记录OLE字段的内容 eError = FieldToOLE(OLE1,
tbOLEObjects("File_Cont")) DoEvents End If Screen.MousePointer = 0 bBusy
= False End If Case 2 'Data1执行了MovePrevious If Not bBusy Then '用于防止程序重入 bBusy
= True ' Screen.MousePointer = 11 DoEvents If bUpdated Then '如果OLE1中的内容发生变化 Call
PutOLEObject '保存OLE1中的内容 DoEvents bUpdated = False End If If nRecordNumber >
1 Then tbOLEObjects.MovePrevious '到Data1所指向的记录 nRecordNumber = nRecordNumber -
1 '修改tbOLEObjects的指针 '取出当前记录OLE字段的内容 eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
DoEvents End If Screen.MousePointer = 0 bBusy = False End If Case 3 'MoveNext
...... Case 4 'MoveLast ...... Case 5 '增加一个新记录 If Not bBusy Then bBusy = True
Screen.MousePointer = 11 DoEvents If bUpdated Then Call PutOLEObject '保存当前OLE控件中的内容
DoEvents bUpdated = False End If '执行tbOLEObjects.AddNew, 修改tbOLEObjects的记录数、指针等
'本例子中未给出这部分代码, 程序中在增加按钮的Click事件中执行 Screen.MousePointer = 0 bBusy = False End If
Case 6 '更新数据库 If Save = True Then If MsgBox ("保存所做的修改?", MSGBOX_TYPE)
<> YES Then Action = 0: Save = False End If Case 7 '删除记录,与增加记录的过程作同样的考虑
...... Case 8 ...... Case 9 ...... Case 10 '关闭数据库 If Save = True Then If MsgBox("关闭数据库前,保存所做的修改?",
MSGBOX_TYPE) <> YES Then Save = False End If End Select End Sub

----下面的过程是用户用Outline控件查找数据库中的Word文档,每一个记录对应一个Outline条目,当用户在Outline的某一条目上作Click动作时,系统就显示出该记录的所有内容,包括OLE字段的内容。这里,tbOLEObjects在查找记录时,使用的是顺序查找方法,读者若要加快查找的速度,可采用其它的查找方法。

Sub Outline1_Click() Dim stLName As String,
stTmp$, eError% Dim stFName As String If Outline1.Indent(Outline1.ListIndex) =
2 Then stTmp$ = Outline1.List(Outline1.ListIndex) stLName = stGetToken$(stTmp$,
",") '读取该记录的标志 If nRecordCount > 1 Then tbOLEObjects.MoveFirst nRecordNumber
= 1 '到第一个记录 Do While Trim$(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控件上 ElseIf nRecordCount = 1 Then Data1.Recordset.FindFirst
"File_ID = '" + stLName + "'" eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
Outline1.SetFocus End If End If End Sub

----最后,说明一点:以上的程序都是在Windows3.2中文版和VB3环境下实现的,若在Windows环境下,用VB4编写这种程序,上面的程序要作改动,不能直接应用。VB4中,Data控件理论上是支持OLE数据库字段的,但这样使用时,每次执行MoveFirst或MoveNext等类似动作,都会产生一个没有错误号的"OLEAutomation"错误,笔者没有找到产生这个问题的原因和解决方法,如果有朋友告知解决方法,笔者十分感谢。

最新评论

deeper 发表于 2022-5-22 20:44
源代码2完整版免费观看

轻源码让程序更轻更快

QingYuanMa.com

工作时间 周一至周六 8:00-17:30

侵权处理

客服QQ点击咨询

关注抖音号

定期抽VIP

Copyright © 2016-2021 https://www.qingyuanma.com/ 滇ICP备13200218号

快速回复 返回顶部 返回列表