' 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
