在類里,寫入了5個Let屬性,1個Get屬性(只讀)和兩個方法。Let屬性傳遞動態(tài)鏈接庫需要的信息,Get屬性提供動 態(tài)鏈接庫生成的圖片文件的位置。兩個方法用來打開到數(shù)據(jù)庫的連接,以生成圖片文件。表 A 總結(jié)了這些屬性和方法的作 用。當(dāng)然,根據(jù)項目的需要,可以在類里加入更復(fù)雜的功能。
Private mAdoConn As New ADODB.Connection Private mAdoRst As New ADODB.Recordset Private mstrDbName As String Private mstrTableName As String Private mstrImageColumnName As String '圖片字的名稱。 Private mstrImageTypeColumnName As String '圖片類型字段的名稱。 Private mstrImageIdColumnName As String '圖片ID字段的名稱。 Private mstrFileName() As String '數(shù)組,里面包含文件名和路徑。 Private mlngImageId() As Long '數(shù)組,里面包含圖片ID Private mlngNumberOfFiles As Long Const BLOCKSIZE = 102400
Public Property Let DbName(ByVal strVal As String) mstrDbName = strVal End Property
Public Property Let TableName(ByVal strVal As String) mstrTableName = strVal End Property
Public Property Let NameOfImageColumn(ByVal strVal As String) mstrImageColumnName = strVal End Property
Public Property Let NameOfImageTypeColumn(ByVal strVal As String) mstrImageTypeColumnName = strVal End Property
Public Property Let NameOfImageIdColumn(ByVal strVal As String) mstrImageIdColumnName = strVal End Property
Public Property Get ImageFile(ByVal ImageId As Integer) As String Dim intPos As Integer Dim blnFindId As Boolean Dim i As Integer
blnFindId = False For i = 0 To mlngNumberOfFiles - 1 If mlngImageId(i) = ImageId Then intPos = 5 + Len(ImageId) + 3 ImageFile = Right(mstrFileName(i), intPos) 'reformat the location of file. blnFindId = True End If Next i
If blnFindId = False Then Err.Clear Err.Raise vbObjectError + 23, "Get ImageFile", "Can't find image file!" End If
End Property
Public Sub OpenConnection() '********************************************************** '作用:打開數(shù)據(jù)庫連接。 '**********************************************************
On Error GoTo Error_handler If mstrDbName = "" Then GoTo Error_handler If mAdoConn.State = adStateOpen Then mAdoConn.Close mAdoConn.ConnectionString = "DRIVER={SQL Server};SERVER=(local);UID=sa;PWD=;WSID=JIA;DATABASE=" & mstrDbName mAdoConn.ConnectionTimeout = 15 mAdoConn.Open Exit Sub
Error_handler: Call HandleError End Sub
Public Sub CreateTempImageFile(ByVal ImageId As Integer) Dim strImageType As String Dim i As Integer '********************************************************** '作用:打開記錄集,提取二進(jìn)制數(shù)據(jù),并把數(shù)據(jù)存入文件。注意文件名使用圖片ID生成。 '輸入:圖片ID。 '********************************************************** If mAdoConn.State = adStateClosed Then Exit Sub
Call OpenRecordset(ImageId)
If mAdoRst.State = adStateClosed Then Exit Sub
On Error GoTo Error_handler
For i = 0 To mlngNumberOfFiles - 1 '檢測圖片文件是否已經(jīng)存在。 If mlngImageId(i) = ImageId Then Exit Sub Next i
Private Sub OpenRecordset(ByVal ImageId As Integer) Dim SqlText As String '********************************************************** '作用:打開記錄集。 '輸入:圖片ID。 '**********************************************************
On Error GoTo Error_handler If mAdoRst.State = adStateOpen Then mAdoRst.Close SqlText = "SELECT " & mstrImageColumnName & "," & _ mstrImageTypeColumnName & " FROM " & mstrTableName & _ " WHERE " & mstrImageIdColumnName & "=" & ImageId
Private Sub ReadFromDB(fld As ADODB.Field, ByVal DiskFile As String, _ FldSize As Long) Dim NumBlocks As Integer Dim LeftOver As Long Dim byteData() As Byte '字節(jié)數(shù)組,用于長的可變二進(jìn)制數(shù)據(jù)LongVarBinary。 Dim strData As String '字符串,用于長的可變二進(jìn)制數(shù)據(jù)LongVarChar。 Dim DestFileNum As Integer Dim pic As Variant Dim i As Integer '********************************************************** '作用:提取二進(jìn)制數(shù)據(jù)并把數(shù)據(jù)放入文件。 '輸入:圖片字段,文件名/位置和數(shù)據(jù)尺寸。 '**********************************************************
If Len(Dir(DiskFile)) > 0 Then '刪除已經(jīng)存在的目標(biāo)文件。 Kill DiskFile End If
DestFileNum = FreeFile Open DiskFile For Binary As DestFileNum NumBlocks = FldSize / BLOCKSIZE LeftOver = FldSize Mod BLOCKSIZE
Select Case fld.Type Case adLongVarBinary '用于圖片數(shù)據(jù)類型。 byteData() = fld.GetChunk(LeftOver) pic = fld.GetChunk(LeftOver) Put DestFileNum, , byteData()
For i = 1 To NumBlocks byteData() = fld.GetChunk(BLOCKSIZE) Put DestFileNum, , byteData() Next i
Case adLongVarChar '用于文本數(shù)據(jù)類型。 For i = 1 To NumBlocks strData = String(BLOCKSIZE, 32) strData = fld.GetChunk(BLOCKSIZE) Put DestFileNum, , strData Next i
strData = String(LeftOver, 32) strData = fld.GetChunk(LeftOver) Put DestFileNum, , strData Case Else Err.Clear Err.Raise vbObjectError + 22, "Read from DB", "Not a Chunk Required column!" End Select
Close DestFileNum
End Sub
Private Sub HandleError() Dim adoErrs As ADODB.Errors Dim errLoop As ADODB.Error Dim strError As String Dim i As Integer '********************************************************** '作用:處理可能的錯誤。 '**********************************************************
If mAdoConn.State = adStateClosed Then GoTo Done i = 1 Set adoErrs = mAdoConn.Errors For Each errLoop In adoErrs '枚舉錯誤集。 With errLoop strError = strError & vbCrLf & " ADO Error #" & .Number strError = strError & vbCrLf & " Description " & .Description strError = strError & vbCrLf & " Source " & .Source i = i + 1 End With Next
Done: Err.Raise vbObjectError + 21, "", strError End Sub
Private Sub Class_Initialize() mlngNumberOfFiles = 0 End Sub
Private Sub Class_Terminate() Dim i As Integer On Error GoTo Error_handler If mAdoRst.State = adStateOpen Then mAdoRst.Close '關(guān)閉記錄集。 If mAdoConn.State = adStateOpen Then mAdoConn.Close '關(guān)閉連接。 Set mAdoRst = Nothing Set mAdoConn = Nothing Exit Sub