AppendChunk
Public Function SaveFileToDB(ByVal Filename As String, dbField As ADODB.Field, Optional
PackageSize As Long = 8192&) As Long
On Error GoTo errHandle
Dim lngActualSize As Long, lngCurrentSize As Long
Dim bTemp() As Byte
Dim hFile As Long
Dim i As Integer
Dim lChunkCount As Long
Dim lChunkRemainder As Long
lngActualSize = FileLen(Filename)
lngCurrentSize = 0
If lngActualSize <= 0 Then
Err.Raise ERR_SIZE_EQU_OR_LESS_ZERO, "writeFileToDB"
End If
'读取文件内容
hFile = FreeFile()
Open Filename For Binary As hFile
ReDim bTemp(PackageSize) '临时存贮块
lChunkCount = LOF(hFile) / PackageSize '取块数
lChunkRemainder = LOF(hFile) Mod PackageSize
If lChunkRemainder > 0 Then lChunkCount = lChunkCount + 1
For i = 1 To lChunkCount
Get hFile, , bTemp '从文件中取出一块
dbField.AppendChunk (bTemp) '将块写入字段中
Next
Close #1
SaveFileToDB = 0
Exit Function
errHandle:
SaveFileToDB = Err.Number
End Function
GetChunk
Public Function GetFileFromDB(dbField As ADODB.Field, vData As Variant, Optional ByVal SaveAs As String = "", Optional PackageSize As Long = 8192&) As Long
'如果SaveAs为空串则保存在vData这个变体类型中,否则保存在文件中
On Error GoTo errHandle
Dim i% , lngActualSize As Long, lChunkCount As Long
Dim vTemp As Variant, bTemp() As Byte
Dim hFile As Long
lngActualSize = dbField.ActualSize
If lngActualSize <= 0 Then
Err.Raise ERR_SIZE_EQU_OR_LESS_ZERO, "getFileFromDB"
End If
lChunkCount = lngActualSize / PackageSize
If (lngActualSize Mod PackageSize <>0) Then
lChunkCount = lChunkCount + 1
End if
If Trim(SaveAs) = "" Then
For I = 1 To lChunkCount
vTemp = dbField.GetChunk(PackageSize)
vData = vData & vTemp
Next
Else
hFile = FreeFile()
Open SaveAs For Binary As hFile
For I = 1 To lChunkCount
bTemp = dbField.GetChunk(PackageSize)
Put #hFile, , bTemp
Next
Close
End If
GetFileFromDB = 0
Exit Function
errHandle:
GetFileFromDB = Err.Number
End Function