'1,以人名和相关图片为例说明,数据库为Access, '有如下字段:Name char, ' picture OLE object, ' FileLength Number。 '当为ms sql时,将picture改为lob即可。 '2,示例包含control:commom dialog,picture,listbox。 '源码如下: OptionExplicit Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString AsString, ByVal wUnique AsLong, ByVal lpTempFileName AsString) AsLong Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength AsLong, ByVal lpBuffer AsString) AsLong PrivateConst MAX_PATH =260 Private m_DBConn As ADODB.Connection PrivateConst BLOCK_SIZE =10000 注释: Return a temporary file name. PrivateFunction TemporaryFileName() AsString Dim temp_path AsString Dim temp_file AsString Dim length AsLong 注释: 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 PrivateSub Form_Load() Dim db_file AsString Dim rs As ADODB.Recordset 注释: Get the database file name. db_file = App.Path IfRight$(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) DoWhileNot rs.EOF lstPeople.AddItem rs!Name rs.MoveNext Loop rs.Close Set rs =Nothing End Sub PrivateSub Form_Resize() lstPeople.Height = ScaleHeight End Sub 注释: Display the clicked person. PrivateSub lstPeople_Click() Dim rs As ADODB.Recordset Dim bytes() AsByte Dim file_name AsString Dim file_num AsInteger Dim file_length AsLong Dim num_blocks AsLong Dim left_over AsLong Dim block_num AsLong Dim hgt AsSingle 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 ThenExitSub 注释: 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 =1To num_blocks bytes() = rs!Picture.GetChunk(BLOCK_SIZE) Put #file_num, , bytes() Next block_num If left_over >0Then bytes() = rs!Picture.GetChunk(left_over) Put #file_num, , bytes() EndIf 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 <1440Then hgt =1440 Height = hgt Kill file_name Screen.MousePointer = vbDefault End Sub PrivateSub mnuRecordAdd_Click() Dim rs As ADODB.Recordset Dim person_name AsString Dim file_num AsString Dim file_length AsString Dim bytes() AsByte Dim num_blocks AsLong Dim left_over AsLong Dim block_num AsLong person_name =InputBox("Name") IfLen(person_name) =0ThenExitSub dlgPicture.Flags = _ cdlOFNFileMustExist Or _ cdlOFNHideReadOnly Or _ cdlOFNExplorer dlgPicture.CancelError =True dlgPicture.Filter ="Graphics Files|*.bmp;*.ico;*.jpg;*.gif" OnErrorResumeNext dlgPicture.ShowOpen If Err.Number = cdlCancel Then ExitSub ElseIf Err.Number <>0Then MsgBox"Error "& Format$(Err.Number) & _ " selecting file."& vbCrLf & Err.Description ExitSub EndIf 注释: 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 >0Then 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 =1To num_blocks Get #file_num, , bytes() rs!Picture.AppendChunk bytes() Next block_num If left_over >0Then ReDim bytes(left_over) Get #file_num, , bytes() rs!Picture.AppendChunk bytes() EndIf rs.Update Close #file_num lstPeople.AddItem person_name lstPeople.Text = person_name EndIf End Sub