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
上 述 函 數 的 調 用 方 法 十 分 簡 單， 下 面 的 兩 個 子 程 序 給 出 了 調 用 例 子。
將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 數 據 庫。
第 二、 如 何 使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) 等。
變 量 說 明：
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" 錯 誤， 筆 者 沒 有 找 到 產 生 這 個 問 題 的 原 因 和 解 決 方 法， 如 果 有 朋 友 告 知 解 決 方 法， 筆 者 十 分 感 謝。
延伸閱讀
文章來源于領測軟件測試網 http://www.kjueaiud.com/
