设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 34505|回复: 96
打印 上一主题 下一主题

[模块/函数] 二进制保存图片

[复制链接]

点击这里给我发消息

1#
发表于 2007-12-1 10:38:08 | 显示全部楼层
不错,这种方法很好.
我以前使用另一种方法


'保存文件到字段:
'tmtony
Public Function SaveFileToField(ByRef fld As ADODB.Field, DiskFile As String) As Boolean

On Error GoTo ErrorHandle

    Const BLOCKSIZE = 4096
    Dim byteData() As Byte '定义数据块数组
    Dim NumBlocks As Long '定义数据块个数
    Dim FileLength As Long '标识文件长度
    Dim LeftOver As Long '定义剩余字节长度
    Dim SourceFile As Long '定义自由文件号
    Dim I As Long '定义循环变量
    SourceFile = FreeFile '提供一个尚未使用的文件号
    Open DiskFile For Binary Access Read As SourceFile '打开文件
    FileLength = LOF(SourceFile) '得到文件长度
    If FileLength = 0 Then '判断文件是否存在
    Close SourceFile
    MsgBox DiskFile & "无 内 容 或 不 存 在 !"
    Else
    NumBlocks = FileLength \ BLOCKSIZE '得到数据块的个数
    LeftOver = FileLength Mod BLOCKSIZE '得到剩余字节数
    fld.Value = Null
    ReDim byteData(BLOCKSIZE) '重新定义数据块的大小
    For I = 1 To NumBlocks
    Get SourceFile, , byteData() ' 读到内存块中
    fld.AppendChunk byteData() '写入FLD
    Next I
    ReDim byteData(LeftOver) '重新定义数据块的大小
    Get SourceFile, , byteData() '读到内存块中
    fld.AppendChunk byteData() '写入FLD
   
    Close SourceFile '关闭源文件
    End If
        SaveFileToField = True
        Exit Function
   
ErrorHandle:
        SaveFileToField = False
        MsgBox Err.Description, vbCritical, "写入数据出错!"
   
End Function

'保存字段内容到文件:

Public Function GetFileFromField(blobColumn As ADODB.Field, ByVal FILENAME) 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
        GetFileFromField = False
        ChunkSize = 2048                    '定义块大小为 2K
        If IsNull(blobColumn) 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            '关闭文件
        GetFileFromField = True
        Exit Function
ErrorHandle:
        GetFileFromField = False
        MsgBox Err.Description, vbCritical, "读取数据出错!"
End Function
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-16 03:28 , Processed in 0.081804 second(s), 25 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表