VB中如何在数据库中插入图片？

Question

VB中如何在数据库中插入图片？

Answer 1

以前有人贴过Private Sub write_Click()
   Dim Cnn As New ADODB.Connection
   Dim Rs As New ADODB.Recordset
   Dim Rm As New ADODB.Command
   Dim mstream As New ADODB.Stream
   Dim str As String
   
   Cnn.ConnectionString = "Provider=MSDASQL.1;Password=admin;Persist Security Info=True;User ID=admin;Data Source=Test"
   Cnn.CursorLocation = adUseClient
   Cnn.Open
   Rs.Open "select * from a", Cnn, adOpenKeyset, adLockPessimistic
   mstream.Type = adTypeBinary
   mstream.Open
   mstream.LoadFromFile App.Path + "\a.gif"
   'On Error Resume Next
   Rs.AddNew
   mstream.Position = 1
   Rs.Fields(0).Value = mstream.Read
   Rs.Update
   Rs.Close
   Cnn.CloseEnd SubPrivate Sub read_Click()
    Dim Cnn As New ADODB.Connection
    Dim Rs As New ADODB.Recordset
    Dim Rm As New ADODB.Command
    Dim mstream As New ADODB.Stream
   
    Cnn.ConnectionString = "Provider=MSDASQL.1;Password=admin;Persist Security Info=True;User ID=admin;Data Source=Test"
    Cnn.CursorLocation = adUseClient
    Cnn.Open
    Rs.Open "select * from a", Cnn, adOpenKeyset, adLockOptimistic
    mstream.Type = adTypeBinary
    mstream.Open
    mstream.Write Rs.Fields("col").Value
    mstream.SaveToFile App.Path + "\doc3.doc", adSaveCreateOverWrite
    Rs.Close
    Cnn.Close
End Sub新建一个工程,添加 ado 控件,2个 Command ,1个 Picture,1个 ImageDim Chunk() As Byte
Dim lngLengh As Long
Dim intChunks As Integer
Dim intFragment As Integer
Const ChunkSize = 1000
Const lngDataFile = 1Private Sub cmdBrowse_Click()
    
    On Error Resume Next
    With cmdlFilePath
        .Filter = "JPG Files|*.JPG|Bitmaps|*.BMP"
        .ShowOpen
        txtFilePath.Text = .filename
    End With
End SubPrivate Sub Savepic()
    
    Open "c:\colordraw0094_m.jpg" For Binary Access Read As lngDataFile
    lngLengh = LOF(lngDataFile)
    If lngLengh = 0 Then Close lngDatafile: Exit Sub
    intChunks = lngLengh \ ChunkSize
    intFragment = lngLengh Mod ChunkSize
    
    'OpenData 打开数据库
    Dim i As Integer
    Dim rs As New ADODB.Recordset
    Dim strQ  As String
    
    If rs.State = adStateOpen Then rs.Close
    
    strQ = "Select * From [mydata]"
    rs.Open strQ, conn, adOpenStatic, adLockOptimistic
    
    On Error Resume Next
    
    rs.AddNew
    
    ReDim Chunk(intFragment)
    Get lngDataFile, , Chunk()
    rs.Fields("rs_photo1").AppendChunk Chunk()
    ReDim Chunk(ChunkSize)
    
    For i = 1 To intChunks
        Get lngDataFile, , Chunk()
        rs.Fields("rs_photo1").AppendChunk Chunk()
    Next i
    
    rs.Update
    rs.Close
    Close lngDataFile
    Call ShowPic
    
End SubPublic Sub ShowPic()    'OpenData 打开数据库
    Dim i As Integer
    Dim rs As New ADODB.Recordset
    Dim strQ, filename As String
    If rs.State = adStateOpen Then rs.Close    strQ = "Select * From [mydata]"
    rs.Open strQ, conn, adOpenStatic, adLockOptimistic
    If rs.EOF <> True Then
        rs.MoveLast
    Else
        Exit Sub
    End If
    On Error Resume Next
    Open "pictemp" For Binary Access Write As lngDataFile
        lngLengh = rs.Fields("rs_photo1").ActualSize
        intChunks = lngLengh \ ChunkSize
        intFragment = lngLengh Mod ChunkSize
        ReDim Chunk(intFragment)
        Chunk() = rs.Fields("rs_photo1").GetChunk(intFragment)
        Put lngDataFile, , Chunk()
        For i = 1 To intChunks
           ReDim Buffer(ChunkSize)
           Chunk() = rs.Fields("rs_photo1").GetChunk(ChunkSize)
           Put lngDataFile, , Chunk()
        Next i
    Close lngDataFile
    filename = "pictemp"
    Picture1.Picture = LoadPicture(filename)
    Image1.Stretch = True
    Image1.Picture = Picture1.Picture
    Kill filename
    
End SubPrivate Sub Command1_Click()
    
    SavepicEnd SubPrivate Sub Command2_Click()    ShowPic
    
End Sub