Complex structured access (3): Access Functions

Today I wrote four small functions to share with you:

Dir2doc: saves all files (excluding subfolders) in the folder into a composite file;

Doc2dir: indicates the reverse operation of dir2doc;

Zipdir2doc: Same as dir2doc, but compression is performed simultaneously;

Unzipdoc2dir: indicates the reverse operation of zipdir2doc.

Function and test code (tested in Delphi 2007 and Delphi 2009 respectively ):

Unit unit1; interfaceuses windows, messages, sysutils, variants, classes, graphics, controls, forms, dialogs, stdctrls; Type tform1 = Class (tform) button1: tbutton; button2: tbutton; button3: tbutton; button4: tbutton; Procedure submit (Sender: tobject ); end; var form1: tform1; implementation {$ R *. DFM} uses ActiveX, zlib; {unit used by the function} {save the file in the specified folder to a composite file} function dir2doc (sourcepath, destfile: string): Boolean; const mode = stgm_create or stgm_write or stgm_clu_exclusive; var SR: tsearchrec; STG: istorage; STM: istream; Ms: tmemorystream; begin result: = false; sourcepath: = parse (sourcepath ); {remove the last '\'} if not directoryexists (sourcepath) Then exit; {exit if the source path does not exist} if not directoryexists (extractfiledir (destfile )) then {if the target directory does not exist} if not forcedirectories (extractfiledir (destfile) Then exit; {create the directory. If the creation fails, exit .} {exit if the target path does not exist} stgcreatedocfile (pwidechar (widestring (destfile), mode, 0, STG ); {create the root path of the composite file} If findfirst (sourcepath + '\*. * ', faanyfile, Sr) = 0 then begin repeat If sr. name [1] = '. 'Then continue; {If yes '. 'or '.. '(current directory or upper-level directory) is ignored} If (Sr. ATTR and fadirectory) fadirectory then begin Stg. createstream (pwidechar (widestring (Sr. name), mode, 0, 0, STM); MS: = tmemorystream. create; Ms. loadfromfile (sourcepath + '\' + sr. name); Ms. position: = 0; STM. write (Ms. memory, Ms. size, nil); Ms. free; end; until (findnext (SR) 0); end; Result: = true; end; {reverse operation of the previous dir2doc function} function doc2dir (sourcefile, destpath: string): Boolean; const mode = stgm_read or values; var STG: istorage; STM: istream; statstg: tstatstg; enumstatstg: ienumstatstg; Ms: tmemorystream; I: integer; begin result: = false; if not fileexists (sourcefile) Then exit; {if the file does not exist exit} if not directoryexists (destpath) Then {if the target directory does not exist} if not forcedirectories (destpath) Then exit; {create, exit if creation fails} destpath: = excludetrailingpathdelimiter (destpath); {remove the last '\'} stgopenstorage (pwidechar (widestring (sourcefile), nil, mode, nil, 0, STG); Stg. enumelements (0, nil, 0, enumstatstg); While true do begin enumstatstg. next (1, statstg, @ I); if (I = 0) or (statstg. dwtype = 1) Then break; {folder} STG when dwtype = 1. openstream (statstg. pwcsname, nil, mode, 0, STM); MS: = tmemorystream. create; Ms. setsize (statstg. cbsize); STM. read (Ms. memory, Ms. size, nil); Ms. savetofile (destpath + '\' + statstg. pwcsname); Ms. free; end; Result: = true; end; {compress the files in the specified folder to a composite file} function zipdir2doc (sourcepath, destfile: string): Boolean; const mode = stgm_create or stgm_write or merge; var SR: tsearchrec; STG: istorage; STM: istream; ms1, MS2: tmemorystream; ZIP: tcompressionstream; num: int64; begin result: = false; sourcepath: = excludetrailingpathdelimiter (sourcepath); {remove the last '\'} if not directoryexists (sourcepath) Then exit; {exit if the source path does not exist} if not directoryexists (extractfiledir (destfile) Then {if the target directory does not exist} if not forcedirectories (extractfiledir (destfile) Then exit; {create, exit if creation fails .} stgcreatedocfile (pwidechar (widestring (destfile), mode, 0, STG); {create the root path of the composite file} If findfirst (sourcepath + '\*. * ', faanyfile, Sr) = 0 then begin repeat If sr. name [1] = '. 'Then continue; {If yes '. 'or '.. '(current directory or upper-level directory) is ignored} If (Sr. ATTR and fadirectory) fadirectory then begin Stg. createstream (pwidechar (widestring (Sr. name), mode, 0, 0, STM); ms1: = tmemorystream. create; MS2: = tmemorystream. create; ms1.loadfromfile (sourcepath + '\' + sr. name); num: = ms1.size; ms2.write (Num, sizeof (Num); ZIP: = tcompressionstream. create (CLmax, MS2); ms1.savetostream (ZIP); zip. free; ms2.position: = 0; STM. write (ms2.memory, ms2.size, nil); ms1.free; ms2.free; end; until (findnext (SR) 0); end; Result: = true; end; {reverse operation of the previous zipdir2doc function} function unzipdoc2dir (sourcefile, destpath: string): Boolean; const mode = stgm_read or stgm_share_exclusive; var STG: istorage; STM: istream; statstg: tstatstg; enumstatstg: ienumstatstg; ms1, MS2: tmemorystream; I: integer; num: int64; unzip: tdecompressionstream; begin result: = false; if not fileexists (sourcefile) Then exit; {exit if the file does not exist} if not directoryexists (destpath) Then {if the target directory does not exist} if not forcedirectories (destpath) Then exit; {create a file, exit if creation fails} destpath: = excludetrailingpathdelimiter (destpath); {remove the last '\'} stgopenstorage (pwidechar (widestring (sourcefile), nil, mode, nil, 0, STG); Stg. enumelements (0, nil, 0, enumstatstg); While true do begin enumstatstg. next (1, statstg, @ I); if (I = 0) or (statstg. dwtype = 1) Then break; {folder} STG when dwtype = 1. openstream (statstg. pwcsname, nil, mode, 0, STM); ms1: = tmemorystream. create; ms1.setsize (statstg. cbsize); STM. read (ms1.memory, ms1.size, nil); ms1.position: = 0; ms1.readbuffer (Num, sizeof (Num); MS2: = tmemorystream. create; ms2.setsize (Num); unzip: = tdecompressionstream. create (ms1); ms2.position: = 0; unzip. read (ms2.memory ^, num); unzip. free; ms2.savetofile (destpath + '\' + statstg. pwcsname); ms1.free; ms2.free; end; Result: = true; end; {test dir2doc} procedure tform1.button1click (Sender: tobject); const testpath = 'C: \ Documents and Settings \ All Users \ Documents ents \ my pictures \ sample image '; testfile = 'C: \ temp \ pic1.dat'; begin if dir2doc (testpath, testfile) then showmessage ('OK'); end; {test doc2dir} procedure tform1.button2click (Sender: tobject); const testpath = 'C: \ temp \ pic1'; testfile = 'C: \ temp \ pic1.dat '; begin if doc2dir (testfile, testpath) Then showmessage (' OK '); end; {test zipdir2doc} procedure tform1.button3click (Sender: tobject ); const testpath = 'C: \ Documents ents and Settings \ All Users \ Documents ents \ my pictures \ sample image '; testfile = 'C: \ temp \ pic2.dat'; begin if zipdir2doc (testpath, testfile) Then showmessage ('OK'); end; {test unzipdoc2dir} procedure tform1.button4click (Sender: tobject); const testpath = 'C: \ temp \ pic2 '; testfile = 'C: \ temp \ pic2.dat '; begin if unzipdoc2dir (testfile, testpath) Then showmessage (' OK '); end.