General files are saved to the database, write from the database to disk program code ---- 20040809 In the past few days, I just have time to continue writing MyCodelibrary.
1.5 version, just written to file and data inventory this evening, in the forum, this problem is more, so this part of this part of the code is publicly used. The code can be used in full normal use, but It is still necessary to do some errors.
'Welcome to download the use of this code, this code is provided by the program Pacific to download learning' declaration: '1. All code of this site belongs to the original author, if you use the source code you downloaded in this site' caused All disputes (consequences) have nothing to do with this site, please respect the original author's labor results! '2. If this site has infringement on the code, please contact the webmaster and the webmaster will correct it in a timely manner.
'China Code Network: http://www.daima.com.cn' Program Pacific: http://www.5ivb.net'email: dapha@tang.com'copyright 2001-2005 by www.5ivals time: 2004-8-9 3: 32: 48option explicitpublic objconn as new adodb.connectionpublic m_connstring as stringprivate function exists (byval str_filename as string, _ byval int_val as vbfileattribute) as boolean '----------- -------------------------------------------------- ------------------- 'Project: Mycodelibrary 1.5' Procedure: EXISTS 'DESCRIPTION: [Judgment file or directory exists]' created by: ronggang (zhouroang@163.com ) 'Date-Time: 2004-8-9-2: 31: 45' 'parameters: str_filename (string)' int_val (vbFileAttribute) '------------------- -------------------------------------------------- ----------- ignal resume next if len (str_filename) = 0 THEN EXISTS = false exit function end if if INT_VAL <> vbdirectory the 'If not a directory', if it is empty Member if dir absence (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 ifend functionpublic sub binvalue (byval strfilename AS String, Byref Objfield As Field) ------------------------------------------------------------------------------------------------------------------------------------------------- --------------------------------------- 'Project: MyCodelibrary 1.5' Procedure: binvalue 'description : [Save the file to the database] '
Created by: Wangfeng 'Date-Time: 2004-8-9-2: 20: 37' parameters: strfilename (string) 'Objfield (Field)' ----------------------------------------------------------------------------------------------------------------- -------------------------------------------------- -------------- 'This method needs to do error handling, to prevent documentation to open DIM OBJSTREAM AS stream if not exists (strfilename, vbnormal) Then' If the file is not allowed to throw an exception ERR .raise 50001, "dbfile", "file does not exist!" exit sub end if set objstream = new adodb.stream with objstream .type = adtypebinary .open .loadfromfile strfilename objfield.value = .read end with set objstream = nothingend subpublic function Binvalue2file (byval strfilename as string, botion overwrite as boolean = false) as boolean ------------------------------------------------------------------------------------------------------------------------------------------------ -------------------------------------------------- - 'Project: Mycodelibrary 1.5' Procedure: Binvalue2File 'Description: [Save the binary data in the database as file]' create by: WANGFENG 'DATE-TIME: 2004-8-9-2: 22: 33' 'parameters: strfilename (string) Target file' Objfield (Field) Data Field Name 'OVERWRITE (Boolean = FALSE) Overwrite existing existing file' True covers False (default) Save "--------------------------------------- ----------------------------------------- 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 'saving the successful return true101: set objstream = nothing exit functionerrorhander: binvalue2file = false goto 101end functionpublic function getfilename (byval strpathfilename) as string dim ipos as long ipos = vba.instrrev (strpathfilename, "/") getfilename = mid (strpathfilename, ipos 1) end functionpublic 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 software screenshot: Additional Source: Click to view this file
If there is any problem in the process of use, you can also post it! Thank you.
