用VB6读写数据库中的图片

核心提示：很多兄弟在这里问关于VB6读写数据库中的图片的问题，在此有一例，用VB6读写数据库中的图片，希有所启发， 1，将picture改为lob即可， 2，以人名和相关图片为例说明，数据库为access

很多兄弟在这里问关于VB6读写数据库中的图片的问题，在此有一例，希有所启发。
　 1，以人名和相关图片为例说明，数据库为access，有如下字段：Name char,picture OLE object,FileLength
Number。当为ms sql时，将picture改为lob即可。
　 2，示例包含control：commom dialog,picture,listbox。
源码如下：
Option Explicit

PRivate Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As
String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long,
ByVal lpBuffer As String) As Long
Private Const MAX_PATH = 260

Private m_DBConn As ADODB.Connection

Private Const BLOCK_SIZE = 10000
' Return a temporary file name.
Private Function TemporaryFileName() As String
Dim temp_path As String
Dim temp_file As String
Dim length As Long

　　' Get the temporary file path.
　　temp_path = Space$(MAX_PATH)
　　length = GetTempPath(MAX_PATH, temp_path)
　　temp_path = Left$(temp_path, length)

　　' Get the file name.
　　temp_file = Space$(MAX_PATH)
　　GetTempFileName temp_path, "per", 0, temp_file
　　TemporaryFileName = Left$(temp_file, InStr(temp_file, Chr$(0)) - 1)
End Function
Private Sub Form_Load()
Dim db_file As String
Dim rs As ADODB.Recordset

　　' Get the database file name.
　　db_file = App.Path
　　If Right$(db_file, 1) <> "\" Then db_file = db_file & "\"
　　db_file = db_file & "dbpict.mdb"

　　' Open the database connection.
　　Set m_DBConn = New ADODB.Connection
　　m_DBConn.Open _
　　　　"Provider=Microsoft.Jet.OLEDB.4.0;" & _
　　　　"Data Source=" & db_file & ";" & _
　　　　"Persist Security Info=False"

　　' Get the list of people.
　　Set rs = m_DBConn.Execute("SELECT Name FROM People ORDER BY Name", , adCmdText)
　　Do While Not rs.EOF
　　　　lstPeople.AddItem rs!Name
　　　　rs.MoveNext
　　Loop

　　rs.Close
　　Set rs = Nothing
End Sub
Private Sub Form_Resize()
　　lstPeople.Height = ScaleHeight
End Sub


' Display the clicked person.
Private Sub lstPeople_Click()
Dim rs As ADODB.Recordset
Dim bytes() As Byte
Dim file_name As String
Dim file_num As Integer
Dim file_length As Long
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long
Dim hgt As Single

　　picPerson.Visible = False
　　Screen.MousePointer = vbHourglass
　　DoEvents

　　' Get the record.
　　Set rs = m_DBConn.Execute("SELECT * FROM People WHERE Name='" & _
　　　　lstPeople.Text & "'", , adCmdText)
　　If rs.EOF Then Exit Sub

　　' Get a temporary file name.
　　file_name = TemporaryFileName()

　　' Open the file.
　　file_num = FreeFile
　　Open file_name For Binary As #file_num

　　' Copy the data into the file.
　　file_length = rs!FileLength
　　num_blocks = file_length / BLOCK_SIZE
　　left_over = file_length Mod BLOCK_SIZE

　　For block_num = 1 To num_blocks
　　　　bytes() = rs!Picture.GetChunk(BLOCK_SIZE)
　　　　Put #file_num, , bytes()
　　Next block_num

　　If left_over > 0 Then
　　　　bytes() = rs!Picture.GetChunk(left_over)
　　　　Put #file_num, , bytes()
　　End If

　　Close #file_num

　　' Display the picture file.
　　picPerson.Picture = LoadPicture(file_name)
　　picPerson.Visible = True

　　Width = picPerson.Left + picPerson.Width + Width - ScaleWidth
　　hgt = picPerson.Top + picPerson.Height + Height - ScaleHeight
　　If hgt < 1440 Then hgt = 1440
　　Height = hgt

　　Kill file_name
　　Screen.MousePointer = vbDefault
End Sub

Private Sub mnuRecordAdd_Click()
Dim rs As ADODB.Recordset
Dim person_name As String
Dim file_num As String
Dim file_length As String
Dim bytes() As Byte
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long

　　person_name = InputBox("Name")
　　If Len(person_name) = 0 Then Exit Sub

　　dlgPicture.Flags = _
　　　　cdlOFNFileMustExist Or _
　　　　cdlOFNHideReadOnly Or _
　　　　cdlOFNExplorer
　　dlgPicture.CancelError = True
　　dlgPicture.Filter = "Graphics Files|*.bmp;*.ico;*.jpg;*.gif"

　　On Error Resume Next
　　dlgPicture.ShowOpen
　　If Err.Number = cdlCancel Then
　　　　Exit Sub
　　ElseIf Err.Number <> 0 Then
　　　　MsgBox "Error " & Format$(Err.Number) & _
　　　　　　" selecting file." & vbCrLf & Err.Description
　　　　Exit Sub
　　End If

　　' Open the picture file.
　　file_num = FreeFile
　　Open dlgPicture.FileName For Binary Access Read As #file_num

　　file_length = LOF(file_num)
　　If file_length > 0 Then
　　　　num_blocks = file_length / BLOCK_SIZE
　　　　left_over = file_length Mod BLOCK_SIZE

　　　　Set rs = New ADODB.Recordset
　　　　rs.CursorType = adOpenKeyset
　　　　rs.LockType = adLockOptimistic
　　　　rs.Open "Select Name, Picture, FileLength FROM People", m_DBConn

　　　　rs.AddNew
　　　　rs!Name = person_name
　　　　rs!FileLength = file_length

　　　　ReDim bytes(BLOCK_SIZE)
　　　　For block_num = 1 To num_blocks
　　　　　　Get #file_num, , bytes()
　　　　　　rs!Picture.AppendChunk bytes()
　　　　Next block_num

　　　　If left_over > 0 Then
　　　　　　ReDim bytes(left_over)
　　　　　　Get #file_num, , bytes()
　　　　　　rs!Picture.AppendChunk bytes()
　　　　End If

　　　　rs.Update
　　　　Close #file_num

　　　　lstPeople.AddItem person_name
　　　　lstPeople.Text = person_name
　　End If
End Sub