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 
mlngNumberOfFiles = mlngNumberOfFiles + 1
ReDim Preserve mstrFileName(mlngNumberOfFiles) ’改变数组大小。
ReDim Preserve mlngImageId(mlngNumberOfFiles) ’改变数组大小。
mlngImageId(mlngNumberOfFiles - 1) = ImageId
strImageType = mAdoRst.Fields(mstrImageTypeColumnName) ’ 取得图片类型。   
mstrFileName(mlngNumberOfFiles - 1) = App.Path & "\images" & _
  "\image" & LTrim(Str(ImageId)) & "." & strImageType ’取得图片文件名称和位置。
Call ReadFromDB(mAdoRst.Fields(mstrImageColumnName), _
  mstrFileName(mlngNumberOfFiles - 1), AdoRst.Fields(mstrImageColumnName).ActualSize)
Exit Sub 
Error_handler:
Call HandleError 
End Sub 
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 
Set mAdoRst.ActiveConnection = mAdoConn
mAdoRst.Open SqlText, , adOpenStatic, adLockReadOnly ’Open recordset. 
Exit Sub 

Error_handler:
Call HandleError
End Sub 
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 Erro