设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

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

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

[复制链接]
跳转到指定楼层
1#
发表于 2007-12-1 09:17:01 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
游客,如果您要查看本帖隐藏内容请回复

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅

点击这里给我发消息

2#
发表于 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
3#
发表于 2007-12-1 11:25:30 | 只看该作者
保存的方法不错,实际上不仅是jpeg图片,其它格式的图片和其它格式的文件都可以这样保存。所以有个问题在里面,就是你以后如何把它读出来。特别是如果是图片,读出时如何不要另存为临时文件,而是直接在图片控件上显示出来。
4#
发表于 2007-12-1 15:15:44 | 只看该作者
感谢
5#
发表于 2007-12-1 17:00:33 | 只看该作者
这个例子。。。网上有出现过哦。。。。情比金坚
6#
发表于 2008-3-3 10:42:03 | 只看该作者
请问tmtony管理员,你这段程序如何调用?
7#
发表于 2008-9-16 16:12:35 | 只看该作者
上述方法多收下了.顶一个,以便大家分享.
8#
发表于 2008-9-16 17:16:03 | 只看该作者
我先前也发布了一篇文章,是将文件保存在xml文件中,因为xml文件内容是纯文本,所以我们可以用备注字段来保存。

参考地址:http://www.office-cn.net/vvb/thread-63960-1-1.html
9#
发表于 2008-9-22 07:09:25 | 只看该作者
做了个实例,xml不错文件。并保存在数据库中。

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
10#
发表于 2008-9-22 11:59:41 | 只看该作者
学习了
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-5-2 01:23 , Processed in 0.086864 second(s), 35 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

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