这种例子随便抓都一大把，给你几个
dim cn as new
dim rs as new
dim stm as
private sub savepicturetodb(cn as )
将bmp图片存入数据库
on error goto eh
set stm = new
"select imagepath,imagevalue from tbl_image", cn, adopenkeyset, adlockoptimistic
=
with stm
.type = adtypebinary
.open
.loadfromfile
end with
with rs
.addnew
.fields("imagepath") =
.fields("imagevalue") =
.update
end with
set rs = nothing
exit sub
eh: msgbox , vbinformation, "error"
end sub
private sub loadpicturefromdb(cn as )
载数据库中读出bmp图片
on error goto eh
dim strtemp as string
set stm = new
strtemp = "c:/" 临时文件,用来保存读出的图片
"select imagepath,imagevalue from tbl_image", cn, , , adcmdtext
with stm
.type = adtypebinary
.open
.write rs("imagevalue")
.savetofile strtemp, adsavecreateoverwrite
.close
end with
= loadpicture(strtemp)
set stm = nothing
set rs = nothing
exit sub
eh: msgbox , vbinformation, "error"
end sub
image类型
用picture显示
以下两个函数是从数据库中读出图片的核心程序
public function getimage(optional filename as string) as variant
on error goto procerr
dim objrs as
dim strsql as string
dim chunk() as byte
set objrs = new
strsql = "select thumb from tblpictures where idpict=" & tblid(thumbindex) & ""
strsql = "select thumb from tblpictures where idpict= " & thumb
strsql = "select thumb from tblpictures where idpict=387"
strsql
strsql, db, adopenforwardonly, adlockreadonly
if and then
getimage = 0
goto procexit
elseif isnull((0)) then
errnumber = 1001
errdesc = "字段为空"
goto procexit
end if
chunk() = (0).getchunk((0).actualsize)
set getimage = chunk2image(chunk(), filename)
procexit:
on error resume next
chunk() = (0).getchunk(0)
set getimage = chunk2image(chunk(), filename)
set objrs = nothing
exit function
procerr:
getimage = 0
resume procexit
end function
private function chunk2image(chunk() as byte, optional filename as string) as variant
on error goto procerr
dim keepfile as boolean
dim datafile as integer
keepfile = true
if trim(filename) = "" then
filename = "c:/"
keepfile = false
end if
datafile = freefile
open filename for binary access write as datafile
put datafile, , chunk()
close datafile
procexit:
set chunk2image = loadpicture(filename)
on error resume next
if not keepfile then kill filename
exit function
procerr:
on error resume next
kill filename
chunk2image = 0
end function
public function getfromfile(strtable as string, strfield as string, strfilter as string, objfilename as string) as boolean
============================================================
过程函数名： 类型：function
参数：
strtable (string)：准备保存图形数据的表名称
strfield (string)：准备保存图形数据的字段名称
strfilter (string) ：打开表的过滤字符串，用于定位并确保被打开的表的数据的唯一性
objfilename (string) ：准备输入到表里边的图象文件名称
返回：如果保存成功，返回true，如果失败，返回false
-------------------------------------------------------------
说明：把图象文件的数据保存到表里边
-------------------------------------------------------------
修订历史：
=============================================================
dim recset as , filedata() as byte, fileno as long, filesize as long, strsql as string
strsql = "select " & strfield & " from " & strtable & " where " & strfilter & ";"
set recset = new
strsql, , adopendynamic, adlockoptimistic
getfromfile = true
if recset(strfield).type <> db_ole or not isfilename(objfilename) then
getfromfile = false 如果字段不是ole字段，或者文件不存在，返回错误
goto endgetfromfile
end if
if then 如果记录不存在，返回错误
getfromfile = false
goto endgetfromfile
end if
filesize = getfilesize(objfilename) 如果被打开的文件大小为零，返回错误
if filesize <= 0 then
getfromfile = false
goto endgetfromfile
end if
redim filedata(filesize)重新初始化数组
fileno = freefile 获取一个空闲的文件号
open objfilename for binary as #fileno 打开文件
get #fileno, , filedata() 读取文件内容到数组
close #fileno 关闭文件
recset(strfield).value = filedata() 保存数据
更新数据
erase filedata 释放内存
endgetfromfile:
关闭recordset
set recset = nothing释放内存
end function
public function savetofile(strtable as string, strfield as string, strfilter as string, strfilename as string) as boolean
============================================================
过程函数名： 类型：function
参数：
strtable (string)：保存图形数据的表名称
strfield (string)：保存图形数据的字段名称
strfilter (string) ：打开表的过滤字符串，用于定位并确保被打开的表的纪录的唯一性
strfilename (string) ：准备保存的图象的文件名称
返回：如果保存成功，返回true，如果失败，返回false
-------------------------------------------------------------
说明：把由getfromfile函数保存到表中ole字段的数据还原到文件
-------------------------------------------------------------
修订历史：
=============================================================
dim recset as , filedata() as byte, fileno as long, filesize as long, strsql as string
strsql = "select " & strfield & " from " & strtable & " where " & strfilter & ";"
set recset = new
strsql, , adopendynamic, adlockoptimistic
savetofile = true
if recset(strfield).type <> db_ole then
savetofile = false 如果字段不是ole字段，返回错误
goto endsavetofile
end if
if then 如果记录不存在，返回错误
savetofile = false
goto endsavetofile
end if
fileno = freefile
open strfilename for binary as #fileno
redim filedata(recset(strfield).actualsize) 重新初始化数组
filedata() = recset(strfield).getchunk(recset(strfield).actualsize) 把ole字段的内容保存到数组
put #fileno, , filedata() 把数组内容保存到文件
close #fileno
erase filedata
endsavetofile:
set recset = nothing
end function