ADO 操纵图像：能不能用ADO把图像数据赋值到数据库（Binary 类型）字段？

Question

Access数据库中建立OLE型字段：Private Sub DBOpen()
    'open the database with ADO
    MYcon.Open "PROVIDER=MICROSOFT.JET.OLEDB.4.0; DATA SOURCE=" & App.Path + "/DBpic.MDB"
    MYrs.Open "PICTABLE", MYcon, 1, 3End Sub
'Close the open database
Private Sub DBClose()
    MYrs.Close
    MYcon.Close
    Set MYrs = Nothing
    Set MYcon = Nothing
End SubPrivate Sub SaveInto(ByVal strPath As String)Dim lngFileLength   As Long   'the length of the file
Dim lngBlockCount   As Long   'the number of total whole block
Dim lngLastBlock   As Integer   'the length of the last block
Dim lngBlockIndex   As Long   'the index of each block
Dim ByteGet()   As Byte   '用于传送数据的二进制数组
Dim FileNum As Integer 'return the file number which the next file will use
Dim strFilepath As String
        
        strFilepath = strPath
        FileNum = FreeFile()
        
        Open strFilepath For Binary Access Read As #FileNum
        lngFileLength = LOF(FileNum) '返回一个 Long，表示用 Open 语句打开的文件的大小，该大小以字节为单位。
        lngBlockCount = lngFileLength \ lngBlockSize
        lngLastBlock = lngFileLength Mod lngBlockSize
        
        MYrs.AddNew
            MYrs.Fields("size") = lngFileLength
            MYrs.Fields("date") = Date
            MYrs.Fields("name") = Trim(Text1)
            ReDim ByteGet(lngBlockSize)
            For lngBlockIndex = 1 To lngBlockCount
                Get #FileNum, , ByteGet()
                MYrs.Fields("pic").AppendChunk ByteGet()
            Next
    
        If lngLastBlock > 0 Then
            ReDim ByteGet(lngLastBlock)
            Get #FileNum, , ByteGet()
            MYrs.Fields("pic").AppendChunk ByteGet()
        End If
            MYrs.Update
        Close #FileNum
End SubPrivate Sub ShowImg(ByVal RecordPoint As Long)
On Error Resume NextDim temp_path As String
Dim temp_file As String
Dim length As Long
Dim lngFileLength   As Long   'the length of the file
Dim lngBlockCount   As Long   'the number of total whole block
Dim lngLastBlock   As Integer   'the length of the last block
Dim lngBlockIndex   As Long   'the index of each block
Dim ByteGet()   As Byte   '用于传送数据的二进制数组
Dim FileNum As Integer 'return the file number which the next file will use
Dim strFileName As Stringtemp_path = Space$(MAX_PATH)
length = GetTempPath(MAX_PATH, temp_path)
temp_path = Left$(temp_path, length)
temp_file = Space$(MAX_PATH)
GetTempFileName temp_path, "per", 0, temp_file
strFileName = Left$(temp_file, InStr(temp_file, Chr$(0)) - 1)    MYrs.MoveFirst
    MYrs.Move RecordPoint
    Label1 = MYrs.AbsolutePosition
    frmMain.Caption = MYrs.Fields("name") + Str(i)
    FileNum = FreeFile()
    Open strFileName For Binary As #FileNum
    lngFileLength = MYrs.Fields("size")
    lngBlockCount = lngFileLength \ lngBlockSize
    lngLastBlock = lngFileLength Mod lngBlockSize
    For lngBlockIndex = 1 To lngBlockCount
        ByteGet() = MYrs.Fields("pic").GetChunk(lngBlockSize)
        Put #FileNum, , ByteGet()
    Next
    If lngLastBlock > 0 Then
    ReDim ByteGet(lngLastBlock)
        ByteGet() = MYrs.Fields("pic").GetChunk(lngBlockSize)
        Put #FileNum, , ByteGet()
    End If
    
    Picture1.Picture = LoadPicture(strFileName)
    
    Close #FileNum
    Kill strFileName
    
    Err.Clear
End SubPrivate Sub AimFilePath(ByVal strPath As String)
Dim PathVal As String
    PathVal = Dir(strPath)
    If PathVal = Null Then MsgBox "null"
    Do While PathVal <> ""
        SaveInto (strPath + PathVal)
        PathVal = Dir
    Loop
End Sub

Answer 1

