VB中对大字段的存取AppendChunk和GetChunk

来源:互联网 发布:查看linux下tomcat版本 编辑:程序博客网 时间:2024/04/16 15:29

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