/* $VER: xPKE 1.1 (16-4-97) © Frédéric RODRIGUES - Freeware XPK Packing in E xPKE is declared freeware. This is intended for a learning use to encourage programming of XPK in E. Do whatever you want with the files but keep all files unchanged and together if you distribute it and mention my name on your creations if you use it. I would appreciate little donations for my work (who knows somebody will send me something - please, send me at least an email). Reach me at : rodrigue@iles.siera.ups-tlse.fr (IP 130.120.84.50) This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. V1.0 (18-3-97) - First Was not able to make ctrl-c break to function There's a bug on the AmigaDos functions MatchFirst() MatchEnd() : Fails when using wildcards without the TARGET option (at least with my v37). Same bug on original xPack.c. V1.1 (16-4-97) - Now better than xPack.c and xpk.c because I could make function ctrl-c break in the hook (see end of this) Still the bug reported in V1.0 Corrected little (?) bug (xPackIt has it) which not copy the comment,date,protection on the TARGET subdirectories (it took me a while to implement this without sacrifying the existent code) Modified hook Did a little better programing (guess what ?) */ OPT OSVERSION=36 MODULE 'xpk/xpk','xpkmaster','utility/tagitem','dos/dos','utility/hooks', 'dos/dosasl' CONST MAXCHARFILE=256 ENUM ER_OK,ER_LIB,ER_XPK,ER_DOS,ER_MEM CONST TAG_INNAMED=3,TAG_OUTNAMET=4,TAG_OUTNAMED=5,TAG_FILENAMED=11, TAG_PACKMETHODD=13 ENUM ARG_FILES,ARG_TARGET,ARG_METHOD,ARG_PASSWORD,ARG_LOSSY,ARG_QUIET, ARG_ALL,ARG_FORCE DEF xpkerrmsg[XPKERRMSGSIZE]:STRING,tags:PTR TO LONG, fib:PTR TO fileinfoblock,chunkhook:hook,myargs:PTR TO LONG,rdargs, progress:PTR TO xpkprogress,files:PTR TO LONG,anchor:PTR TO anchorpath, outfile[MAXCHARFILE]:STRING,lock,achain:PTR TO achain,xpkfib:xpkfib, size,curdir[MAXCHARFILE]:STRING PROC main() HANDLE DEF err,delete WriteF('\e[1m$VER: xPKE 1.1 (16-4-97) © Frédéric RODRIGUES - Freeware\n'+ '\e[4mXPK Packing in E\n\n\e[22m\e[24m') myargs:=[NIL,NIL,NIL,NIL,NIL,NIL,NIL,NIL] IF (rdargs:=ReadArgs('FILES/M/A,TARGET/K,METHOD/K,PASSWORD/K,LOSSY/S,'+ 'QUIET/S,ALL/S,FORCE/S', myargs,NIL))=NIL THEN Raise(ER_DOS) IF (xpkbase:=OpenLibrary('xpkmaster.library',2))=NIL THEN Raise(ER_LIB) chunkhook.entry:={chunkfunc} GetCurrentDirName(curdir,StrMax(curdir)) SetStr(curdir,StrLen(curdir)) IF curdir[StrLen(curdir)-1]<>":" THEN StrAdd(curdir,'/',ALL) tags:=[XPK_GETERROR,xpkerrmsg, XPK_INNAME,NIL, XPK_OUTNAME,NIL, XPK_PASSWORD,myargs[ARG_PASSWORD], IF myargs[ARG_QUIET] THEN TAG_IGNORE ELSE XPK_CHUNKHOOK,chunkhook, XPK_FILENAME,NIL, IF myargs[ARG_METHOD] THEN XPK_PACKMETHOD ELSE TAG_DONE,myargs[ARG_METHOD], IF myargs[ARG_LOSSY] THEN XPK_LOSSYOK ELSE TAG_IGNORE,myargs[ARG_LOSSY], XPK_GETOUTLEN,{size},TAG_DONE] IF myargs[ARG_PASSWORD] THEN myargs[ARG_FORCE]:=TRUE files:=myargs[ARG_FILES] IF (anchor:=New(SIZEOF anchorpath+MAXCHARFILE))=NIL THEN Raise(ER_MEM) anchor.breakbits:=SIGBREAKF_CTRL_C anchor.strlen:=MAXCHARFILE-1 WHILE files[] err:=MatchFirst(files[]++,anchor) WHILE err=0 fib:=anchor.info IF fib.direntrytype>0 IF ((anchor.flags AND APF_DIDDIR)=0) AND myargs[ARG_ALL] THEN anchor.flags:=anchor.flags OR APF_DODIR anchor.flags:=anchor.flags AND Not(APF_DIDDIR) ELSE achain:=anchor.last lock:=CurrentDir(achain.lock) tags[TAG_INNAMED]:=fib.filename IF myargs[ARG_TARGET] THEN makeoutfile(outfile,anchor+SIZEOF anchorpath) ELSE StringF(outfile,'xPKE\z\h[8]',FindTask(NIL)) tags[TAG_OUTNAMED]:=outfile tags[TAG_FILENAMED]:=fib.filename delete:=TRUE IF fib.protection AND FIBF_DELETE AND (myargs[ARG_TARGET]=FALSE) WriteF('\e[33mSkip\e[31m: \s delete protected\n',fib.filename) delete:=FALSE ELSE IF tags[TAG_PACKMETHODD] tags[TAG_OUTNAMET]:=TAG_DONE IF XpkExamine(xpkfib,tags)<>0 THEN Raise(ER_XPK) tags[TAG_OUTNAMET]:=XPK_OUTNAME IF xpkfib.type=XPKTYPE_UNPACKED OR myargs[ARG_FORCE] size:=0 IF XpkPack(tags)<>0 THEN Raise(ER_XPK) IF (size>fib.size) AND (myargs[ARG_FORCE]=FALSE) DeleteFile(tags[TAG_OUTNAMED]) WriteF('\e[33mSkip\e[31m: \s not packable\n',fib.filename) IF myargs[ARG_TARGET] THEN copy(tags[TAG_INNAMED],tags[TAG_OUTNAMED]) delete:=FALSE ENDIF ELSE WriteF('\e[33mSkip\e[31m: \s already packed\n',fib.filename) IF myargs[ARG_TARGET] THEN copy(tags[TAG_INNAMED],tags[TAG_OUTNAMED]) delete:=FALSE ENDIF ELSE IF (err:=XpkUnpack(tags))<>0 IF err=XPKERR_NOTPACKED WriteF('\e[33mSkip\e[31m: \s not packed\n',fib.filename) IF myargs[ARG_TARGET] THEN copy(tags[TAG_INNAMED],tags[TAG_OUTNAMED]) delete:=FALSE ELSE Raise(ER_XPK) ENDIF ENDIF ENDIF ENDIF SetComment(tags[TAG_OUTNAMED],fib.comment) SetProtection(tags[TAG_OUTNAMED],fib.protection) SetFileDate(tags[TAG_OUTNAMED],fib.datestamp) IF (myargs[ARG_TARGET]=FALSE) AND delete IF DeleteFile(tags[TAG_INNAMED])=FALSE THEN Raise(ER_DOS) IF Rename(tags[TAG_OUTNAMED],tags[TAG_INNAMED])=FALSE THEN Raise(ER_DOS) ENDIF CurrentDir(lock) lock:=NIL ENDIF err:=MatchNext(anchor) ENDWHILE IF err<>ERROR_NO_MORE_ENTRIES THEN Raise(ER_DOS) MatchEnd(anchor) ENDWHILE anchor:=NIL Raise(ER_OK) EXCEPT IF xpkbase THEN CloseLibrary(xpkbase) IF rdargs THEN FreeArgs(rdargs) IF lock THEN CurrentDir(lock) IF anchor THEN MatchEnd(anchor) SELECT exception CASE ER_DOS;PrintFault(IoErr(),'\e[32mxPKE\e[31m');RETURN RETURN_FAIL CASE ER_LIB;WriteF('\e[32mxPKE\e[31m: cannot open xpkmaster.library');RETURN RETURN_ERROR CASE ER_XPK;WriteF('\e[32mxPKE\e[31m: \s\n',xpkerrmsg);RETURN RETURN_FAIL CASE ER_MEM;PrintFault(ERROR_NO_FREE_STORE,'\e[32mxPKE\e[0m');RETURN RETURN_ERROR ENDSELECT ENDPROC PROC makeoutfile(outfile,infile) DEF p=-1,buf[MAXCHARFILE]:STRING,len,indir[MAXCHARFILE]:STRING, lock,fib:fileinfoblock,i StrCopy(outfile,myargs[ARG_TARGET],ALL) IF outfile[StrLen(outfile)-1]<>":" THEN StrAdd(outfile,'/',ALL) len:=StrLen(outfile) MidStr(buf,infile,InStr(infile,':',0)+1,ALL) StrAdd(outfile,buf,ALL) WHILE (p:=InStr(outfile,'/',p+1))<>-1 FOR i:=0 TO StrMax(buf)-1 DO buf[i]:=0 MidStr(buf,outfile,0,p) UnLock(CreateDir(buf)) StrCopy(indir,curdir,ALL) StrAdd(indir,buf+len,ALL) IF (lock:=Lock(indir,SHARED_LOCK))=0 THEN Raise(ER_DOS) IF Examine(lock,fib)=FALSE THEN Raise(ER_DOS) SetComment(buf,fib.comment) SetProtection(buf,fib.protection) SetFileDate(buf,fib.datestamp) UnLock(lock) ENDWHILE ENDPROC PROC copy(src,dest) HANDLE DEF buf[512]:STRING,fhsrc,fhdest,nbytes IF (fhsrc:=Open(src,OLDFILE))=NIL THEN Raise(ER_DOS) IF (fhdest:=Open(dest,NEWFILE))=NIL THEN Raise(ER_DOS) WHILE (nbytes:=Read(fhsrc,buf,512))>0 IF Write(fhdest,buf,nbytes)<>nbytes THEN Raise(ER_DOS) ENDWHILE IF nbytes<0 THEN Raise(ER_DOS) Raise(ER_OK) EXCEPT IF fhsrc THEN Close(fhsrc) IF fhdest THEN Close(fhdest) IF exception=ER_DOS THEN Raise(ER_DOS) ENDPROC PROC chunkfunc() MOVE.L A1,progress WriteF('\b\s - \e[1m\s\e[22m - \d/\d kb, \d% CF, \e[1m\d% done\e[22m', progress.activity,progress.filename,progress.ccur/1024, progress.ulen/1024,progress.cf,progress.done) IF (progress.type=XPKPROG_END) THEN WriteF('\e[11D at \d b/s\n',progress.speed) ENDPROC CtrlC()