图片的写入/读出问题?

Question

1、图片写入数据库的image字段使用如下程序段,没有错误。
Public Sub PhotoToDB(ByRef fld As ADODB.Field, PhotoFile As String) '把JPG文件保存至库的二进制子段里
  Dim Filename As String '图片文件名
  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 PhotoFile For Binary Access Read As #SourceFile '打开文件
    FileLength = LOF(SourceFile) '得到文件长度
    If FileLength = 0 Then '判断文件是否存在
       Close #SourceFile
       MsgBox PhotoFile & "无内容或不存在 !"
    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
End Sub2、从数据库中读出文件的模块，却经常出错？？？
Public Sub DBtoPic(ByRef fld As ADODB.Field, PhotoFile As String) '把库里的二进制数据读出并保存为JPG文件
  'Dim Filename As String '图片文件名
  
  Const BLOCKSIZE = 4096 '每次读写块的大小
  Dim byteData() As Byte '定义数据块数组
  Dim NumBlocks As Long '定义数据块个数
  Dim FileLength As Long '标识文件长度
  Dim LeftOver As Long '定义剩余字节长度
  Dim destFile As Long '定义自由文件号
  Dim i As Long '定义循环变量
    FileLength = fld.ActualSize  If FileLength = 0 Then
     If Dir(PhotoFile) <> "" Then Kill PhotoFile  '如果文件存在，则删出
  Else
    destFile = FreeFile() '提供一个尚未使用的文件号
    Open PhotoFile For Binary Access Write As #destFile '打开文件
    NumBlocks = FileLength \ BLOCKSIZE
    LeftOver = FileLength Mod BLOCKSIZE
    ReDim byteData(BLOCKSIZE)
    For i = 1 To NumBlocks
        byteData() = fld.GetChunk(BLOCKSIZE)   '错误在此处出现
        Put #destFile, , byteData()
    Next i
    ReDim byteData(LeftOver)
    byteData() = fld.GetChunk(LeftOver)
    Put #destFile, , byteData()
    Close #destFile
  End If
End Sub请教：第二个模块如何做，才能保证不出错？？？？

Answer 1

用Stream对象处理比用GetChunk/AppendChunk等来得简洁得多：
该对象用于读写二进制字段数据的，如下是从图像读取数据写入的简单代码：
    Set stm = New ADODB.Stream
    stm.Type = adTypeBinary    
    stm.Open                     
    stm.LoadFromFile (文件名) 
    rs.AddNew
    rs.Fields(二进制字段).Value = stm.Read   '从stm对象中读取数据
    rs.Update
    stm.Close下面是读字段值写入图像中：
Dim stm As ADODB.Stream
        Set stm = New ADODB.Stream
        With stm
            .Type = adTypeBinary
            .Open
            .Write rs.Fields(二进制字段)       '数据库中的数据写入Stream中
            .SaveToFile 文件名, adSaveCreateOverWrite  '将Stream中数据写入临时文件中
            .Close
        End With
    Exit Sub

Answer 2

往数据库（SQL/Acess）读写Word文件，其实以下代码中的一句就可以变成读写图片：
'窗体放一个CommonDialg1,一个Command1(保存Word),一个Command2（读出Word）
'引用 Microsoft ActiveX Data Objects 2.5 Library 及以上版本
'字段myWord为image类型（SQL库）或Ole对象类型(Access库)
Private Sub Command1_Click()
  On Error GoTo err
  Dim StmPic As ADODB.Stream
    '保存你所选择的文件
    Set StmPic = New ADODB.Stream
    StmPic.Type = adTypeBinary    '指定流是二进制类型
    CommonDialog1.ShowOpen    
    StmPic.Open                     '将数据获取到Stream对象中
    StmPic.LoadFromFile (CommonDialog1.FileName) '将选择的文件加载到打开的StmPic中
    rs.AddNew
    rs.Fields("myWord").Value = StmPic.Read   '从StmPic对象中读取数据
    rs.Update
    StmPic.Close
  Exit Sub
err:
  MsgBox err.Description
End SubPrivate Sub Command2_Click()
     Dim StmPic As ADODB.Stream
     On Error GoTo err
        'StrPicTemp="c:\temp.doc"--------------------->请把这句改为：StrPicTemp="c:\temp.jpeg"，这里只是个例子，不一定是jpeg格式，具体得看你的图片格式了
        Set StmPic = New ADODB.Stream
        With StmPic
            .Type = adTypeBinary
            .Open
            .Write rs.Fields("myWord")       '写入数据库中的数据至Stream中
            .SaveToFile StrPicTemp, adSaveCreateOverWrite  '将Stream中数据写入临时文件中
            .Close
        End With
        Exit Sub
err:
     MsgBox err.Description
End Sub

Answer 3

强以上我的网站上看看此问题的源码：http://www.j2soft.cn/VB资料->查询“向数据库存取图片”；＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
学习技巧与源码下载站：
http://www.j2soft.cn/
http://j2soft.008.net/