用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