|
'********************
'给数据库字段写入图片
'********************
Function ImgSave(ByRef Fld As ADODB.Field, ImgName As String)
Dim byteData() As Byte '定义数据块数组
Dim NumBlocks As Long '定义数据块个数
Dim FileLength As Long '标识文件长度
Dim LeftOver As Long '定义剩余字节长度
Dim SourceFile As Long '定义自由文件号
Const BlockSize = 4096 '每次读写图片块的大小
On Error Resume Next
SourceFile = FreeFile '提供一个尚未使用的文件号
Open ImgName For Binary Access Read As SourceFile '打开文件
FileLength = LOF(SourceFile) '得到文件长度
If FileLength = 0 Then '判断文件是否存在
Close SourceFile
MsgBox ImgName & "未选用新的图片或图片不存在，图片未作修改！", vbExclamation, "警告！"
Check = False
Else
NumBlocks = FileLength \ BlockSize '得到数据块的个数
LeftOver = FileLength Mod BlockSize '得到剩余字节数
Fld.Value = Null
ReDim byteData(BlockSize) '重新定义数据块的大小
For i = 1 To NumBlocks
Get SourceFile, , byteData() '读到内存块中
Fld.AppendChunk byteData() '写入FLD
Next i
ReDim byteData(LeftOver) '重新定义数据块的大小
Get SourceFile, , byteData() '读到内存块中
Fld.AppendChunk byteData() '写入FLD
Close SourceFile '关闭源文件
End If
End Function
'********************
'从数据库字段读出图片
'********************
Function ImgShow(ByRef Fld As ADODB.Field)
Dim Chunk() As Byte
Dim lngLengh As Long '图片文件的实际长度
Dim intChunks As Integer
Dim intFragment As Integer
Const ChunkSize = 4096
Const lngDataFile = 1
On Error Resume Next
Open "pictemp" For Binary Access Write As lngDataFile
lngLengh = Fld.ActualSize '取得图片数据（字段值的实际长度）
If lngLengh > 0 Then
intChunks = lngLengh \ ChunkSize
intFragment = lngLengh Mod ChunkSize
ReDim Chunk(intFragment)
Chunk() = Fld.GetChunk(intFragment)
Put lngDataFile, , Chunk()
For i = 1 To intChunks
ReDim Buffer(ChunkSize)
Chunk() = Fld.GetChunk(ChunkSize)
'建立图片临时文件
Put lngDataFile, , Chunk()
Next i
Close lngDataFile
ImgName = "pictemp"
End If
End Function
[replyview]======================================
#1 VB之将图片以二进制格式导入数据库实现图片加密
Option Explicit
??'by lecky
??'将图片导入数据库实现加密
??'2005-12-15
??'界面控件
??'commondialog1，command1，command2
??'引用ADO2.5
??Private cn As New ADODB.Connection
??Private fName As String
??
??Private Sub Command1_Click()
?? With CommonDialog1
?? .Filter = "图片|*.jpg"
?? .ShowOpen
?? '通用对话框设置
?? If .FileName <> "" Then
?? fName = Mid(.FileName, InStrRev(.FileName, "\") + 1)
?? '该变量存储该图片文件名
?? Image1.Picture = LoadPicture(.FileName)
?? Dim fn As Integer
?? '定义文件号
?? Dim b() As Byte
?? '该数组为字节类型
?? fn = FreeFile
?? ReDim b(FileLen(.FileName))
?? '定义存储图片的数组
?? Open .FileName For Binary As #fn
?? '以二进制格式打开
?? Get #fn, , b
?? Close #fn
?? Dim rs As New ADODB.Recordset
?? rs.Open "T1", cn, adOpenDynamic, adLockOptimistic
?? rs.AddNew
?? rs.Fields("Name") = Mid(.FileName, InStrRev(.FileName, "\") + 1)
?? 'mid函数段，去除路径，去文件名
?? rs.Fields("Data") = b
?? rs.Update
?? rs.Close
?? End If
?? End With
??End Sub
??
??Private Sub Command2_Click()
?? Dim fn As Integer
?? Dim b() As Byte
?? Dim rs As New ADODB.Recordset
?? Set rs = cn.Execute("select * from T1 where name='" & fName & "'")
?? ReDim b(rs.Fields("Data").ActualSize)
?? '定义数组长度
?? b = rs.Fields("Data") & ""
?? fn = FreeFile
?? Open App.Path & "\t" For Binary As #fn
?? '临时文件t保存数据库取出的图
?? Put #fn, , b
?? Close #fn
?? Image2.Picture = LoadPicture(App.Path & "\t")
?? Kill App.Path & "\t"
?? '删除该临时文件
??End Sub
??
??Private Sub Form_Load()
?? With cn
?? .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb;Persist Security Info=False"
?? '本例以access数据库为例，建立一个名为db1的数据库，并存在一个名为T1的表，其中有两个字段name与data
?? .CursorLocation = adUseClient
?? .Open
?? End With
??End Sub [/replyview]
| 
