VB中超長(zhǎng)OLE數(shù)據(jù)庫(kù)字段的操縱方法
作者：程毅 
現(xiàn) 在， 多 數(shù) 數(shù) 據(jù) 庫(kù) 都 支 持OLE 類 型 的 數(shù) 據(jù) 庫(kù) 字 段， 利 用 這 種 字 段， 可 以 存 放Word 文 檔 和Excel 表 格 等 任 何 種 類 的 文 件， 而 且， 使 用OLE Automation 方 法， 可 直 接 激 活 文 件 的 原 始 編 輯 器， 也 就 是 它 們 的OLE Server。 這 樣， 我 們 就 有 了 一 個(gè) 安 全 可 靠 的 保 存 各 類 重 要 文 件 的 方 法。 但 是， 因 為 這 些 文 件 常 常 是 很 大， 幾 十K ， 甚 至 上 百K， 就 要 求 我 們 有 一 種 切 實(shí) 可 行 的 操 縱 方 法， 實(shí) 現(xiàn) 對(duì) 這 種 字 段 的 存 取。

VB 為 程 序 員 提 供 了 數(shù) 據(jù) 庫(kù) 控 件Data， 使 用 它， 可 以 方 便 地 操 縱 數(shù) 據(jù) 庫(kù)， 如 瀏 覽 數(shù) 據(jù) 庫(kù)， 增 加 新 記 錄， 編 輯 且 更 新 現(xiàn) 存 的 記 錄， 刪 除 記 錄 等。 但 這 些 功 能 是 對(duì) 普 通 的 數(shù) 據(jù) 庫(kù) 而 言 的， 當(dāng) 數(shù) 據(jù) 庫(kù) 中 有 超 長(zhǎng) 的OLE 字 段 時(shí)， 僅 僅 使 用Data 則 不 能 完 成 上 述 操 作 了。 此 時(shí)， 需 要 解 決 二 個(gè) 問 題： 第 一， 如 何 存 取OLE 字 段 中 的 內(nèi) 容； 第 二， 如 何 同 步 存 取Data 控 件 所 顯 示 記 錄 中OLE 字 段 與 其 它 字 段 的 內(nèi) 容。

針 對(duì) 上 述 二 個(gè) 問 題， 介 紹 一 種 解 決 方 法。

第 一、 如 何 存 取OLE 字 段 中 的 內(nèi) 容。
VB 提 供 了 文 件 存 取 的 方 法， 利 用 這 種 方 法 我 們 可 以 方 便 地 存 取OLE 數(shù) 據(jù) 庫(kù) 字 段。 下 面 給 出 的 函 數(shù) 就 利 用 文 件 存 取 的 方 法， 實(shí) 現(xiàn) 了 對(duì)OLE 數(shù) 據(jù) 庫(kù) 字 段 的 存 取 操 作。 這 里， 使 用Get、Put、Seek 等 語(yǔ) 句， 以 二 進(jìn) 制 形 式 打 開 一 個(gè) 臨 時(shí) 文 件， 把 它 作 為OLE 字 段 與OLE 控 件 的 中 間 緩 沖 器， 當(dāng) 從OLE 字 段 向OLE 控 件 中 讀 數(shù) 據(jù) 時(shí)， 先 將OLE 字 段 的 數(shù) 據(jù) 寫 入 臨 時(shí) 文 件， 再 將 臨 時(shí) 文 件 用OLE 控 件 的OLE_LOAD_FROM_FILE 動(dòng) 作 插 入OLE 控 件； 當(dāng) 把OLE 控 件 的 數(shù) 據(jù) 寫 入OLE 字 段 時(shí)， 則 先 用OLE 控 件 的OLE_SAVE_TO_FILE 動(dòng) 作， 將 其 存 入 臨 時(shí) 文 件， 再 將 臨 時(shí) 文 件 寫 入OLE 字 段。 這 里， 以 固 定 塊 長(zhǎng) 的 方 式 讀 寫OLE 字 段 和 臨 時(shí) 文 件。 這 些 函 數(shù) 都 沒 有 錯(cuò) 誤 檢 測(cè) 部 分。
下 面 所 有 例 子 使 用 的 都 是Access2.0 數(shù) 據(jù) 庫(kù)。

變 量 聲 明：
Option Explicit

Const OLE_SAVE_TO_FILE = 11 'OLE Action 常 量
Const OLE_LOAD_FROM_FILE = 12 'OLE Action 常 量
Const CHUNK_SIZE = 32000 ' 文 件 讀 寫 塊 的 大 小
下 面 的 函 數(shù) 將Access 1.x 數(shù) 據(jù) 庫(kù) 中OLE 字 段 的 內(nèi) 容 取 出 并 插 入OLE2 控 件 中。
Function AccessFieldToOLE
(oleObject As Control, fdObject As Field)
Dim eError As Integer
Dim iFileNumber As Integer
Dim wOffsetToObject As Integer

