vb数据库连接字符串

*************************************************************************

**

** 使用adodb.stream 保存/读取文件到数据库

** 引用microsoft activex data objects 2.5 library 及以上版本

**

** ----- 数据库连接字符串模板---------------------------------------

** access数据库

** iconcstr = "provider=microsoft.jet.oledb.4.0;persist security info=false" & _

** ";data source=数据库名"

**

** sql数据库

** iconcstr = "provider=sqloledb.1;persist security info=true;" & _

** "user id=用户名;password=密码;initial catalog=数据库

名;data source=sql服务器名"

**

*************************************************************************

保存文件到数据库中

sub s_savefile()

dim istm as adodb.stream

dim ire as adodb.recordset

dim iconcstr as string

数据库连接字符串

iconcstr = "provider=microsoft.jet.oledb.4.0;persist security info=false" & _

";data source=f:/my documents/客户资料1.mdb"

读取文件到内容

set istm = new adodb.stream

with istm

.type = adtypebinary 二进制模式

.open

.loadfromfile "c:/test.doc"

end with

打开保存文件的表

set ire = new adodb.recordset

with ire

.open "表", iconc, adopenkeyset, adlockoptimistic

.addnew 新增一条记录

.fields("保存文件内容的字段") = istm.read

.update

end with

完成后关闭对象

ire.close

istm.close

end sub

从数据库中读取数据,保存成文件

sub s_readfile()

dim istm as adodb.stream

dim ire as adodb.recordset

dim iconc as string

数据库连接字符串

iconc = "provider=microsoft.jet.oledb.4.0;persist security info=false" & _

";data source=//xz/c$/inetpub/zj/zj/zj.mdb"

打开表

set ire = new adodb.recordset

ire.open "tb_img", iconc, adopenkeyset, adlockreadonly

ire.filter = "id=64"

保存到文件

set istm = new adodb.stream

with istm

.mode = admodereadwrite

.type = adtypebinary

.open

.write ire("img")

.savetofile "c:/test.doc"

end with

关闭对象

ire.close

istm.close

end sub

dim cn as new adodb.connection

dim rs as new adodb.recordset

dim stm as adodb.stream

private sub savepicturetodb(cn as adodb.connection)

将bmp图片存入数据库

on error goto eh

set stm = new adodb.stream

rs.open "select imagepath,imagevalue from tbl_image", cn, adope nkeyset, adlockoptimistic

commondialog1.showopen

text1.text = commondialog1.filename

with stm

.type = adtypebinary

.open

.loadfromfile commondialog1.filename

end with

with rs

.addnew

.fields("imagepath") = text1.text

.fields("imagevalue") = stm.read

.update

end with

rs.close

set rs = nothing

exit sub

eh: msgbox err.description, vbinformation, "error"

end sub

private sub loadpicturefromdb(cn as adodb.connection)

载数据库中读出bmp图片

on error goto eh

dim strtemp as string

set stm = new adodb.stream

strtemp = "c:/temp.tmp" 临时文件,用来保存读出的图片

rs.open "select imagepath,imagevalue from tbl_image", cn, , , adcmdtext

with stm

.type = adtypebinary

.open

.write rs("imagevalue")

.savetofile strtemp, adsavecreateoverwrite

.close

end with

image1.picture = loadpicture(strtemp)

set stm = nothing

rs.close

set rs = nothing

exit sub

eh: msgbox err.description, vbinformation, "error"

end sub

image类型

用picture显示

以下两个函数是从数据库中读出图片的核心程序

public function getimage(optional filename as string) as variant

on error goto procerr

dim objrs as adodb.recordset

dim strsql as string

dim chunk() as byte

set objrs = new adodb.recordset

strsql = "select thumb from tblpictures where idpict=" & tblid(thu mbindex) & ""

strsql = "select thumb from tblpictures where idpict= " & thum b

strsql = "select thumb from tblpictures where idpict=387"

db.execute strsql

objrs.open strsql, db, adopenforwardonly, adlockreadonly

if objrs.bof and objrs.eof then

getimage = 0

goto procexit

elseif isnull(objrs.fields(0)) then

errnumber = 1001

errdesc = "字段为空"

goto procexit

end if

chunk() = objrs.fields(0).getchunk(objrs.fields(0).actualsize)

set getimage = chunk2image(chunk(), filename)

procexit:

on error resume next

objrs.close

chunk() = objrs.fields(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 st ring) as variant

on error goto procerr

dim keepfile as boolean

dim datafile as integer

keepfile = true

if trim(filename) = "" then

filename = "c:/tmpxxdb.fil"

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

============================================================

过程函数名：commmodule.getfromfile类型：function

参数：

strtable (string)：准备保存图形数据的表名称

strfield (string)：准备保存图形数据的字段名称

strfilter (string)：打开表的过滤字符串，用于定位并确保被打开的表的数据的唯一性

objfilename (string) ：准备输入到表里边的图象文件名称返回：如果保存成功，返回true，如果失败，返回false

-------------------------------------------------------------

说明：把图象文件的数据保存到表里边

-------------------------------------------------------------

修订历史：

=============================================================

dim recset as adodb.recordset, filedata() as byte, fileno as lon g, filesize as long, strsql as string

strsql = "select " & strfield & " from " & strtable & " where " & strfilter & ";"

set recset = new adodb.recordset

recset.open strsql, currentproject.connection, adopendynamic, adlockopti mistic

getfromfile = true

if recset(strfield).type <> db_ole or not isfilename(objfilename) then

getfromfile = false如果字段不是ole字段，或者文件不存在，返回错误

goto endgetfromfile

end if

if recset.eof 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() 保存数据

recset.update更新数据

erase filedata释放内存

endgetfromfile:

recset.close关闭recordset

set recset = nothing释放内存

end function

public function savetofile(strtable as string, strfield as string, strfilter as string, strfilename as string) as boolean

============================================================

过程函数名：commmodule.savetofile 类型：function

参数：

strtable (string)：保存图形数据的表名称

strfield (string)：保存图形数据的字段名称

strfilter (string)：打开表的过滤字符串，用于定位并确保被打开的表的纪录的唯一性

strfilename (string) ：准备保存的图象的文件名称

返回：如果保存成功，返回true，如果失败，返回false

-------------------------------------------------------------

说明：把由getfromfile函数保存到表中ole字段的数据还原到文件

-------------------------------------------------------------

修订历史：

=============================================================

dim recset as adodb.recordset, filedata() as byte, fileno as lon g, filesize as long, strsql as string

strsql = "select " & strfield & " from " & strtable & " where " & strfilter & ";"

set recset = new adodb.recordset

recset.open strsql, currentproject.connection, adopendynamic, adlockopti mistic

savetofile = true

if recset(strfield).type <> db_ole then

savetofile = false如果字段不是ole字段，返回错误

goto endsavetofile

end if

if recset.eof 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:

recset.close

set recset = nothing

end function