通用 文件保存至数据库,从数据库写入磁盘 程序代码 ----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
软件截图:
 附完整源码:
点击浏览该文件 
在使用过程中如有什么问题也可跟贴提出!谢谢。 
|