用VB6读写数据库中的图片

1，以人名和相关图片为例说明，数据库为Access，有如下字段：Namechar,pictureOLEobject,FileLength
　　Number。当为mssql时，将picture改为lob即可。
　　2，示例包含control：commomdialog,picture,listbox。
　　源码如下：
　　OptionExplicit
　　
　　PrivateDeclareFunctionGetTempFileNameLib"kernel32"Alias"GetTempFileNameA"(ByVallpszPathAsString,ByVallpPrefixStringAsString,ByValwUniqueAsLong,ByVallpTempFileNameAsString)AsLong
　　PrivateDeclareFunctionGetTempPathLib"kernel32"Alias"GetTempPathA"(ByValnBufferLengthAsLong,ByVallpBufferAsString)AsLong
　　PrivateConstMAX_PATH=260
　　
　　Privatem_DBConnAsADODB.Connection
　　
　　PrivateConstBLOCK_SIZE=10000
　　注释：Returnatemporaryfilename.
　　PrivateFunctionTemporaryFileName()AsString
　　Dimtemp_pathAsString
　　Dimtemp_fileAsString
　　DimlengthAsLong
　　
　　注释：Getthetemporaryfilepath.
　　temp_path=Space$(MAX_PATH)
　　length=GetTempPath(MAX_PATH,temp_path)
　　temp_path=Left$(temp_path,length)
　　
　　注释：Getthefilename.
　　temp_file=Space$(MAX_PATH)
　　GetTempFileNametemp_path,"per",0,temp_file
　　TemporaryFileName=Left$(temp_file,InStr(temp_file,Chr$(0))-1)
　　EndFunction
　　PrivateSubForm_Load()
　　Dimdb_fileAsString
　　DimrsAsADODB.Recordset
　　
　　注释：Getthedatabasefilename.
　　db_file=App.Path
　　IfRight$(db_file,1)<>""Thendb_file=db_file&""
　　db_file=db_file&"dbpict.mdb"
　　
　　注释：Openthedatabaseconnection.
　　Setm_DBConn=NewADODB.Connection
　　m_DBConn.Open_
　　"Provider=Microsoft.Jet.OLEDB.4.0;"&_
　　"DataSource="&db_file&";"&_
　　"PersistSecurityInfo=False"
　　
　　注释：Getthelistofpeople.
　　Setrs=m_DBConn.Execute("SELECTNameFROMPeopleORDERBYName",,adCmdText)
　　DoWhileNotrs.EOF
　　lstPeople.AddItemrs!Name
　　rs.MoveNext
　　Loop
　　
　　rs.Close
　　Setrs=Nothing
　　EndSub
　　PrivateSubForm_Resize()
　　lstPeople.Height=ScaleHeight
　　EndSub
　　
　　
　　注释：Displaytheclickedperson.
　　PrivateSublstPeople_Click()
　　DimrsAsADODB.Recordset
　　Dimbytes()AsByte
　　Dimfile_nameAsString
　　Dimfile_numAsInteger
　　Dimfile_lengthAsLong
　　Dimnum_blocksAsLong
　　Dimleft_overAsLong
　　Dimblock_numAsLong
　　DimhgtAsSingle
　　
　　picPerson.Visible=False
　　Screen.MousePointer=vbHourglass
　　DoEvents
　　
　　注释：Gettherecord.
　　Setrs=m_DBConn.Execute("SELECT*FROMPeopleWHEREName=注释："&_
　　lstPeople.Text&"注释：",,adCmdText)
　　Ifrs.EOFThenExitSub
　　
　　注释：Getatemporaryfilename.
　　file_name=TemporaryFileName()
　　
　　注释：Openthefile.
　　file_num=FreeFile
　　Openfile_nameForBinaryAs#file_num
　　
　　注释：Copythedataintothefile.
　　file_length=rs!FileLength
　　num_blocks=file_length/BLOCK_SIZE
　　left_over=file_lengthModBLOCK_SIZE
　　
　　Forblock_num=1Tonum_blocks
　　bytes()=rs!Picture.GetChunk(BLOCK_SIZE)
　　Put#file_num,,bytes()
　　Nextblock_num
　　
　　Ifleft_over>0Then
　　bytes()=rs!Picture.GetChunk(left_over)
　　Put#file_num,,bytes()
　　EndIf
　　
　　Close#file_num
　　
　　注释：Displaythepicturefile.
　　picPerson.Picture=LoadPicture(file_name)
　　picPerson.Visible=True
　　
　　Width=picPerson.Left picPerson.Width Width-ScaleWidth
　　hgt=picPerson.Top picPerson.Height Height-ScaleHeight
　　Ifhgt<1440Thenhgt=1440
　　Height=hgt
　　
　　Killfile_name
　　Screen.MousePointer=vbDefault
　　EndSub
　　
　　PrivateSubmnuRecordAdd_Click()
　　DimrsAsADODB.Recordset
　　Dimperson_nameAsString
　　Dimfile_numAsString
　　Dimfile_lengthAsString
　　Dimbytes()AsByte
　　Dimnum_blocksAsLong
　　Dimleft_overAsLong
　　Dimblock_numAsLong
　　
　　person_name=InputBox("Name")
　　IfLen(person_name)=0ThenExitSub
　　
　　dlgPicture.Flags=_
　　cdlOFNFileMustExistOr_
　　cdlOFNHideReadOnlyOr_
　　cdlOFNExplorer
　　dlgPicture.CancelError=True
　　dlgPicture.Filter="GraphicsFiles|*.bmp;*.ico;*.jpg;*.gif"
　　
　　OnErrorResumeNext
　　dlgPicture.ShowOpen
　　IfErr.Number=cdlCancelThen
　　ExitSub
　　ElseIfErr.Number<>0Then
　　MsgBox"Error"&Format$(Err.Number)&_
　　"selectingfile."&vbCrLf&Err.Description
　　ExitSub
　　EndIf
　　
　　注释：Openthepicturefile.
　　file_num=FreeFile
　　OpendlgPicture.FileNameForBinaryAccessReadAs#file_num
　　
　　file_length=LOF(file_num)
　　Iffile_length>0Then
　　num_blocks=file_length/BLOCK_SIZE
　　left_over=file_lengthModBLOCK_SIZE
　　
　　Setrs=NewADODB.Recordset
　　rs.CursorType=adOpenKeyset
　　rs.LockType=adLockOptimistic
　　rs.Open"SelectName,Picture,FileLengthFROMPeople",m_DBConn
　　
　　rs.AddNew
　　rs!Name=person_name
　　rs!FileLength=file_length
　　
　　ReDimbytes(BLOCK_SIZE)
　　Forblock_num=1Tonum_blocks
　　Get#file_num,,bytes()
　　rs!Picture.AppendChunkbytes()
　　Nextblock_num
　　
　　Ifleft_over>0Then
　　ReDimbytes(left_over)
　　Get#file_num,,bytes()
　　rs!Picture.AppendChunkbytes()
　　EndIf
　　
　　rs.Update
　　Close#file_num
　　
　　lstPeople.AddItemperson_name
　　lstPeople.Text=person_name
　　EndIf
　　EndSub->