通用文件保存至数据库,从数据库写入磁盘程序代码

**通用文件保存至数据库,从数据库写入磁盘程序代码 ----20040809
** 这几天我休假中，正好有时间继续编写mycodelibrary __ 1.5版,今天晚上刚好写到文件与数据库存入取出模块，在论坛上此问题见的也较多，所以特此公开此部分代码，供有需者参考使用.代码虽然可以完整的正常使用，但还是需要做些错误方面的处理。

'欢迎你下载使用本代码，本份代码由程序太平洋提供下载学习之用
'声明:
'1.本站所有代码的版权归原作者所有，如果你使用了在本站下载的源代码
' __ __ 引起的一切纠纷(后果)与本站无关,请您尊重原作者的劳动成果！
'2.若本站在代码上有侵权之处请您与站长联系，站长会及时更正。
'中国代码网： http://www.daima.com.cn
'程序太平洋： http://www.5ivb.net
'email:[email protected]
'copyright __ 2001-2005 __ by __ www.5ivb.net
'整理时间：2004-8-9 __ 3:32:48
option __ explicit
public __ objconn __ as __ new __ adodb.connection
public __ m_connstring __ as __ string
private __ function __ exists(byval __ str_filename __ as __ string, __ _
__ __ __ __ __ __ __ __ __ __ __ __ byval __ int_val __ as __ vbfileattribute) __ as __ boolean
__ __ __ __ '--------------------------------------------------------------------------------
__ __ __ __ ' __ project __ __ __ __ : __ __ __ __ __ __ __ mycodelibrary __ 1.5
__ __ __ __ ' __ procedure __ __ : __ __ __ __ __ __ __ exists
__ __ __ __ ' __ description: __ __ __ __ __ __ __ [判断文件或目录是否存在]
__ __ __ __ ' __ created __ by __ : __ __ __ __ __ __ __ ronggang __ （[email protected]）
__ __ __ __ ' __ date-time __ __ : __ __ __ __ __ __ __ 2004-8-9-2:31:45
__ __ __ __ '
__ __ __ __ ' __ parameters __ : __ __ __ __ __ __ __ str_filename __ (string)
__ __ __ __ ' __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ int_val __ (vbfileattribute)
__ __ __ __ '--------------------------------------------------------------------------------
__ __ __ __ on __ error __ resume __ next
__ __ __ __ if __ len(str_filename) __ = __ 0 __ then
__ __ __ __ __ __ __ __ exists __ = __ false
__ __ __ __ __ __ __ __ exit __ function
__ __ __ __ end __ if
__ __ __ __ if __ int_val __ <> __ vbdirectory __ then __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ '如果不是目录
__ __ __ __ __ __ __ __ '如果为空表示文件不存在
__ __ __ __ __ __ __ __ if __ dir(str_filename) __ = __ "" __ then
__ __ __ __ __ __ __ __ __ __ __ __ exists __ = __ false
__ __ __ __ __ __ __ __ else
__ __ __ __ __ __ __ __ __ __ __ __ exists __ = __ true
__ __ __ __ __ __ __ __ end __ if
__ __ __ __ else
__ __ __ __ __ __ __ __ if __ dir(str_filename, __ vbdirectory) __ = __ "" __ then
__ __ __ __ __ __ __ __ __ __ __ __ exists __ = __ false
__ __ __ __ __ __ __ __ else
__ __ __ __ __ __ __ __ __ __ __ __ exists __ = __ true
__ __ __ __ __ __ __ __ end __ if
__ __ __ __ end __ if
end __ function
public __ sub __ binvalue(byval __ strfilename __ as __ string, __ byref __ objfield __ as __ field)
__ __ __ __ '--------------------------------------------------------------------------------
__ __ __ __ ' __ project __ __ __ __ : __ __ __ __ __ __ __ mycodelibrary __ 1.5
__ __ __ __ ' __ procedure __ __ : __ __ __ __ __ __ __ binvalue
__ __ __ __ ' __ description: __ __ __ __ __ __ __ [将文件保存至数据库中]
__ __ __ __ ' __ created __ by __ : __ __ __ __ __ __ __ wangfeng
__ __ __ __ ' __ date-time __ __ : __ __ __ __ __ __ __ 2004-8-9-2:20:37
__ __ __ __ '
__ __ __ __ ' __ parameters __ : __ __ __ __ __ __ __ strfilename __ (string)
__ __ __ __ ' __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ objfield __ (field)
__ __ __ __ '--------------------------------------------------------------------------------
__ __ __ __ '此方法需要做错误处理，以防文件己打开
__ __ __ __ dim __ objstream __ as __ stream
__ __ __ __ if __ not __ exists(strfilename, __ vbnormal) __ then __ __ __ __ __ __ __ __ __ __ __ __ __ __ '如果文件不存则抛出异常
__ __ __ __ __ __ __ __ err.raise __ 50001, __ "dbfile", __ "文件不存在!"
__ __ __ __ __ __ __ __ exit __ sub
__ __ __ __ end __ if
__ __ __ __ set __ objstream __ = __ new __ adodb.stream
__ __ __ __ with __ objstream
__ __ __ __ __ __ __ __ .type __ = __ adtypebinary
__ __ __ __ __ __ __ __ .open
__ __ __ __ __ __ __ __ .loadfromfile __ strfilename
__ __ __ __ __ __ __ __ objfield.value __ = __ .read
__ __ __ __ end __ with
__ __ __ __ set __ objstream __ = __ nothing
end __ sub
public __ function __ binvalue2file(byval __ strfilename __ as __ string, __ byref __ objfield __ as __ field, __ optional __ overwrite __ as __ boolean __ = __ false) __ as __ boolean
__ __ __ __ '--------------------------------------------------------------------------------
__ __ __ __ ' __ project __ __ __ __ : __ __ __ __ __ __ __ mycodelibrary __ 1.5
__ __ __ __ ' __ procedure __ __ : __ __ __ __ __ __ __ binvalue2file
__ __ __ __ ' __ description: __ __ __ __ __ __ __ [将数据库中的二进制数据保存为文件]
__ __ __ __ ' __ created __ by __ : __ __ __ __ __ __ __ wangfeng
__ __ __ __ ' __ date-time __ __ : __ __ __ __ __ __ __ 2004-8-9-2:22:33
__ __ __ __ '
__ __ __ __ ' __ parameters __ : __ __ __ __ __ __ __ strfilename __ (string) __ __ __ __ __ __ __ __ __ __ __ 目标文件
__ __ __ __ ' __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ objfield __ (field) __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ 数据字段名
__ __ __ __ ' __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ overwrite __ (boolean __ = __ false) __ __ __ __ 是否覆盖现有存在的文件
__ __ __ __ ' __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ true __ 覆盖 __ false(默认)不存在时保存
__ __ __ __ '--------------------------------------------------------------------------------
__ __ __ __ on __ error __ goto __ errorhander
__ __ __ __ dim __ objstream __ as __ stream
__ __ __ __ dim __ returnmsg __ as __ vbmsgboxresult
__ __ __ __ set __ objstream __ = __ new __ adodb.stream
__ __ __ __ with __ objstream
__ __ __ __ __ __ __ __ .type __ = __ adtypebinary
__ __ __ __ __ __ __ __ .open
__ __ __ __ __ __ __ __ .write __ objfield.value
__ __ __ __ __ __ __ __ if __ overwrite __ then
__ __ __ __ __ __ __ __ __ __ __ __ .savetofile __ strfilename, __ adsavecreateoverwrite
__ __ __ __ __ __ __ __ else
__ __ __ __ __ __ __ __ __ __ __ __ .savetofile __ strfilename, __ adsavecreatenotexist
__ __ __ __ __ __ __ __ end __ if
__ __ __ __ end __ with
__ __ __ __ binvalue2file __ = __ true __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ __ '保存成功返回true
101:
__ __ __ __ set __ objstream __ = __ nothing
__ __ __ __ exit __ function
errorhander:
__ __ __ __ binvalue2file __ = __ false
__ __ __ __ goto __ 101
end __ function
public __ function __ getfilename(byval __ strpathfilename) __ as __ string
__ __ __ __ dim __ ipos __ as __ long
__ __ __ __ ipos __ = __ vba.instrrev(strpathfilename, __ "")
__ __ __ __ getfilename __ = __ mid(strpathfilename, __ ipos __ + __ 1)
end __ function
public __ function __ getpathname(optional __ strpathname __ as __ string) __ as __ string
__ __ __ __ 'sfilename __ = __ mid(getpathname, __ ipos __ + __ 1)
__ __ __ __ dim __ ipos __ as __ long
__ __ __ __ ipos __ = __ vba.instrrev(strpathname, __ "")
__ __ __ __ getpathname __ = __ mid(strpathname, __ 1, __ ipos)
end __ function