iFileNumber = FreeFile
' 獲 取 文 件 號(hào)
Open App.Path & "\OLE.TMP" For Binary As iFileNumber
' 創(chuàng) 建 臨 時(shí) 文 件
eError = FieldToFileStream(iFileNumber, fdObject)
' 將 字 段 的 內(nèi) 容 寫 到 文 件 中
Get iFileNumber, 3, wOffsetToObject
' 獲 得Object 的 偏 移 地 址
Seek iFileNumber, wOffsetToObject + 1
' 到 object 的 起 始 位 置
oleObject.FileNumber = iFileNumber
' 將 OLE control 指 向 臨 時(shí) 文 件
oleObject.Action = OLE_LOAD_FROM_FILE
' 從 文 件 中 取 出 OLE object
Close iFileNumber
' 關(guān) 閉 臨 時(shí) 文 件
Kill App.Path & "\OLE.TMP"
' 刪 除 臨 時(shí) 文 件
AccessFieldToOLE = 0
' 返 回
End Function
下 面 的 函 數(shù) 將OLE 字 段 中 的 內(nèi) 容 寫 到 臨 時(shí) 文 件 中。
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
' 獲 得 文 件 的 塊 數(shù)
lChunkRemainder = fdObject.FieldSize() Mod CHUNK_SIZE
' 整 塊 后 余 下 的 數(shù) 據(jù)
For I = 0 To lChunkCount - 1
sChunkHolder = fdObject.GetChunk
(I * CHUNK_SIZE, CHUNK_SIZE)
' 取 一 塊
Put iFileNumber, , sChunkHolder
' 將 塊 寫 入 臨 時(shí) 文 件
Next
If lChunkRemainder > 0 Then
sChunkHolder = fdObject.GetChunk
(lChunkCount * CHUNK_SIZE, lChunkRemainder)
' 取 余 下 的 數(shù) 據(jù)
Put iFileNumber, , sChunkHolder
' 將 其 寫 入 臨 時(shí) 文 件
End If
FieldToFileStream = 0
' 返 回
End Function
下 面 的 函 數(shù) 將OLE2 數(shù) 據(jù) 庫(kù) 字 段 的 內(nèi) 容 取 出 并 插 入OLE2 控 件 中。
Function FieldToOLE
(oleObject As Control, fdObject As Field)
Dim eError As Integer
Dim iFileNumber As Integer

iFileNumber = FreeFile
' 獲 取 文 件 號(hào)
Open App.Path & "\OLE.TMP" For Binary As iFileNumber
' 創(chuàng) 建 臨 時(shí) 文 件
eError = FieldToFileStream(iFileNumber, fdObject)
' 將 字 段 的 內(nèi) 容 寫 到 臨 時(shí) 文 件 中
Seek iFileNumber, 1
' 到 object 的 起 始 位 置
oleObject.FileNumber = iFileNumber
'OLE 控 件 指 向 臨 時(shí) 文 件
oleObject.Action = OLE_LOAD_FROM_FILE
' 從 文 件 中 取 出 OLE object
Close iFileNumber
' 關(guān) 閉 臨 時(shí) 文 件
Kill App.Path & "\OLE.TMP"
' 刪 除 臨 時(shí) 文 件
FieldToOLE = 0
' 返 回
End Function
下 面 的 函 數(shù) 將 臨 時(shí) 文 件 寫 入 數(shù) 據(jù) 庫(kù) 的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)
' 臨 時(shí) 存 貯 塊
lChunkCount = (LOF(iFileNumber) - Seek(iFileNumber) + 1)
\ CHUNK_SIZE ' 取 塊 數(shù)
lChunkRemainder = (LOF(iFileNumber) - Seek
(iFileNumber) + 1) Mod CHUNK_SIZE
' 取 整 塊 后 余 下 的 數(shù) 據(jù)
For I = 1 To lChunkCount
Get iFileNumber, , sChunkHolder
' 從 文 件 中 取 出 一 塊
fdObject.AppendChunk (sChunkHolder)
' 將 塊 寫 入 字 段 中
Next
If lChunkRemainder > 0 Then
sChunkHolder = Space$(lChunkRemainder)
' 臨 時(shí) 存 貯 塊
Get iFileNumber, , sChunkHolder
' 取 出 該 塊
fdObject.AppendChunk (sChunkHolder)
' 寫 入 字 段 中
End If
FileStreamToField = 0
' 返 回
End Function
下 面 的 函 數(shù) 將OLE2 Object 從OLE2 控 件 中 取 出， 并 存 入 數(shù) 據(jù) 庫(kù) 字 段 中。
Function OLEToField (oleObject As Control,
fdObject As Field) As Integer
Dim eError As Integer
Dim iFileNumber As Integer

iFileNumber = FreeFile
' 獲 取 文 件 號(hào)
Open App.Path & "\OLE.TMP" For Binary As iFileNumber
' 創(chuàng) 建 臨 時(shí) 文 件
oleObject.FileNumber = iFileNumber
'OLE 控 件 指 向 臨 時(shí) 文 件
oleObject.Action = OLE_SAVE_TO_FILE
' 將 字 段 的 內(nèi) 容 寫 到 臨 時(shí) 文 件 中
Seek iFileNumber, 1
' 到 object 的 起 始 位 置
fdObject = "" 清 空OLE2 字 段
eError = FileStreamToField(iFileNumber, fdObject)
' 將 文 件 寫 入OLE2 字 段 中
Close iFileNumber
' 關(guān) 閉 臨 時(shí) 文 件
Kill App.Path & "\OLE.TMP"
' 刪 除 臨 時(shí) 文 件
OLEToField = 0 ' 返 回
End Function
上 述 函 數(shù) 的 調(diào) 用 方 法 十 分 簡(jiǎn) 單， 下 面 的 兩 個(gè) 子 程 序 給 出 了 調(diào) 用 例 子。
將OLE2 字 段 中 的 內(nèi) 容 取 出 并 插 入OLE 控 件 中
Sub GetOLEObject()
Dim eError As Integer

' 將OLE 字 段File_Cont 中 的 內(nèi) 容 取 出 并 插 入OLE 控 件OLE1 中
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
End Sub
將OLE2 控 件 中 的 內(nèi) 容 寫 入OLE2 字 段
Sub PutOLEObject()
Dim eError As Integer

tbOLEObjects.Edit ' 修 改OLEObjects 的 工 作 方 式
eError = OLEToField(OLE1, tbOLEObjects("File_Cont"))
' 保 存OLE 控 件OLE1 中 的 內(nèi) 容
tbOLEObjects.Update ' 更 新tbOLEObjects