VB代码如下:'**************************读图片文件**************************************
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
'*********将数据库中的文件读到硬盘上*************************
' strTemp = App.Path + "\temp\" + rs1!Name '`临时文件,用来保存读出的图片 With stm
.Type = adTypeBinary
.Open
.Write rs1("tp").value
strTemp = App.Path & "\temp1\" & rs1!Name
.SaveToFile strTemp, adSaveCreateOverWrite
.Close
End With
Set itemX = lvwPic.ListItems.add(, App.Path & "\temp1\" & rs1!Name, rs1!Name, 1, 1)
itemX.SubItems(1) = rs1!bz
rs1.MoveNext
Wend
Set stm = Nothing
rs1.Close
Set rs1 = Nothing
End Sub'******************将图片文件保存到数据库中*************************
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
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
'*********将数据库中的文件读到硬盘上*************************
' strTemp = App.Path + "\temp\" + rs1!Name '`临时文件,用来保存读出的图片 With stm
.Type = adTypeBinary
.Open
.Write rs1("tp").value
strTemp = App.Path & "\temp1\" & rs1!Name
.SaveToFile strTemp, adSaveCreateOverWrite
.Close
End With
Set itemX = lvwPic.ListItems.add(, App.Path & "\temp1\" & rs1!Name, rs1!Name, 1, 1)
itemX.SubItems(1) = rs1!bz
rs1.MoveNext
Wend
Set stm = Nothing
rs1.Close
Set rs1 = Nothing
End Sub'******************将图片文件保存到数据库中*************************
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
解决方案 »
- 如何匹配分数段
- 查询一个表的时候,把重复的全部删除,只剩一项
- 排序问题
- 万分火急: sql2000远程访问能ping通,能ie访问,但就是远程访问不了sql 2000数据库啊?为什么??
- 求教:文件组对数据库的备份有什么帮助吗?
- 可以详细的描述一下什么是C/S结构吗?参与(提出见解)就给分
- 两个字段联合做主键的数据插入要怎么写
- 请高手写sql语句
- ODBC访问SQL Server 7问题求解(囊肿羞涩 只有22分)
- insert into table(varchar500) value ('一个长度大于256的字符串')为什么会被自动截断?
- 怎样测试,注册的远程服务器是可用的。
- 如何通过存储过程删除登陆
注:写图片文件到数据库
Col为栏位名,ImgFile为要写到数据库的图片文件名,BockSize为每次写多少字节,缺省为每次写8K字节到数据库
Public Sub WriteDB(Col As ADODB.Field, ImgFile As String, Optional BlockSize As Long=8192)
Dim byteData() As Byte, FileLength As Long, NumBlocks As Integer
Dim LeftOver As Long, SourceFileNum As Integer, i As Integer
SourceFileNum = FreeFile
Open ImgFile For Binary As SourceFileNum
FileLength = LOF(SourceFileNum)
If FileLength > 50 Then
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
ReDim byteData(LeftOver)
Get SourceFileNum, , byteData()
Col.AppendChunk byteData()
ReDim byteData(BlockSize)
For i = 1 To NumBlocks
Get SourceFileNum, , byteData()
Col.AppendChunk byteData()
Next
End If
Close SourceFileNum
End Sub
ImgFile为从数据库读出数据写到磁盘的文件名,BlockSize为每次向文件写多少个字节,缺省为8K字节,当ReadDB=True,得到图片文件後,可以用LoadPicter(图片文件名)显示图片到PictureBox或Image框中.
Public Function ReadDB(Col As ADODB.Field, ImgFile As String,Optional BlockSize As Long=8192) As Boolean
Dim byteData() As Byte, NumBlocks As Integer
Dim LeftOver As Long, DestFileNum As Integer, i As Integer
Dim ColSize As Long
On Error GoTo ErrRead
ReadDB = False
'If Dir(ImgFile) <> "" Then Kill ImgFile
DestFileNum = FreeFile
Open ImgFile For Binary As #DestFileNum
ColSize = Col.ActualSize
NumBlocks = ColSize \ BlockSize
LeftOver = ColSize Mod BlockSize
ReDim byteData(LeftOver)
byteData() = Col.GetChunk(LeftOver)
Put DestFileNum, , byteData()
ReDim byteData(BlockSize)
For i = 1 To NumBlocks
byteData() = Col.GetChunk(BlockSize)
Put #DestFileNum, , byteData()
Next
If LOF(DestFileNum) > 200 Then ReadDB = True
Close #DestFileNum
Exit Function
ErrRead:
MsgBox "READ PICTURE ERR:" & Err.Number
ReadDB = False
Exit Function
End Function//如果ReadDB=False则写文件失败。
'**
'** 使用 ADODB.Stream 保存/读取文件到数据库
'** 引用 Microsoft ActiveX Data Objects 2.5 Library 及以上版本
'**
'** ----- 数据库连接字符串模板 ---------------------------------------
'** ACCESS数据库
'** iConcStr = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
'** ";Data Source=数据库名"
'**
'** SQL数据库
'** iConcStr = "Provider=SQLOLEDB.1;Persist Security Info=True;" & _
'** "User ID=用户名;Password=密码;Initial Catalog=数据库名;Data Source=SQL服务器名"
'**
'*************************************************************************
'
'保存文件到数据库中
Sub s_SaveFile()
Dim iStm As ADODB.Stream
Dim iRe As ADODB.Recordset
Dim iConcStr As String
'数据库连接字符串
iConcStr = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
";Data Source=F:\My Documents\客户资料1.mdb"
'读取文件到内容
Set iStm = New ADODB.Stream
With iStm
.Type = adTypeBinary '二进制模式
.Open
.LoadFromFile "c:\test.doc"
End With
'打开保存文件的表
Set iRe = New ADODB.Recordset
With iRe
.Open "表", iConc, adOpenKeyset, adLockOptimistic
.AddNew '新增一条记录
.Fields("保存文件内容的字段") = iStm.Read
.Update
End With
'完成后关闭对象
iRe.Close
iStm.Close
End Sub'从数据库中读取数据,保存成文件
Sub s_ReadFile()
Dim iStm As ADODB.Stream
Dim iRe As ADODB.Recordset
Dim iConc As String
'数据库连接字符串
iConc = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
";Data Source=\\xz\c$\Inetpub\zj\zj\zj.mdb"
'打开表
Set iRe = New ADODB.Recordset
iRe.Open "tb_img", iConc, adOpenKeyset, adLockReadOnly
iRe.Filter = "id=64"
'保存到文件
Set iStm = New ADODB.Stream
With iStm
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write iRe("img")
.SaveToFile "c:\test.doc"
End With
'关闭对象
iRe.Close
iStm.Close
End Sub
'在form1上放一个图片控件,写上如下代码'注意根据你的情况适当调整.Dim Re As ADODB.RecordsetPrivate Sub Form_Load()
Set Re = New ADODB.Connection
With Re
.Open "保存图片的表", "数据库连接字符串", adOpenKeyset, adLockOptimistic
Set Picture1.DataSource = Re
Picture1.DataField = "图片字段名"
End With
End SubPrivate Sub Form_Unload(Cancel As Integer)
Re.Close
Set Re = Nothing
End Sub