现 在 多 数 数 据 库 都 支 持OLE 类 型 数 据 库 字 段 利 用 这 种 字 段 可 以 存 放Word 文 档 和Excel 表 格 等 任 何 种 类 文 件 而 且 使 用OLE Automation 方 法 可 直 接 激 活 文 件 原 始 编 辑 器 也 就 是 它 们 OLE Server 这 样 我 们 就 有 了 个 安 全 可 靠 保 存 各 类 重 要 文 件 方 法 但 是 因 为 这 些 文 件 常 常 是 很 大 几 十K 甚 至 上 百K 就 要 求 我 们 有 种 切 实 可 行 操 纵 方 法 实 现 对 这 种 字 段 存 取

VB 为 程 序 员 提 供 了 数 据 库 控 件Data 使 用 它 可 以 方 便 地 操 纵 数 据 库 如 浏 览 数 据 库 增 加 新 记 录 编 辑 且 更 新 现 存 记 录 删 除 记 录 等 但 这 些 功 能 是 对 普 通 数 据 库 而 言 当 数 据 库 中 有 超 长 OLE 字 段 时 仅 仅 使 用Data 则 不 能 完 成 上 述 操 作 了 此 时 需 要 解 决 2 个 问 题: 第 如 何 存 取OLE 字 段 中 内 容； 第 2 如 何 同 步 存 取Data 控 件 所 显 示 记 录 中OLE 字 段 和 其 它 字 段 内 容

针 对 上 述 2 个 问 题 介 绍 种 解 决 方 法

第 、 如 何 存 取OLE 字 段 中 内 容
VB 提 供 了 文 件 存 取 方 法 利 用 这 种 方 法 我 们 可 以 方 便 地 存 取OLE 数 据 库 字 段 下 面 给 出 函 数 就 利 用 文 件 存 取 方 法 实 现 了 对OLE 数 据 库 字 段 存 取 操 作 这 里 使 用Get、Put、Seek 等 语 句 以 2 进 制 形 式 打 开 个 临 时 文 件 把 它 作 为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 wOffToObject As Integer

iFileNumber = FreeFile
\' 获 取 文 件 号
Open App.Path & \"\\OLE.TMP\" For Binary As iFileNumber
\' 创 建 临 时 文 件
eError = FieldToFileStream(iFileNumber, fdObject)
\' 将 字 段 内 容 写 到 文 件 中
Get iFileNumber, 3, wOffToObject
\' 获 得Object 偏 移 地 址
Seek iFileNumber, wOffToObject + 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 lChunkReder As Long
Dim I As Long

lChunkCount = fdObject.FieldSize \\ CHUNK_SIZE
\' 获 得 文 件 块 数
lChunkReder = fdObject.FieldSize Mod CHUNK_SIZE
\' 整 块 后 余 下 数 据
For I = 0 To lChunkCount - 1
sChunkHolder = fdObject.GetChunk
(I * CHUNK_SIZE, CHUNK_SIZE)
\' 取 块
Put iFileNumber, , sChunkHolder
\' 将 块 写 入 临 时 文 件
Next
If lChunkReder > 0 Then
sChunkHolder = fdObject.GetChunk
(lChunkCount * CHUNK_SIZE, lChunkReder)
\' 取 余 下 数 据
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 lChunkReder As Long
Dim I As Long

sChunkHolder = Space$(CHUNK_SIZE)
\' 临 时 存 贮 块


lChunkCount = (LOF(iFileNumber) - Seek(iFileNumber) + 1)
\\ CHUNK_SIZE \' 取 块 数
lChunkReder = (LOF(iFileNumber) - Seek
(iFileNumber) + 1) Mod CHUNK_SIZE
\' 取 整 块 后 余 下 数 据
For I = 1 To lChunkCount
Get iFileNumber, , sChunkHolder
\' 从 文 件 中 取 出 块
fdObject.AppendChunk (sChunkHolder)
\' 将 块 写 入 字 段 中
Next
If lChunkReder > 0 Then
sChunkHolder = Space$(lChunkReder)
\' 临 时 存 贮 块
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
上 述 函 数 调 用 方 法 十 分 简 单 下 面 两 个 子 程 序 给 出 了 调 用 例 子
将OLE2 字 段 中 内 容 取 出 并 插 入OLE 控 件 中
Sub GetOLEObject
Dim eError As Integer

\' 将OLE 字 段File_Cont 中 内 容 取 出 并 插 入OLE 控 件OLE1 中
eError = FieldToOLE(OLE1, tbOLEObjects(\"File_Cont\"))
End Sub
将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 数 据 库
第 2、 如 何 使Data 控 件 显 示 记 录 和OLE 字 段 内 容 同 步
这 个 问 题 是 因 为Data 控 件 不 支 持 超 长 OLE 字 段 引 起 对 于 普 通 数 据 库 字 段 把 显 示 该 字 段 内 容 控 件 DataSource 和DataField 属 性 分 别 置 为Data 控 件 和 数 据 库 字 段 名 就 可 以 由Data 控 件 正 确 地 显 示 数 据 库 记 录 字 段 内 容 而 用 于 显 示OLE2 字 段 内 容 OLE 控 件 数 据 是 无 法 用Data 控 件 来 存 取 必 须 用 上 面 提 供 函 数 来 存 取 这 时 关 键 问 题 是 使OLE 控 件 显 示 内 容 是Data 控 件 所 在 记 录 中OLE 字 段 内 容 也 就 是OLE 控 件 要 和Data 控 件 同 步
实 现 方 法:

声 明 Dyna 类 型 Object:tbOLEObjects

在F