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 '數組,裡麵包含檔案名稱和路徑。
Private mlngImageId() As Long '數組,裡麵包含圖片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()
'**********************************************************
'作用:開啟資料庫連接。
'**********************************************************
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
'**********************************************************
'作用:開啟記錄集,提取位元據,並把資料存入檔案。注意檔案名稱使用圖片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
'檢測圖片檔案是否已經存在。
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 '位元組數組,用於長的可變位元據LongVarBinary。
Dim strData As String '字串,用於長的可變位元據LongVarChar。
Dim DestFileNum As Integer
Dim pic As Variant
Dim i As Integer
'**********************************************************
'作用:提取位元據並把資料放入檔案。
'輸入:圖片欄位,檔案名稱/位置和資料尺寸。
'**********************************************************
If Len(Dir(DiskFile)) > 0 Then '刪除已經存在的目標檔案。
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 '用於圖片資料類型。
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 '用於文本資料類型。
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 '關閉記錄集。
If mAdoConn.State = adStateOpen Then mAdoConn.Close '關閉串連。
Set mAdoRst = Nothing
Set mAdoConn = Nothing
Exit Sub