用ado的Stream方法！
ado2.6以上的都可以！
不过我只会VB!
'Insert into SQL Server
Private Sub ImportBLOB(cn As ADODB.Connection)
    
    Dim rs As New ADODB.Recordset
    Dim stm As ADODB.Stream
    
    Set stm = New ADODB.Stream
    
    ' Skip any table not found errors
    On Error Resume Next
    cn.Execute "drop table BinaryObject"
    
    On Error GoTo 0
    'Create the BinaryObject table
    cn.Execute "create table BinaryObject " & _
                 "(blob_id int IDENTITY(1,1), " & _
                  "blob_filename varchar(256), " & _
                  "blob_object image)"
                
    rs.Open "Select * from BinaryObject where 1=2", cn, adOpenKeyset, adLockOptimistic
    'Read the binary files from disk
    stm.Type = adTypeBinary
    stm.Open
    stm.LoadFromFile App.Path & "\BLOBsample.jpg"
    
    rs.AddNew
    rs!blob_filename = App.Path & "\BLOBsample.jpg"
    rs!blob_object = stm.Read
    
    'Insert the binary object in the table
    rs.Update
    
    rs.Close
    stm.Close
    
    Set rs = Nothing
    Set stm = Nothing
    
End Sub

Answer 2

'Use the image to show
Private Sub DisplayBLOB(cn As ADODB.Connection)    Dim rs As New ADODB.Recordset
    
    ' Select the only image in the table
    rs.Open "Select * from BinaryObject where blob_id = 1", cn
    
    ' Set the DataSource to the recordset
    Set imgBinaryData.DataSource = rs
    'Set the DataField to the BLOB field
    imgBinaryData.DataField = rs!blob_object.Name
    
    'Release the recordset
    rs.Close
    Set rs = NothingEnd Sub

Answer 3

用Stream对象比较简单，不过我不推荐在数据库中存储二进制对象，那会使读取这个字段的时候会很慢。

Answer 4

'/////保存档案到数据库中
  Dim Auno As String '车辆号牌号码
  Dim Row As Long '页码号
  Dim FileName As String '
  Dim stm As New ADODB.Stream '二进制流
  Timer1.Enabled = False
  While Not L_rs.EOF
     Auno = L_rs!Auno
     Row = L_rs!inrow
     FileName = L_rs!fpath & L_rs!fname
     If stm.State <> adStateClosed Then
       stm.Close
     End If
     
     stm.Type = adTypeBinary
     stm.Open
    
    stm.LoadFromFile FileName
    G_Rs.AddNew
    G_Rs.Fields("Auno") = Trim(Auno)
    G_Rs.Fields("InRow") = Row
    G_Rs.Fields("APos") = Pos
    G_Rs.Fields("PageN").AppendChunk stm.Read
    G_Rs.Update
    stm.Close
    L_rs.MoveNext
     
  Wend
'////读出
 While Not G_Rs1.EOF
     Set L_rs = G_Conn.Execute("select * from Au_vehicles where Auno='" & G_Rs1!c_hphm & "' order by inrow asc")
        While Not L_rs.EOF
           If stm.State <> adStateClosed Then
              stm.Close
           End If
           stm.Type = adTypeBinary
           stm.Open
           stm.Write L_rs.Fields("PageN").GetChunk(L_rs.Fields("PageN").ActualSize)
           stm.SaveToFile TmpPath & "\tmp" & G_Rs1!c_hphm & L_rs!inrow & ".jpg", IIf(Len(Trim(Dir(TmpPath & "\tmp" & G_Rs1!c_hphm & L_rs!inrow & ".jpg", vbNormal + vbHidden))) > 0, adSaveCreateOverWrite, adSaveCreateNotExist)
           Dim st As String
           st = "insert into Au_temp  values ('" & L_rs!Auno & "','" & TmpPath & "\','" & "tmp" & G_Rs1!c_hphm & Trim(Str(L_rs!inrow)) & ".jpg'," & L_rs!inrow & ")"
           G_Conn.Execute (st)
           L_rs.MoveNext
        Wend
        G_Rs1.MoveNext
  Wend

Answer 5

在模块：
Sub SavePictureToAdodc(rs As ADODB.Recordset, ByVal FileName As String)
    Dim Length As Long, f As Integer
    Length = FileLen(FileName)
    
    ReDim bArray(Length + 12) As Byte, bArray2(Length) As Byte
    bArray(0) = &H6C: bArray(1) = &H74
    RtlMoveMemory bArray(4), Length, 4
    
    f = FreeFile
    Open FileName For Binary As #f
    Get #f, , bArray2
    Close #1
    
    RtlMoveMemory bArray(8), bArray2(0), Length
    
    rs("相片").AppendChunk bArray
End Sub
调用：
Private Sub Label2_Click()
On Error Resume NextWith CommonDialog1
     .CancelError = True
     .ShowOpen
     
If Err.Number <> cdlCancel Then   Image2.Picture = LoadPicture(.FileName)
SavePictureToAdodc Adodc1.Recordset, .FileNameEnd If
End WithEnd Sub

Answer 6

总结一下1。ADO2.5以上可以用ADO的Stream对象2。用AppendChund方法

Answer 7

谢谢各位！ Stream 对象最理想的了。但是存储图像那样大量数据，数据库访问速度就变慢了。怎样管理这样数据最好？ 有最好的解决方案吗？