该范例使用 AppendChunk 和 GetChunk 方法用其他记录中的数据填写图像字段。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
图片放到SQL Server的数据库中 'Use ADODB.Stream Method 'After ADO 2.6 'Import the Image to SQLServer 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"
End Sub 'Display the image on image control 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 存入ACCESS数据库中: Dim rs As New ADODB.Recordset Dim Rss As New ADODB.Stream Dim cnn As ADODB.Connection Dim cnstr As String cnstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\pic.mdb;Mode=ReadWrite;Persist Security Info=False" Set cnn = New ADODB.Connection cnn.Open cnstr rs.Open "test", cnn, adOpenStatic, adLockOptimistic Rss.Type = adTypeBinary Rss.Open Rss.LoadFromFile App.Path & "\1.jpg" rs.AddNew rs.Fields("a1") = "PICTURE" rs.Fields("a2") = Rss.Read rs.Update rs.Close cnn.Closea2的类型为OLE 读取: Dim rs As New ADODB.Recordset Dim Rss As New ADODB.Stream Dim cnn As ADODB.Connection Dim cnstr As String cnstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\pic.mdb;Mode=ReadWrite;Persist Security Info=False" Set cnn = New ADODB.Connection cnn.Open cnstr rs.Open "test", cnn, adOpenStatic, adLockOptimistic Rss.Type = adTypeBinary Rss.Open If Not rs.EOF Then Rss.Write rs.Fields("a2") Rss.SaveToFile App.Path & "\tmp.jpg" ‘存为硬盘文件 Picture1.Picture = LoadPicture(App.Path & "\tmp.jpg") Kill App.Path & "\tmp.jpg" End If rs.Close cnn.Close 如果要存别的类型,用类似的方法。 Dim Chunk() As Byte Chunk() = Image2Chunk(Filename)
.Fields("thumb").AppendChunk Chunk() .Update Private Function Image2Chunk(Filename As String) As Variant On Error GoTo ProcErr Dim Datafile As Integer Dim FileLength As Long Dim Chunk() As Byte
Datafile = FreeFile Open Filename For Binary Access Read As Datafile FileLength = LOF(Datafile) If FileLength = 0 Then GoTo ProcErr ReDim Chunk(FileLength) Get Datafile, , Chunk() Close Datafile
ProcExit: Image2Chunk = Chunk() Exit FunctionProcErr: Image2Chunk = 0 End Function
'******************将图片文件保存到数据库中************************* Sub SavePicToDb(cn As ADODB.Connection, table1 As String, field1 As String, file1 As String, id1 As String) On Error Resume Next Dim stm As ADODB.Stream Set stm = New ADODB.Stream Set rs1 = New ADODB.Recordset rs1.Open "select * from " & table1 & " where id = " & id1, cn, adOpenKeyset, adLockOptimistic With stm .Type = adTypeBinary .Open .LoadFromFile file1 'DLG.FileName End With With rs1 .Fields(field1) = stm.Read .Update End With rs1.Close Set rs1 = Nothing End Sub
'*************************************************************** '*从数据库中相应的表里边读取该合同的所有图片 '*并将他们保存到当前路径下面的temp目录下边 '*文件名用在表中保存的文件名 '**************************************************************** Sub GetPicFromDB(cn As ADODB.Connection) On Error Resume Next Dim fld As Field Dim strTemp As String Dim stm As ADODB.Stream Set stm = New ADODB.Stream 'strTemp = "c:\temp.bmp" Set rs1 = New ADODB.Recordset rs1.Open "select * from rs_http where htbh='" & frm_manage.Grid2.TextMatrix(frm_manage.Grid2.RowSel, 0) & "'", cn, , , adCmdText While Not rs1.EOF With stm .Type = adTypeBinary .Open .Write rs1("tp").value strTemp = App.Path & "\temp1\" & rs1!Name .SaveToFile strTemp, adSaveCreateOverWrite .Close End With
rs1.MoveNext Wend Set stm = Nothing rs1.Close Set rs1 = Nothing End Sub
'*************************************************************** '*从数据库中相应的表里边读取该合同的所有图片 '*并将他们保存到当前路径下面的temp目录下边 '*文件名用在表中保存的文件名 '**************************************************************** Sub GetPicFromDB(cn As ADODB.Connection) On Error Resume Next Dim fld As Field Dim strTemp As String Dim stm As ADODB.Stream Set stm = New ADODB.Stream 'strTemp = "c:\temp.bmp" Set rs1 = New ADODB.Recordset rs1.Open "select * from rs_http where htbh='" & frm_manage.Grid2.TextMatrix(frm_manage.Grid2.RowSel, 0) & "'", cn, , , adCmdText While Not rs1.EOF With stm .Type = adTypeBinary .Open .Write rs1("tp").value strTemp = App.Path & "\temp1\" & rs1!Name .SaveToFile strTemp, adSaveCreateOverWrite .Close End With
rs1.MoveNext Wend Set stm = Nothing rs1.Close Set rs1 = Nothing End Sub
很简单:数据库中相应字段用image类型 Dim spic As ADODB.Stream 'strMyFile为取得的图片路径 If strMyFile <> "" Then spic.LoadFromFile strMyFile rstRec.Fields("图片").Value = spic.Read End If rstRec.updatebatch
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 ' 打开连接。
Set cnn1 = New ADODB.Connection
strCnn = "Provider=sqloledb;" & _
"Data Source=srv;Initial Catalog=pubs;User Id=sa;Password=; "
cnn1.Open strCnn
' 打开 pub_info 表。
Set rstPubInfo = New ADODB.Recordset
rstPubInfo.CursorType = adOpenKeyset
rstPubInfo.LockType = adLockOptimistic
rstPubInfo.Open "pub_info", cnn1, , , adCmdTable
' 提示复制徽标。
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)
' 将徽标大块复制到变量中。
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
' 从用户处得到数据。
strPubID = Trim(InputBox("Enter a new pub ID:"))
strPRInfo = Trim(InputBox("Enter descriptive text:"))
' 添加新记录,大块复制徽标。
rstPubInfo.AddNew
rstPubInfo!pub_id = strPubID
rstPubInfo!pr_info = strPRInfo lngOffset = 0 ' 重置位移。
Do While lngOffset < lngLogoSize
varChunk = LeftB(RightB(varLogo, lngLogoSize - lngOffset), _
conChunkSize)
rstPubInfo!logo.AppendChunk varChunk
lngOffset = lngOffset + conChunkSize
Loop
rstPubInfo.Update
' 显示新添加的数据。
MsgBox "New record: " & rstPubInfo!pub_id & vbCr & _
"Description: " & rstPubInfo!pr_info & vbCr & _
"Logo size: " & rstPubInfo!logo.ActualSize ' 删除新记录,因为这只是演示。
rstPubInfo.Requery
cnn1.Execute "DELETE FROM pub_info " & _
"WHERE pub_id = '" & strPubID & "'" rstPubInfo.Close
cnn1.Close End Sub
上边有搜索
另外我以前是在数据库里存图片的路径
数据库里存图片的路径不是我想用的方法,我想使用长二进制来存储的!
'Use ADODB.Stream Method
'After ADO 2.6
'Import the Image to SQLServer
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
'Display the image on image control
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
存入ACCESS数据库中:
Dim rs As New ADODB.Recordset
Dim Rss As New ADODB.Stream
Dim cnn As ADODB.Connection
Dim cnstr As String
cnstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\pic.mdb;Mode=ReadWrite;Persist Security Info=False"
Set cnn = New ADODB.Connection
cnn.Open cnstr
rs.Open "test", cnn, adOpenStatic, adLockOptimistic
Rss.Type = adTypeBinary
Rss.Open
Rss.LoadFromFile App.Path & "\1.jpg"
rs.AddNew
rs.Fields("a1") = "PICTURE"
rs.Fields("a2") = Rss.Read
rs.Update
rs.Close
cnn.Closea2的类型为OLE
读取:
Dim rs As New ADODB.Recordset
Dim Rss As New ADODB.Stream
Dim cnn As ADODB.Connection
Dim cnstr As String
cnstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\pic.mdb;Mode=ReadWrite;Persist Security Info=False"
Set cnn = New ADODB.Connection
cnn.Open cnstr
rs.Open "test", cnn, adOpenStatic, adLockOptimistic
Rss.Type = adTypeBinary
Rss.Open
If Not rs.EOF Then
Rss.Write rs.Fields("a2")
Rss.SaveToFile App.Path & "\tmp.jpg" ‘存为硬盘文件
Picture1.Picture = LoadPicture(App.Path & "\tmp.jpg")
Kill App.Path & "\tmp.jpg"
End If
rs.Close
cnn.Close
如果要存别的类型,用类似的方法。
Dim Chunk() As Byte
Chunk() = Image2Chunk(Filename)
.Fields("thumb").AppendChunk Chunk()
.Update
Private Function Image2Chunk(Filename As String) As Variant
On Error GoTo ProcErr
Dim Datafile As Integer
Dim FileLength As Long
Dim Chunk() As Byte
Datafile = FreeFile
Open Filename For Binary Access Read As Datafile
FileLength = LOF(Datafile)
If FileLength = 0 Then GoTo ProcErr
ReDim Chunk(FileLength)
Get Datafile, , Chunk()
Close Datafile
ProcExit:
Image2Chunk = Chunk()
Exit FunctionProcErr:
Image2Chunk = 0
End Function
'******************将图片文件保存到数据库中*************************
Sub SavePicToDb(cn As ADODB.Connection, table1 As String, field1 As String, file1 As String, id1 As String)
On Error Resume Next
Dim stm As ADODB.Stream
Set stm = New ADODB.Stream
Set rs1 = New ADODB.Recordset
rs1.Open "select * from " & table1 & " where id = " & id1, cn, adOpenKeyset, adLockOptimistic
With stm
.Type = adTypeBinary
.Open
.LoadFromFile file1 'DLG.FileName
End With
With rs1
.Fields(field1) = stm.Read
.Update
End With
rs1.Close
Set rs1 = Nothing
End Sub
'*从数据库中相应的表里边读取该合同的所有图片
'*并将他们保存到当前路径下面的temp目录下边
'*文件名用在表中保存的文件名
'****************************************************************
Sub GetPicFromDB(cn As ADODB.Connection)
On Error Resume Next
Dim fld As Field
Dim strTemp As String
Dim stm As ADODB.Stream
Set stm = New ADODB.Stream
'strTemp = "c:\temp.bmp"
Set rs1 = New ADODB.Recordset
rs1.Open "select * from rs_http where htbh='" & frm_manage.Grid2.TextMatrix(frm_manage.Grid2.RowSel, 0) & "'", cn, , , adCmdText
While Not rs1.EOF
With stm
.Type = adTypeBinary
.Open
.Write rs1("tp").value
strTemp = App.Path & "\temp1\" & rs1!Name
.SaveToFile strTemp, adSaveCreateOverWrite
.Close
End With
rs1.MoveNext
Wend
Set stm = Nothing
rs1.Close
Set rs1 = Nothing
End Sub
'*从数据库中相应的表里边读取该合同的所有图片
'*并将他们保存到当前路径下面的temp目录下边
'*文件名用在表中保存的文件名
'****************************************************************
Sub GetPicFromDB(cn As ADODB.Connection)
On Error Resume Next
Dim fld As Field
Dim strTemp As String
Dim stm As ADODB.Stream
Set stm = New ADODB.Stream
'strTemp = "c:\temp.bmp"
Set rs1 = New ADODB.Recordset
rs1.Open "select * from rs_http where htbh='" & frm_manage.Grid2.TextMatrix(frm_manage.Grid2.RowSel, 0) & "'", cn, , , adCmdText
While Not rs1.EOF
With stm
.Type = adTypeBinary
.Open
.Write rs1("tp").value
strTemp = App.Path & "\temp1\" & rs1!Name
.SaveToFile strTemp, adSaveCreateOverWrite
.Close
End With
rs1.MoveNext
Wend
Set stm = Nothing
rs1.Close
Set rs1 = Nothing
End Sub
那我在查询分析器里建表的时候定义 图象字段名 该给它什么类型呢。
http://support.microsoft.com/default.aspx?scid=kb;EN-US;258038
Dim spic As ADODB.Stream
'strMyFile为取得的图片路径
If strMyFile <> "" Then
spic.LoadFromFile strMyFile
rstRec.Fields("图片").Value = spic.Read
End If
rstRec.updatebatch