/* ** ToDo: 160 may be used as space (32) */ /* UpDateCopy.e ** Copies multiple files/directories to one destination. ** Not existing directories are created. ** Already existing files are only replaced by newer ones ** (UpDateCopy first checks for versions-string and then ** for dates). ** ** $VER: UpDateCopy.e 2.0 (04.07.98) ** ** This program is Cardware. If you use it you should send an Email to ** the author. Also small presents are very welcome. ** You may use this sourcefile or parts of it freely in your programs. ** But please do not spread a modified version under this name (UpDateCopy). ** For Bugreports, ideas or anything else send a Email to: ** ss37@inf.tu-dresden.de ** ** Sven Steiniger, 1996-98 ** ** Fold-start: ->// "" ** Fold-stop: ->\\ ** ** History: ** 2.0 : - FIXED: archive bit was modified in TESTMODE ** - slightly optimized copyfile() ** - FIXED: error during writing the last part of an file may be not recognized ** 1.9 : - added PATTERN option to set the pattern used for recursiv scanning ** 1.8 : - validateFilename() is much faster now ** - FIXED: sometimes forgot to unlock files ** - now works with strange patterns, eg. "Text (deutsch)/#?" ** 1.7 : - UDC failed if it processes directories containing characters ** declared as wildcards (eg. "(" or "?"). ** Note: standard "C:" commands fail here!! Just try ** 'copy "WBStartup (Enabled)" ram:' ** 1.6 : - changed getVersion() to recognize different version strings ** (eg. 'Test v1.0', 'Test 1', 'Test 2.') ** 1.5 : - anchor structure was not longword aligned ** : - added lha-compatible date compare mode ** 1.4 : - FIXED: directories may be created, even in testmode ** : - FIXED: protection bits may be modified in testmode ** 1.3 : - the file-io buffer is now allocated once at start ** . - cleaned up ** 1.2 : - fixed small bug in getVersion() ** 1.1 : - uses now asyncio.library for fantastic speed ** 1.00: - implemented SAB, CAB options ** 0.54: - implemented NOASK-option ** 0.53: - now user is asked on errors. Doesn't works perfect but I don't now ** how to implement it properly without adding to much extra code. ** 0.52: - improved SMARTINFO-option ** 0.51: - removed bug of version-scan-routines ** 0.50: - added FAST-option ** 0.49: - added SMARTINFO option ** - added wildcard-check. Now you can also use '*' as wildcard and ** you can also pass devices as sources (eq. ram:) ** 0.48: - used exthelp-feature OF ReadArgs() ** - no longer needs 'c:copy'-command. Implemented an own routine. ** 0.47: - file was not closed before SetProtection()/SetFileDate() ** 0.46: - added PAPF-option -> archive protection flag is not changed ** 0.45: - added CLONE-option -> Datestamp is copied ** 0.44: - removed a unnecessary module. Saves 1K of executable size! ** - removed unnecessary ExamineFH() ** - now file gets only examined if really necessary ** - optimized a bit ** - FIXED: TESTMODE was buggy -> Directories were still created. ** 0.43: - add new option TESTMODE; dont copy/replace files ** 0.42: - add new option NODATECHECK; dont compare datestamps ** 0.41: - replaced all reads/writes by fread/fwrite ** 0.40: - first public release */ OPT OSVERSION=37 OPT PREPROCESS OPT REG=5 MODULE 'dos/dos','dos/dosasl','dos/dostags','dos/rdargs','dos/stdio', 'asyncio','libraries/asyncio' MODULE 'sven/anchorPath', 'sven/eAddPart' RAISE "MEM" IF String()=NIL, "^C" IF CtrlC()=TRUE, "copy" IF FileLength()=-1, "MEM" IF AllocDosObject()=NIL, "fatt" IF SetProtection()=DOSFALSE, "fatt" IF SetComment()=DOSFALSE, "fatt" IF SetFileDate()=DOSFALSE #define OpenAsyncRead(filename) OpenAsync(filename,MODE_READ,ASYNCBUFFER) #define OpenAsyncWrite(filename) OpenAsync(filename,MODE_WRITE,ASYNCBUFFER) #define CloseAsyncRead(fh) CloseAsync(fh) #define CloseAsyncWrite(fh,exceptid) IF fh THEN IF CloseAsync(fh)<0 THEN Raise(exceptid) #define SafeReadAsync(fh,buffer,length,exceptid) IF ReadAsync(fh,buffer,length)<>(length) THEN Raise(exceptid) #define SafeWriteAsync(fh,buffer,length,exceptid) IF WriteAsync(fh,buffer,length)<>(length) THEN Raise(exceptid) CONST MAXPATH=256, -> Maximum path length SPACEADD=3, -> Number of spaces per indent SAFETYBYTES=150, -> Maximum length of versionstring BIGFILEMEM=16384 -> Files bigger than that are not read -> completly into memory CONST PATHLENGTH=MAXPATH-1, BIGFILESIZE=BIGFILEMEM-SAFETYBYTES, MAXPATH2=MAXPATH*2 CONST ASYNCBUFFER=BIGFILESIZE*2, IOBUFFERSIZE=BIGFILEMEM+8 -> size of io-buffer (+8 'coz getVersion() -> may read 4 additional bytes) ENUM PDIR_Error, PDIR_Skipped, PDIR_Created ENUM PFILE_Error, PFILE_Skipped, PFILE_Copied, PFILE_Replaced ENUM ASKUSER_Abort, ASKUSER_Retry, ASKUSER_Skip DEF frompath[MAXPATH]:STRING, -> actual sourcepath fromlist:PTR TO LONG, -> pointer to array of sourcestrings topath[MAXPATH]:STRING, -> destinationpath doinfo, -> should we write informations ? recursiv, -> scan recursively through subdirectories ? ignoreprotection, -> clear delete-protection ? checkversion, -> compare version-strings ? checkdates, -> compare datestamps ? testmode, -> test modus ? (do not copy/replace files) clone, -> copy datestamp ? cleararchivebit, -> clear archivebit OF copied file smartinfo, -> only display copied/replaced files fastdisplay, -> no linefeed interaction, -> ask user on errors setarchivebit, -> set Archive bit checkarchivebit, -> check Archive bit lousydatestamp, -> lha compatible datestamp compare subpattern[MAXPATH]:STRING, -> pattern used to scan subdirectories/devices dirlock=NIL -> PTR TO lock-structure OF destination path DEF buffer=NIL:PTR TO CHAR -> the global buffer used for all file-io. -> Contains IOBUFFERSIZE Bytes PROC main() HANDLE ->// "main()" DEF rdargs=NIL, myargs:PTR TO LONG, myrdargs=NIL:PTR TO rdargs, exthelp[1000]:STRING asynciobase:=OpenLibrary('asyncio.library',39) IF asynciobase=NIL THEN Raise("asio") /* Initialize argument-array */ myargs:=[ NIL, -> fromlist NIL, -> destination path FALSE, -> ~showinfo FALSE, -> scan recursiv throuhg subdirectories FALSE, -> ignore protectionbits FALSE, -> deep scan FALSE, -> ~compare datestamps FALSE, -> testmode FALSE, -> clone FALSE, -> preserve archive protection flag FALSE, -> smartinfo FALSE, -> fastdisplay FALSE, -> interaction FALSE, -> set Archivebit FALSE, -> check Archivbit FALSE, -> precise datestamp '#?' -> subpattern ]:LONG myrdargs:=AllocDosObject(DOS_RDARGS,NIL) StrCopy(exthelp, '\n'+ ' UpDateCopy v2.0\n'+ ' -----------------\n'+ ' Copy files and directories.\n'+ ' Not existing directories are created and\n'+ ' already existing files are only replaced\n'+ ' by newer ones. Allows pattern-matching and\n'+ ' multiple sourcedirectories/files.\n\n'+ 'Sven Steiniger, 1996-98\n' ) StrAdd(exthelp, '\n'+ ' FROM - source directory/file(s)\n'+ ' TO - destination directory\n'+ ' QUIET - no outputs\n'+ ' ALL - scans through subdirectories recursively\n'+ ' FORCE - ignore delete-protectionbit\n'+ ' DEEP - compare version-strings\n'+ ' NODATECHECK - don''t compare datestamps\n'+ ' TESTMODE - neither copy/replace files nor create directories\n'+ ' CLONE - copy datestamp\n'+ ' PAB - don''t clear the archive protection flag\n' ) StrAdd(exthelp, ' SMARTINFO - only displays copied/replaced files\n'+ ' FAST - fast output. No linefeeds\n'+ ' NOASK - don''t ask user on errors\n'+ ' SETARCBIT - set archive-bit on copied directories/files\n'+ ' CHECKARCBIT - only copy files with no archive-bit\n'+ ' PRECISEDS - compare datestamps precisly\n'+ ' PATTERN - pattern used for subdirectory scanning\n' ) myrdargs.exthelp:=exthelp /* Parse Commandline */ IF rdargs:=ReadArgs('FROM/M,TO/A,QUIET/S,ALL/S,FORCE/S,DEEP/S,'+ 'NDC=NODATECHECK/S,TESTMODE/S,CLONE/S,PAB=PAPF/S,'+ 'SMARTINFO/S,FAST/S,NOASK/S,SAB=SETARCBIT/S,'+ 'CAB=CHECKARCBIT/S,PRECISEDS/S,PAT=PATTERN/K', myargs,myrdargs) /* Copy Datas to global variables */ fromlist := myargs[0] StrCopy(topath,myargs[1]) doinfo := Not(myargs[2]) recursiv := myargs[3] ignoreprotection := myargs[4] checkversion := myargs[5] checkdates := Not(myargs[6]) testmode := myargs[7] clone := myargs[8] cleararchivebit := Not(myargs[9]) smartinfo := myargs[10] fastdisplay := myargs[11] interaction := Not(myargs[12]) setarchivebit := myargs[13] checkarchivebit := myargs[14] lousydatestamp := Not(myargs[15]) StrCopy(subpattern,myargs[16]) IF fromlist=NIL THEN Throw("ARGS",'No source specified.') init_arguments() IF doinfo PrintF('Updating files to "\s".\n',topath) IF testmode THEN PrintF('** Testmode **\n') ENDIF IF fastdisplay PrintF('\n') smartinfo:=FALSE ENDIF buffer:=NewR(IOBUFFERSIZE) -> Allocate file-io buffer WHILE fromlist[] -> 'fromlist' is array of string-pointers StrCopy(frompath,fromlist[]++) -> copy the string and increase 'fromlist' checkWildCard(frompath) scan_directory(frompath,'',1) -> then process this directory ENDWHILE PrintF('Finished.\n') ELSE PrintF('\nInvalid arguments!\n\n\s\n',exthelp) ENDIF EXCEPT DO -> Cleanup IF buffer THEN Dispose(buffer) IF fastdisplay THEN reportLine(0,'',NIL,NIL) free_arguments() IF rdargs THEN FreeArgs(rdargs) IF myrdargs THEN FreeDosObject(DOS_RDARGS,myrdargs) CloseLibrary(asynciobase) IF exception /* Print error description */ PrintF('Error: ') SELECT exception CASE "MEM" ; PrintF('Not enough memory.\n') CASE "addp" ; PrintF('Path too long !?\n') CASE "^C" ; PrintF('User abort.\n') CASE "copy" ; PrintF('Could not copy file.\n') CASE "open" ; PrintF('Could not open file.\n') CASE "anly" ; PrintF('Could not analyse file.\n') CASE "fatt" ; PrintF('Could not set file attributes.\n') CASE "asio" ; PrintF('Could not open asyncio.library v39.\n') CASE "lock" ; PrintF('Could not lock directory "\s"\n.',exceptioninfo) DEFAULT ; PrintF('\s\n',exceptioninfo) ENDSELECT ENDIF CleanUp(exception) ENDPROC ->\\ CHAR 0,'$VER: UpDateCopy 2.0 (04.07.98)',0 /* checks the arguments provied by user */ PROC init_arguments() ->// "init_arguments()" IF (dirlock:=Lock(topath,SHARED_LOCK))=NIL -> check if destination Throw("lock",topath) -> directory exists ENDIF /* Enable Version Check if datestamp-check is switch off */ IF Not(checkdates) THEN checkversion:=TRUE ENDPROC ->\\ /* Cleanup datas allocated during init_arguments */ PROC free_arguments() ->// "free_arguments()" UnLock(dirlock) -> Unlock destination directory ENDPROC ->\\ /* handles all special cases with wildcards ** Parameter: ** file - file/dir to be checked. Must be an valid Estring !! ** ** Returns the Estring. */ PROC checkWildCard(file:PTR TO CHAR) ->// "checkWildCard" DEF len, hstri[MAXPATH]:STRING, lock len:=EstrLen(file) IF file[len-1]="*" -> replace '*'-wildcard by '#?' SetStr(file,len-1) StrAdd(file,'#?') ELSEIF file[len-1]=":" -> it's an device. Therefore add wildcard StrAdd(file,subpattern) ENDIF /* Now we come to the complicated part. ** Some people use strange filenames, eg. one that contain brackets etc. ** This is valid and seems harmless but it confuses the pattern matcher! ** e.g. "Text (deutsch)" normally can't be found as it is interpreted ** as an pattern ("(|)" represents an "or"). So the file/directory ** "Text deutsch" is searched which is of course wrong. ** This example can easily be solved by preprocessing it through ** validateFilename(). ** But what happend with "Text (deutsch)/#?" ?? So strategy used here ** is to check if such an file/directory exists. If not, the last path/file ** part is skipped and the rest is checked again. This continues until ** we found an valid directory or got an empty string. Now the valid ** part is passed to validateFilename() and the rest (obvisiously the ** pattern) is added. ** ** Sill.. this algorithm may fail in some weird cases, eg. ** "Text#?(deutsch)". But I can't do anything to prevent this. ** BTW: This is more than any standard "C:" command does. */ len:=EstrLen(file) WHILE len>0 StrCopy(hstri,file,len) UnLock(lock:=Lock(hstri,SHARED_LOCK)) -> does file/directory exists (== no pattern) ? EXIT lock -> yes, then exit len:=PathPart(hstri)-hstri -> get parent directory ENDWHILE IF len>0 -> have we found any valid directory ? -> yes, then modify that it won't bother validateFilename(hstri) -> the pattern matcher StrAdd(hstri,file+len) -> add rest (==the pattern) StrCopy(file,hstri) ENDIF ENDPROC file ->\\ /* Modifies an filename so that it won't conflict with ** patter matching functions. ** For example: "Text (deutsch)" ist changed to "Text '(deutsch')". ** ** Parameter: ** name - the filename (must be an valid estring!) ** ** Maximum filename length is MAXPATH !! */ PROC validateFilename(name:PTR TO CHAR) ->// "validateFilename()" DEF len, helpstri[MAXPATH2]:STRING, src:PTR TO CHAR, dst:PTR TO CHAR, c len:=EstrLen(name) src:=name dst:=helpstri WHILE len-->=0 c:=src[]++ SELECT 127 OF c -> all tokens for the pattern matcher CASE "#" , -> ASCII 35 "%" , -> ASCII 37 "'" , -> ASCII 39 "(" , -> ASCII 40 ")" , -> ASCII 41 "*" , -> ASCII 42 "?" , -> ASCII 63 "[" , -> ASCII 91 "]" , -> ASCII 93 "|" , -> ASCII 124 "~" -> ASCII 126 dst[]++:="'" -> prefix all wildcards by "'" ENDSELECT dst[]++:=c ENDWHILE dst[]++:="\0" ->WriteF('\n "\s" --> "\s"\n',name,helpstri) len:=StrLen(helpstri) IF StrMax(name)\\ /* Scans a directory and copies files/creates subdirectories ** Parameter: ** directory - name of directory to be scanned ** path - the current delta path ** depth - recursion level ** Example: ** The source path is "esource:src". ** 'directory' is "esource:src/tools/file". ** Then 'path' have to be "tools/file". */ PROC scan_directory(directory,path,depth) HANDLE ->// "scan_directory()" DEF info:PTR TO fileinfoblock, anchor=NIL:PTR TO anchorpath, error, fullpath, mypath[MAXPATH]:STRING, dummystri[MAXPATH2]:STRING /* Create and initialize anchor structure needed for ** scanning through directory */ anchor,fullpath:=allocAnchorPath(PATHLENGTH) error:=MatchFirst(directory,anchor) WHILE error=DOSFALSE CtrlC() info:=anchor.info -> get fileinfoblock IF info.direntrytype>0 -> is it a directory ? eAddPartC(mypath, path, info.filename) -> init new delta path including new subdirectory process_directory(fullpath,info,mypath, -> knows what to do with this depth*SPACEADD) -> directory IF recursiv -> scan subdirectories ? StrCopy(dummystri, fullpath) validateFilename(dummystri) -> don't confuse the pattern matcher eAddPart(dummystri,subpattern) -> add pattern matching scan_directory(dummystri,mypath,depth+1)-> call our self with new subdirectory ENDIF ELSE process_file(fullpath,info,path, -> knows what to do with it depth*SPACEADD) ENDIF error:=MatchNext(anchor) -> Next entry ENDWHILE EXCEPT DO IF anchor MatchEnd(anchor) -> Clean up freeAnchorPath(anchor) ENDIF ReThrow() ENDPROC ->\\ /* takes care of fastdisplay-option */ PROC reportLine(spaceanz,fmtstr,arg1,arg2,doCR=TRUE) ->// "reportLine()" IF fastdisplay PrintF([141,$1b,"[","M",0]:CHAR) spaceanz:=SPACEADD ENDIF WHILE spaceanz-->=0 DO FputC(stdout," ") PrintF(fmtstr,arg1,arg2) -> Write directory name & status IF doCR THEN PrintF('\n') ENDPROC ->\\ /* Ask the user what to do on error. ** Returns ASKUSER_xxx */ PROC askError() ->// "askError()" DEF c=0, ret=ASKUSER_Abort IF interaction PrintF(' (R)etry / (S)kip / (A)bort ? ') Flush(stdout) REPEAT UNTIL WaitForChar(stdin,9999999999)=DOSTRUE c:=FgetC(stdin) Flush(stdin) IF (c="r") OR (c="R") ret:=ASKUSER_Retry ELSEIF (c="a") OR (c="A") ret:=ASKUSER_Abort ELSE c:="s" ret:=ASKUSER_Skip ENDIF ENDIF ->IF c THEN PrintF('\c',c) IF c=0 THEN PrintF('\n') ENDPROC ret ->\\ /* Prints a directory status. ** Parameter: ** spaces - number of leading spaces ** status - status (PDIR_Error, PDIR_Skipped, PDIR_Created) ** path - directory path */ PROC printDirStatus(spaces,status,path) ->// "printDirStatus()" DEF stri SELECT status CASE PDIR_Created ; stri:='created' CASE PDIR_Skipped ; IF smartinfo THEN RETURN -> don't display skipped dirs with smartinfo stri:='skipped' DEFAULT ; stri:='Error!!' ENDSELECT -> Write directory name & status IF doinfo OR (status=PDIR_Error) reportLine(spaces,'\e[1m\s\e[0m..\s',path,stri,status<>PDIR_Error) ENDIF ENDPROC ->\\ /* Process an directory. If it doesnt exists it will be created ** Parameter: ** directory - full path of source directory ** info - pointer to fileinfoblock of source directory ** path - delta path of directory */ PROC process_directory(directory,info:PTR TO fileinfoblock,path,spaces) ->// "process_directory()" DEF stri[MAXPATH]:STRING, lock, error eAddPartC(stri,topath,path) -> thats the destination-directory IF checkarchivebit AND (info.protection AND FIBF_ARCHIVE) -> Archive-bit set ? printDirStatus(spaces, PDIR_Skipped, path) ELSEIF lock:=Lock(stri,SHARED_LOCK) -> Exists this Directory ? UnLock(lock) -> Unlock directory printDirStatus(spaces, PDIR_Skipped, path) setArchiveBit(directory,info) ELSEIF testmode -> Don't create directory in testmode printDirStatus(spaces, PDIR_Created, path) -> but write out a info ELSEIF lock:=needThisDir(stri) -> Create the directory UnLock(lock) -> No errors, unlock directory printDirStatus(spaces, PDIR_Created, path) copyAdditionalInformations(stri,info) setArchiveBit(directory,info) ELSE -> Directory could not be created printDirStatus(spaces, PDIR_Error, path) -> as it does not exists before error:=askError() SELECT error CASE ASKUSER_Abort Throw("dir",'Could not create directory')-> something went wrong CASE ASKUSER_Retry process_directory(directory,info,path,spaces) ENDSELECT ENDIF ENDPROC ->\\ /* ** Truncates the tick-entry of the datestamp to be a multiple of 100. ** (lha does this!!) ** It seems they transform the ticks into seconds (/50) and made ** them a multiple of 2. */ PROC simplifyDateStamp(ds:PTR TO datestamp) ->// "simplifyDateStamp" ds.tick:=ds.tick/100*100 ENDPROC ->\\ /* ** Gets the PathPart of an string. ** 'dst' must be an EString! ** Returns 'dst'. */ PROC getPath(dst, stri) IS StrCopy(dst, stri, PathPart(stri)-stri) /* Checks if an directory already exists. ** If not it (and all necessary parent directories) are created. ** Parameter: ** stri - full name of the directory to be created ** Returns a lock to the directory or NIL in case of an error. */ PROC needThisDir(stri:PTR TO CHAR) ->// "needThisDir()" DEF lock, hstri[MAXPATH]:STRING ->WriteF('need dir >>\s<<\n',stri) CtrlC() IF lock:=Lock(stri, SHARED_LOCK) -> Already exists ELSEIF lock:=needThisDir(getPath(hstri, stri)) -> All parent directories exists UnLock(lock) lock:=CreateDir(stri) ENDIF ENDPROC lock ->\\ /* Prints a file status. ** Parameter: ** spaces - number of leading spaces ** status - status (PFILE_Error, PFILE_Skipped, PFILE_Created, PFILE_Skipped) ** file - filename */ PROC printFileStatus(spaces,status,file) ->// "printFileStatus()" DEF stri SELECT status CASE PFILE_Copied ; stri:='copied' CASE PFILE_Replaced ; stri:='replaced' CASE PFILE_Skipped ; IF smartinfo THEN RETURN -> don't display skipped dirs with smartinfo stri:='skipped' DEFAULT ; stri:='Error!!' ENDSELECT -> Write file status IF doinfo OR (status=PFILE_Error) reportLine(spaces,'\s..\s',file,stri,status<>PFILE_Error) ENDIF ENDPROC ->\\ /* Processes an file. If it does not exists or is newer it is copied. ** Parameter: ** file - full source filename (include path) ** info - ptr to fileinfoblock of sourcefile ** path - deltapath to directory (exclude filename !) */ PROC process_file(file,info:PTR TO fileinfoblock,path,spaces) HANDLE ->// "process_file()" DEF stri[MAXPATH]:STRING, filepath[MAXPATH]:STRING, fh=NIL, toinfo=NIL:PTR TO fileinfoblock, result=0, frombuf=NIL, lock, hstri[MAXPATH]:STRING eAddPartC(filepath,path,info.filename) -> create deltapath inclusive filename eAddPartC(stri,topath,filepath) -> create full destination filepath IF checkarchivebit AND (info.protection AND FIBF_ARCHIVE) -> Archive-bit set -> Do not copy already archived files printFileStatus(spaces, PFILE_Skipped, filepath) ELSEIF fh:=Open(stri,MODE_OLDFILE) -> Open destinationfile IF checkversion THEN result,frombuf:=compareversion(file,stri) IF checkdates AND (result=0) /* Fileinfoblock have to be LONGWORD-aligned therefore ** use dos.library to create this */ toinfo:=AllocDosObject(DOS_FIB,NIL) -> fill fileinfoblock IF ExamineFH(fh,toinfo)=DOSFALSE THEN Throw("file",'Could not examine file ?!') /* lha compatible datestamp compare ? */ IF lousydatestamp simplifyDateStamp(info.datestamp) simplifyDateStamp(toinfo.datestamp) ENDIF /* Compare versionstrings was either not specified by user ** or was not successfull. Therefore Compare filedates if ** the user want it. */ result:=CompareDates(toinfo.datestamp,info.datestamp) ENDIF IF result>0 -> fromfile newer than tofile ? Close(fh) ; fh:=NIL -> close destination IF Not(testmode) IF ignoreprotection THEN SetProtection(stri,0) -> Clear protectionflags if specified copyfile(file,info,stri,frombuf) -> copy the file ENDIF printFileStatus(spaces, PFILE_Replaced, filepath) ELSE printFileStatus(spaces, PFILE_Skipped, filepath) ENDIF ELSEIF testmode -> destination does not exists but testmode printFileStatus(spaces, PFILE_Copied, filepath) ELSEIF lock:=needThisDir(getPath(hstri, stri)) -> destination does not exists UnLock(lock) copyfile(file,info,stri) -> copy file printFileStatus(spaces, PFILE_Copied, filepath) ENDIF EXCEPT DO -> Cleanup IF toinfo THEN FreeDosObject(DOS_FIB,toinfo) IF fh THEN Close(fh) IF exception printFileStatus(spaces, PFILE_Error, filepath) result:=askError() SELECT result CASE ASKUSER_Abort ReThrow() -> something went wrong CASE ASKUSER_Retry process_file(file,info,path,spaces) ENDSELECT ENDIF ENDPROC ->\\ /* Copies a file. For files >BIGFILESIZE Bytes c:copy is ** used. ** Parameter: ** fromfile - full path of sourcefile ** tofile - full path of destinationfile ** frombuf - Contents of sourcefile. If NIL then sourcefile ** is read */ PROC copyfile(fromfile,frominfo:PTR TO fileinfoblock,tofile,frombuf=NIL) HANDLE ->// "copyfile()" DEF fhfrom=NIL, fhto=NIL, length, steplength,actlength IF ((fhfrom:=OpenAsyncRead(fromfile))<>NIL) AND -> open sourcefile ((fhto:=OpenAsyncWrite(tofile))<>NIL) -> open destinationfile IF (length:=frominfo.size)>BIGFILESIZE /* Files >BIGFILESIZE are not read completly into memory but in parts ** of BIGFILESIZE Bytes. */ /* steplength is the length of the current block to be read */ /* actlength is the position within the file */ steplength:=actlength:=BIGFILESIZE REPEAT /* Read next block to buffer */ SafeReadAsync(fhfrom,buffer,steplength,"copy") /* Write buffer to destinationfile */ SafeWriteAsync(fhto,buffer,steplength,"copy") IF (actlength:=actlength+BIGFILESIZE)>length steplength:=length-(actlength-BIGFILESIZE) ENDIF /* Read until version-string was found or EOF */ UNTIL steplength<=0 ELSE IF frombuf -> we already know the -> contents of the sourcefile /* Write buffer to destinationfile */ SafeWriteAsync(fhto,frombuf,length,"copy") ELSE /* Read sourcefile into buffer */ SafeReadAsync(fhfrom,buffer,length,"copy") /* Write buffer TO destinationfile */ SafeWriteAsync(fhto,buffer,length,"copy") ENDIF ENDIF ELSE -> There went something wrong Raise("copy") ENDIF EXCEPT DO CloseAsyncRead(fhfrom) CloseAsyncWrite(fhto,"copy") ReThrow() /* Everything went ok. Copy comment, protection flags etc. */ copyAdditionalInformations(tofile,frominfo) setArchiveBit(fromfile,frominfo) ENDPROC ->\\ /* Sets the archive bit for an file/directory if wanted. ** Parameter: ** name - the valid file or directory name ** info - the fileinfoblock of 'name' */ PROC setArchiveBit(name:PTR TO CHAR, info:PTR TO fileinfoblock) ->// "setArchiveBit()" IF Not(testmode) AND setarchivebit SetProtection(name,info.protection OR FIBF_ARCHIVE) ENDIF ENDPROC ->\\ /* Copies extra informations like protectionbits, comment etc. ** 'name' must be a valid File- or Directory name ** 'info' is the fileinfoblock of the original file/directories ** (the dates are copied from it) ** ** Note: the file may not be opened or locked! */ PROC copyAdditionalInformations(name,info:PTR TO fileinfoblock) ->// "copyAdditionalInformations()" DEF protection /* Clear protectionbit (or not) */ protection:=info.protection IF cleararchivebit THEN protection:=protection AND Not(FIBF_ARCHIVE) SetProtection(name,protection) -> Copy protection bits SetComment(name,info.comment) -> Copy comment /* Copy datestamp if clone option is activated */ IF clone THEN SetFileDate(name,info.datestamp) ENDPROC ->\\ /* Compares the version-strings of two files ** Parameter: ** fromfile - full path of sourcefile ** tofile - full path of destinationfile ** ** Returns ** -1 if tofile-version>=fromfile-version ** 0 on error ** 1 if < ** *AND* the contents of the sourcefile or NIL */ PROC compareversion(fromfile,tofile) ->// "compareversion()" DEF frombuf:PTR TO CHAR, version1,base1, version2,base2 /* We dont need the destination file. Therefore don't get buffer. */ version2,base2:=getVersionOfFile(tofile) /* if version is -1 then no version-string was found */ IF version2=-1 THEN RETURN 0,NIL version1,base1,frombuf:=getVersionOfFile(fromfile) IF version1=-1 THEN RETURN 0,frombuf /* Compare the version, reversion of source/destionation ** multiply with other base to get same number of signifant numbers */ RETURN IF (version2*base1)>=(version1*base2) THEN -1 ELSE 1,frombuf ENDPROC ->\\ /* Gets the version-number of a file ** Parameter: ** filename - full path of file ** Returns the version, base and a buffer with the contents of the file ** (description for version,base see getversion()) ** buffer may be NIL if file was to large */ PROC getVersionOfFile(filename) HANDLE ->// "getVersionOfFile()" DEF fh, frombuf=NIL, version,base, steplength,filelength,actlength filelength:=FileLength(filename) IF (fh:=OpenAsyncRead(filename))=NIL THEN Raise("open") IF filelength>BIGFILEMEM /* Files >BIGFILESIZE are not read completly into memory but in parts ** of BIGFILESIZE Bytes. ** As we may skip a versionstring the last SAFETYBYTES are copied ** to start of new BIGFILESIZE block everytime. */ /* Read filecontents into buffer */ SafeReadAsync(fh,buffer,BIGFILEMEM,"anly") /* steplength is the length of the current block to be read */ steplength:=BIGFILESIZE /* actlength is the position within the file */ actlength:=BIGFILEMEM REPEAT /* Get version. If version=-1 then read next block */ version,base:=getversion(buffer,steplength+SAFETYBYTES) IF version=-1 /* The version-string was maybe at the end of buffer ** and therfore skipped. Copy the last SAFETYBYTES bytes ** to start of buffer to not lose the version-string. */ CopyMem(buffer+steplength,buffer,SAFETYBYTES) /* Increase actlength. If actlength is greater than filelength ** then set steplength to the number of bytes left. */ actlength:=actlength+BIGFILESIZE IF actlength>filelength steplength:=filelength-(actlength-BIGFILESIZE) ENDIF /* Read next block to buffer. If steplength<0 then EOF is reached */ IF steplength>0 SafeReadAsync(fh,buffer+SAFETYBYTES,steplength,"anly") ENDIF ENDIF /* Read until version-string was found or EOF */ UNTIL (version<>-1) OR (steplength<=0) ELSE /* We have got a small file. Load it completly into memory. */ SafeReadAsync(fh,buffer,filelength,"anly") /* Notify that we have the file already loaded */ frombuf:=buffer /* get versions and reversion of sourcefile */ version,base:=getversion(buffer,filelength) ENDIF EXCEPT DO /* Close the filehandle */ CloseAsyncRead(fh) ReThrow() ENDPROC version,base,frombuf ->\\ /* Search for a version-string in a file ** Parameter: ** buffer - Contents of file ** bufferlength - length of buffer in bytes ** Returns version,base ** if no version-string was found (or bufferend reached) then -1 is ** returned as version ** Example: version=81259, base=10000 means ** Versionnumber is 81259/10000=8.1259 */ PROC getversion(buffer:PTR TO CHAR,bufferlength) ->// "getversion()" -> Works with up to 2Gig DEF version:REG,base:REG MOVEA.L buffer,A0 -> A0..buffer MOVE.L bufferlength,D0 -> D0..bufferlength MOVEQ #"$",D1 MOVE.L #"VER:",D2 gv_search_loop: SUBQ.L #1,D0 BLT.S gv_error -> bufferend reached ? CMP.B (A0)+,D1 BNE.S gv_search_loop -> Found a "$" ? CMP.L (A0),D2 -> Yes, then next characters="VER:" BNE.S gv_search_loop SUBQ.L #4,D0 -> We have found a version-string BGT.S gv_found_ok ->#### gv_error: -> general error entry point. -> it is placed here because we can reached -> it from all loops with an short branch -> (faster) MOVEQ #-1, version -> an error occured (bufferend reached) BRA.S gv_return ->#### gv_found_ok: ADDQ.L #4,A0 -> skip "VER:" MOVEQ #" ",D1 gv_skipspaces: -> skip all spaces before programname SUBQ.L #1,D0 BLT.S gv_error -> bufferend reached ? CMP.B (A0)+,D1 BEQ.S gv_skipspaces gv_skipname: -> skip programname (find next space) SUBQ.L #1,D0 BLT.S gv_error -> bufferend reached ? CMP.B (A0)+,D1 BNE.S gv_skipname gv_findnumber: -> search first number SUBQ.L #1,D0 BLT.S gv_error -> bufferend reached ? MOVE.B (A0)+,D2 CMPI.B #"0",D2 BLT.S gv_findnumber -> <"0" ? then not found CMPI.B #"9",D2 BGT.S gv_findnumber -> >"9" ? then not found ADDQ.L #1,D0 -> go one step back SUBQ.L #1,A0 MOVEQ #0,version MOVEQ #1,base MOVEQ #9,D1 MOVEQ #0,D2 gv_getversion: -> get version until we found a non-number SUBQ.L #1,D0 BLT.S gv_error -> bufferend reached ? MOVE.B (A0)+,D2 SUBI.B #"0",D2 -> Transform character "0".."9" into number BMI.S gv_getversion_end -> <0 then version end reached CMP.B D1,D2 BGT.S gv_getversion_end -> >9 then version end reached MULU.W #10,version -> version:=version*10 ADD.L D2,version -> +number BRA.S gv_getversion gv_getversion_end: CMPI.B #"."-"0",D2 BNE.S gv_return -> not a "." then return MOVEQ #0,D2 gv_getreversion: -> get reversion SUBQ.L #1,D0 BLT.S gv_error -> bufferend reached ? MOVE.B (A0)+,D2 SUBI.B #"0",D2 -> Transform character "0".."9" into number BMI.S gv_return -> <0 then reversion end reached CMP.B D1,D2 BGT.S gv_return -> >9 then reversion end reached MULU.W #10,version -> version:=version*10 MULU.W #10,base -> base:=base*10 ADD.L D2,version -> +number BRA.S gv_getreversion gv_return: ENDPROC version,base ->\\