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

[永远专注NET]

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

[gpo2002]

以前有人贴过

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.Close

End Sub

Private 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个 Image

Dim Chunk() As Byte
Dim lngLengh As Long
Dim intChunks As Integer
Dim intFragment As Integer
Const ChunkSize = 1000
Const lngDataFile = 1

Private Sub cmdBrowse_Click()

On Error Resume Next
With cmdlFilePath
.Filter = "JPG Files|*.JPG|Bitmaps|*.BMP"
.ShowOpen
txtFilePath.Text = .filename
End With
End Sub

Private 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 Sub

Public 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 Sub

Private Sub Command1_Click()

Savepic

End Sub

Private Sub Command2_Click()

ShowPic

End Sub

[planetike]

翻以前的帖子,有例子的