IDC资讯中心
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->
