用ADO的AppendChunk方法存入,相反的,读出用GetAppendChunk。
数据库字段应该是Image或Text型。
AppendChunk and GetChunk Methods Example This example uses the AppendChunk and GetChunk methods to fill an image field with data from another record, 32K at a time. In a real application, one might use a procedure like this to copy a record containing a photo or graphic image field from one table to another. In this example, the record is simply being copied back to same table. Note that all the chunk manipulation takes place within a single AddNew-Update sequence. Public Sub AppendChunkX() Dim cnn1 As ADODB.Connection
Dim rstPubInfo As ADODB.Recordset
Dim strCnn As String
Dim strPubID As String
Dim strPRInfo As String
Dim lngOffset As Long
Dim lngLogoSize As Long
Dim varLogo As Variant
Dim varChunk As Variant

Const conChunkSize = 100 ' Open a connection.
Set cnn1 = New ADODB.Connection
strCnn = "driver={SQL Server};server=srv;" & _
"uid=sa;pwd=;database=pubs"
cnn1.Open strCnn

' Open the pub_info table.
Set rstPubInfo = New ADODB.Recordset
rstPubInfo.CursorType = adOpenKeyset
rstPubInfo.LockType = adLockOptimistic
rstPubInfo.Open "pub_info", cnn1, , , adCmdTable

' Prompt for a logo to copy.
strMsg = "Available logos are : " & vbCr & vbCr
Do While Not rstPubInfo.EOF
strMsg = strMsg & rstPubInfo!pub_id & vbCr & _
Left(rstPubInfo!pr_info, InStr(rstPubInfo!pr_info, ",") - 1) & _
vbCr & vbCr
rstPubInfo.MoveNext
Loop
strMsg = strMsg & "Enter the ID of a logo to copy:"
strPubID = InputBox(strMsg)

' Copy the logo to a variable in chunks.
rstPubInfo.Filter = "pub_id = '" & strPubID & "'"
lngLogoSize = rstPubInfo!logo.ActualSize
Do While lngOffset < lngLogoSize
varChunk = rstPubInfo!logo.GetChunk(conChunkSize)
varLogo = varLogo & varChunk
lngOffset = lngOffset + conChunkSize
Loop

' Get data from the user.
strPubID = Trim(InputBox("Enter a new pub ID:"))
strPRInfo = Trim(InputBox("Enter descriptive text:"))

' Add a new record, copying the logo in chunks.
rstPubInfo.AddNew
rstPubInfo!pub_id = strPubID
rstPubInfo!pr_info = strPRInfo lngOffset = 0   ' Reset offset.
Do While lngOffset < lngLogoSize
varChunk = LeftB(RightB(varLogo, lngLogoSize - lngOffset), _
conChunkSize)
rstPubInfo!logo.AppendChunk varChunk
lngOffset = lngOffset + conChunkSize
Loop
rstPubInfo.Update

 ' Show the newly added data.
MsgBox "New record: " & rstPubInfo!pub_id & vbCr & _
"Description: " & rstPubInfo!pr_info & vbCr & _
"Logo size: " & rstPubInfo!logo.ActualSize ' Delete new record because this is a demonstration.
rstPubInfo.Requery
cnn1.Execute "DELETE FROM pub_info " & _
"WHERE pub_id = '" & strPubID & "'" rstPubInfo.Close
cnn1.Close End Sub

解决方案 »

  1.   

    给2个vb的例子给你
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim stm As ADODB.StreamPrivate Sub SavePictureToDB(cn As ADODB.Connection)
    '将BMP图片存入数据库
    On Error GoTo EH
        Set stm = New ADODB.Stream
        rs.Open "select ImagePath,ImageValue from tbl_Image", cn, adOpenKeyset, adLockOptimistic
        CommonDialog1.ShowOpen
        Text1.Text = CommonDialog1.FileName
        
        With stm
             .Type = adTypeBinary
             .Open
             .LoadFromFile CommonDialog1.FileName
        End With
        With rs
             .AddNew
             .Fields("ImagePath") = Text1.Text
             .Fields("ImageValue") = stm.Read
             .Update
        End With
        rs.Close
        Set rs = Nothing
    Exit Sub
    EH: MsgBox Err.Description, vbInformation, "Error"
    End Sub
    Private Sub LoadPictureFromDB(cn As ADODB.Connection)
    '载数据库中读出BMP图片
    On Error GoTo EH
        Dim strTemp As String
        Set stm = New ADODB.Stream
        strTemp = "c:\temp.tmp" '临时文件,用来保存读出的图片
        rs.Open "select ImagePath,ImageValue  from tbl_image", cn, , , adCmdText
        With stm
            .Type = adTypeBinary
            .Open
            .Write rs("ImageValue")
            .SaveToFile strTemp, adSaveCreateOverWrite
            .Close
        End With
        Image1.Picture = LoadPicture(strTemp)
        Set stm = Nothing
        rs.Close
        Set rs = Nothing
    Exit Sub
    EH: MsgBox Err.Description, vbInformation, "Error"
    End Sub
    image类型
    用picture显示
    '以下两个函数是从数据库中读出图片的核心程序Public Function GetImage(Optional Filename As String) As Variant
    On Error GoTo ProcErr  Dim objRS As adodb.Recordset
      Dim strSQL As String
      Dim Chunk() As Byte
     
      Set objRS = New adodb.Recordset
      
      'strSQL = "select thumb from tblpictures where idpict='" & tblID(ThumbIndex) & "'"
      strSQL = "select thumb from tblpictures where idpict= " & thumb
      'strSQL = "select thumb from tblpictures where idpict='387'"
      'db.Execute strSQL
      objRS.Open strSQL, db, adOpenForwardOnly, adLockReadOnly
      
      If objRS.BOF And objRS.EOF Then
        GetImage = 0
        GoTo ProcExit
      ElseIf IsNull(objRS.Fields(0)) Then
        'ErrNumber = 1001
        'ErrDesc = "字段为空"
        GoTo ProcExit
      End If
      
      Chunk() = objRS.Fields(0).GetChunk(objRS.Fields(0).ActualSize)
      Set GetImage = Chunk2Image(Chunk(), Filename)ProcExit:
      On Error Resume Next
      'objRS.Close
       ' Chunk() = objRS.Fields(0).GetChunk(0)
        Set GetImage = Chunk2Image(Chunk(), Filename)
     ' Set objRS = Nothing  Exit FunctionProcErr:
      GetImage = 0
      Resume ProcExit
    End Function
    Private Function Chunk2Image(Chunk() As Byte, Optional Filename As String) As Variant
    On Error GoTo ProcErr
    Dim KeepFile As Boolean
    Dim Datafile As Integer    KeepFile = True
        If Trim(Filename) = "" Then
          Filename = "c:\tmpxxdb.fil"
          KeepFile = False
        End If    Datafile = FreeFile
        Open Filename For Binary Access Write As Datafile
          Put Datafile, , Chunk()
        Close DatafileProcExit:
      Set Chunk2Image = LoadPicture(Filename)
      On Error Resume Next
    '  If Not KeepFile Then Kill filename
      Exit FunctionProcErr:
      On Error Resume Next
      Kill Filename
      Chunk2Image = 0
    End Function