VB6 保存和读取图片到数据库
dim stm as ADODB.Stream
dim rs as ADODB.Recordset
sub SavePictureToDB(cn As ADODB.Connection)
'将图片存入数据库
On Error GoTo EH
Set stm = New ADODB.Stream
rs.Open "select ImagePath,ImageValue from tbl_Image", cn, adOpenKeyset, adLockOptimistic
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName
With stm
.Type = adTypeBinary
.Open
.LoadFromFile CommonDialog1.FileName
End With
With rs
.AddNew
.Fields("ImagePath") = Text1.Text
.Fields("ImageValue") = stm.Read
.Update
End With
rs.Close
Set rs = Nothing
Exit Sub
EH: MsgBox Err.Description, vbInformation, "Error"
End Sub
Sub LoadPictureFromDB(cn As ADODB.Connection)
'载数据库中读出图片
On Error GoTo EH
Dim strTemp As String
Set stm = New ADODB.Stream
strTemp = "c:/temp.tmp" '临时文件,用来保存读出的图片
rs.Open "select ImagePath,ImageValue from tbl_image", cn, , , adCmdText
With stm
.Type = adTypeBinary
.Open
.Write rs("ImageValue")
.SaveToFile strTemp, adSaveCreateOverWrite
.Close
End With
Image1.Picture = LoadPicture(strTemp)
Set stm = Nothing
rs.Close
Set rs = Nothing
Exit Sub
EH: MsgBox Err.Description, vbInformation, "Error"
End Sub
也可用FileSystemObject的方式来保存
Dim Sql As String
Dim fs As New FileSystemObject
Sub SavePicture()
Dim sByte() As Byte
Dim bIsNull As Boolean
If fs.FileExists(g_FilePath) Then
Open g_FilePath For Binary Access Read As #1
ReDim sByte(1 To LOF(1))
Get #1, 1, sByte()
Close #1
bIsNull = False
Else
bIsNull = True
End If
Dim rs As New ADODB.Recordset
rs.Open "select empid,empname,pic from emp where empid = '" & Trim(txtEmpId.Text) & "'", cn, adOpenStatic, adLockOptimistic
rs.AddNew
rs!EmpId = txtEmpId.Text
rs!EmpName = txtEmpName.Text
If bIsNull <> True Then
rs!pic = sByte
End If
rs.Update
MsgBox "save data ok!"
txtEmpId.Text = ""
txtEmpName.Text = ""
Set picView.Picture = Nothing
cmdAdd.Enabled = True
End Sub
Sub viewJpg()
Dim TmpFile As String
Dim jByte() As Byte
Sql = "select * from emp"
Set rsViewJpg = New ADODB.Recordset
rsViewJpg.Open Sql, cn, adOpenStatic, adLockOptimistic
rsViewJpg.MoveFirst
If Not rsViewJpg.BOF Then
If Not rsViewJpg.EOF Then
txtEmpId.Text = rsViewJpg!EmpId
txtEmpName.Text = rsViewJpg!EmpName
Set pic.Picture = Nothing
If Not fs.FolderExists(App.Path + "/temp") Then
fs.CreateFolder (App.Path + "/temp")
End If
TmpFile = App.Path + "/Temp/" + rsViewJpg.Fields(0) + ".jpg"
If Not IsNull(rsViewJpg!pic) Then
jByte = rsViewJpg!pic
Open TmpFile For Binary Access Write As #1
Put #1, , jByte
Close #1
pic.Picture = LoadPicture(TmpFile)
End If
End If
End If
End Sub
一般把jpg图片保存在文件夹,数据库中存放对应路径,读取时从数据库取出路径,再找到该jpg图片
Private Sub Command1_Click()
Dim FileNames As String, FileNumber As Integer, Sql As String
With CommonDialog1
.ShowOpen
FileNames = .FileName
.CancelError = False
End With
With Rs
If .State = 1 Then
.Filter = 0
.Close
End If
Sql = "Select * From Table1"
.Open Sql, Conn, 3, 2
Sql = "delete from table1"
Conn.Execute Sql
If Trim(FileNames) <> "" Then
FileNumber = FreeFile
Open FileNames For Binary As FileNumber
ReDim WordFileBinCode(LOF(FileNumber))
While Not EOF(FileNumber)
DoEvents
Get FileNumber, , WordFileBinCode
Wend
Close FileNumber
.AddNew
.Fields(FieldsNumber) = Right(FileNames, 3)
.Fields(FieldsNumber + 1).AppendChunk WordFileBinCode
.Update
MsgBox "数据存储完毕"
End If
End With
End SubPrivate Sub Command2_Click()
Dim FileNumber As Integer, SaveName As String
FileNumber = FreeFile
With Rs
If .State = 1 Then
.Filter = 0
.Close
End If
Sql = "Select * From Table1"
.Open Sql, Conn, 3, 2
Debug.Print Rs("extname")
ReDim WordFileBinCode(.Fields(FieldsNumber).ActualSize)
Rs.MoveLast
CommonDialog1.ShowSave
SaveName = CommonDialog1.FileName + "." + Trim(Rs("ExtName"))
Open SaveName For Binary As FileNumber
WordFileBinCode() = .Fields("binCOde").GetChunk(.Fields("BinCode").ActualSize)
Put FileNumber, , WordFileBinCode()
Close FileNumber
End With
MsgBox "从数据库中读取记录完毕"
End SubPrivate Sub Form_Load()
Dim ConnStr As String
ConnStr = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=sa;Initial Catalog=SaveBin;Data Source=(local)"
Conn.Open ConnStr
FieldsNumber = 0
End SubPrivate Sub Form_Unload(Cancel As Integer)
If Rs.State = 1 Then
Rs.Filter = 0
Rs.Close
End If
Conn.Close
Set Rs = Nothing
Set Conn = Nothing
End Sub
使用二进制存入读取