转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
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
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
还有个问题,我想问一下ADODB.Stream是在哪个引用当中。