---- 现 在， 多 数 数 据 库 都 支 持OLE 类 型 的 数 据 库 字 段， 利 用 这 种 字 段， 可 以 存 放Word 文 档 和Excel 表 格 等 任 何 种 类 的 文 件， 而 且， 使 用OLE Automation 方 法， 可 直 接 激 活 文 件 的 原 始 编 辑 器， 也 就 是 它 们 的OLE Server。 这 样， 我 们 就 有 了 一 个 安 全 可 靠 的 保 存 各 类 重 要 文 件 的 方 法。 但 是， 因 为 这 些 文 件 常 常 是 很 大， 几 十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 等 类 似 动 作， 都 会 产 生 一 个 没 有 错 误 号 的"OLE Automation" 错 误， 笔 者 没 有 找 到 产 生 这 个 问 题 的 原 因 和 解 决 方 法， 如 果 有 朋 友 告 知 解 决 方 法， 笔 者 十 分 感 谢。
*博客内容为网友个人发布，仅代表博主个人观点，如有侵权请联系工作人员删除。
