mblob.bas

主要是封装了对数据库进行文件存取的功能！

Attribute VB_Name = "MBlob"

'功能：从数据库中读出文件，或写文件到数据库中！
'时间：2006.08.16

Option Explicit


Public Function AppendBlobFromFile(blobColumn As ADODB.Field, ByVal FileName As String) As Boolean

    Dim FileNumber     As Integer         '文件号
    Dim DataLen        As Long            '文件长度
    Dim Chunks         As Long            '数据块数
    Dim ChunkAry()     As Byte            '数据块数组
    Dim ChunkSize      As Long            '数据块大小
    Dim Fragment       As Long            '零碎数据大小
    Dim lngI           As Long            '计数器
    
     
    On Error GoTo ErrorHandle
    
    AppendBlobFromFile = False
    
    ChunkSize = 2048                          '限制每次读取的块大小为 2K
    
     
    FileNumber = FreeFile                     '产生随机的文件号
    
    Open FileName For Binary Access Read As FileNumber     '打开图像文件
    
    DataLen = LOF(FileNumber)                 '获得文件长度
    
    If blobColumn Is Nothing Then Exit Function
     
    
    If DataLen = 0 Then                       '文件长度为0
    
      Close FileNumber
    
      AppendBlobFromFile = True
    
      Exit Function
    
    End If
    
    
    Chunks = DataLen \ ChunkSize            '数据块的个数
    
    Fragment = DataLen Mod ChunkSize
    
    If Fragment > 0 Then                    '先写零碎数据
    
      ReDim ChunkAry(Fragment - 1)
    
      Get FileNumber, , ChunkAry()          '读出文件
    
      blobColumn.AppendChunk ChunkAry       '调用AppendChunk函数写数据
    
    End If
    
        
    
    ReDim ChunkAry(ChunkSize - 1)        '为数据块开辟空间
    
    For lngI = 1 To Chunks               '循环读出所有数据块
    
      Get FileNumber, , ChunkAry()       '读出一块数据
    
      blobColumn.AppendChunk ChunkAry    '在数据库中增加数据块
    
    Next lngI
    
        
    
    Close FileNumber                    '关闭文件
    
    AppendBlobFromFile = True
    
    Exit Function
    
ErrorHandle:
    
    AppendBlobFromFile = False
    
    MsgBox Err.Description, vbCritical, "写文件数据出错!"

End Function



Public Function ReadbolbToFile(blobColumn As ADODB.Field, ByVal FileName As String) As Boolean
     
    Dim FileNumber     As Integer         '文件号
    Dim DataLen        As Long            '文件长度
    Dim Chunks         As Long            '数据块数
    Dim ChunkAry()     As Byte            '数据块数组
    Dim ChunkSize      As Long            '数据块大小
    Dim Fragment       As Long            '零碎数据大小
    Dim lngI           As Long            '计数器
    
    On Error GoTo ErrorHandle
    
    ReadbolbToFile = False
    
    ChunkSize = 2048                            '定义块大小为 2K
    
    If blobColumn Is Nothing Then Exit Function
    
    DataLen = blobColumn.ActualSize             '获得图像大小
    
    If DataLen < 8 Then Exit Function           '图像大小小于8字节时认为不是图像信息
    
        FileNumber = FreeFile                   '产生随机的文件号
    
    Open FileName For Binary Access Write As FileNumber  '打开存放图像数据文件
    
    Chunks = DataLen \ ChunkSize                '数据块数
    
    Fragment = DataLen Mod ChunkSize            '零碎数据
    
    If Fragment > 0 Then                        '有零碎数据，则先读该数据
    
            ReDim ChunkAry(Fragment - 1)
    
            ChunkAry = blobColumn.GetChunk(Fragment)
    
            Put FileNumber, , ChunkAry          '写入文件
    
    End If
    
    ReDim ChunkAry(ChunkSize - 1)               '为数据块重新开辟空间
    
    For lngI = 1 To Chunks                      '-循环读出所有块
    
            ChunkAry = blobColumn.GetChunk(ChunkSize)   '在数据库中连续读数据块
    
            Put FileNumber, , ChunkAry()        '将数据块写入文件中
    
    Next lngI
    
    Close FileNumber                            '关闭文件
    
    ReadbolbToFile = True
    
    Exit Function
    
ErrorHandle:
    
    ReadbolbToFile = False
    
    MsgBox Err.Description, vbCritical, "读文件数据出错!"

End Function