home *** CD-ROM | disk | FTP | other *** search
Wrap
/* $VER: LZXDir.dopus5 1.1 tINIC/mAXIMUM (26.6.95) - This version by Stone-D Copyright © 1995 by Edmund Vermeulen This version by Stone-D (Laga Hale) Modified to co-exist with lha version of same file also modified by Stone-D. Placed in the public domain. No restrictions on distribution or usage. Usage differences with original : The original required you to change the lister buttons to link to the actual arexx script. Not so with this one. Change, for example, the COPY button from AREXX DOpus5:Rexx/LzxDir.dopus5 {Qp} back to the COMMAND COPY. Do the same with MOVE, and DELETE. EMail Stone-D at the following address : stone-d@eldar.demon.co.uk To make LzxDir.dopus5 open it's own listview, refer to line 165 ARexx script for Directory Opus 5 to show the contents of an Lzx archive in an Opus lister and operate on the files and directories inside the archive as if it is a normal directory, whilst allowing simultaneous access to similiar scripts...such as the lzxdir.dopus5 one. */ ver='$VER: LZXDir.dopus5 1.1 tINIC/mAXIMUM (26.6.95) - This version by Stone-D' /* for compiled version */ signal on syntax /* intercept syntax errors */ options results /* need results */ options failat 21 /* external commands are allowed return code 20 */ numeric digits 10 /* needed for convertdate routine */ lf='0a'x /* ascii code for linefeed */ if ~show('l','rexxsupport.library') then call addlib('rexxsupport.library',0,-30) /* needed for delay() */ /* init locale */ ok=show(l,'locale.library') if ~ok then ok=addlib('locale.library',0,-30) if ok then catalog=opencatalog('LZXDir.catalog','english',0) parse arg cmd portname handle . '"' dblclck '"' . upper cmd if portname~='' then address value portname else portname=address() parse var portname '.' portno /* port number */ if handle='' then do lister query source if rc>0 then call quitit parse var result handle . /* only need first source */ end lister query handle numselentries entries=result if dblclck~=='' then do entries=1 if right(dblclck,1)='/' then do filetype=1 selentry=left(dblclck,length(dblclck)-1) end else do filetype=-1 selentry=dblclck end end else if entries>0 then call getfirstone call checkLZXdir(handle) topline='' listLZX=0 notmove=cmd~='MOVE' select when cmd='GETDIR' then call dogetdir when cmd='BROWSE' then call dogetdir when cmd='GETSIZES' then call dogetsizes when cmd='DELETE' then call dodelete when cmd='COPY' then call docopy when cmd='MOVE' then call docopy when cmd='MAKEDIR' then call domakedir otherwise if LZXdir then do lister select handle '"'selentry'"' off lister refresh handle address command 'LZX -m x "'||patch(LZXfile,0)||'" "'||patch(LZXsubdir||selentry,1)||'" T:' if rc>0 then call quitit(getcatstr(11,'Error while extracting from archive.')) thisfile='"T:'patch(LZXsubdir||selentry,1)'"' command cmd thisfile lister wait handle do until rc~=20 /* keep trying until not in use */ call delay(200) address command 'Delete >NIL:' thisfile 'QUIET FORCE ALL' end end else command cmd end call quitit(topline) /* finished */ dogetdir: if ~show('p','LZXDir-handler'portno) then address command 'Run >NIL: <NIL: rx DOpus5:arexx/LZXDir-handler' portname oldLZXdir=LZXdir if entries>0 then if filetype>0 then /* list a new dir */ if LZXdir then LZXsubdir=LZXsubdir||selentry'/' else winpath=winpath||selentry'/' else do /* list an archive file */ if pos('|'upper(right(selentry,4)'|'),'|.LZX|')=0 then call quitit(getcatstr(18,'Sorry, LZXDir.dopus5 can only'lf'list LZX archives.')) if LZXdir then do lister query dest if rc>0 then call quitit(getcatstr(9,'No destination selected!')) parse var result desthandle . lister query desthandle path destpath=result dopus request '"'getcatstr(20,'This is an archive in an archive.'lf||lf'Extract it to'lf"'%s'"lf'and then list it?',destpath)'"' getcatstr(21,'Extract|Cancel') if ~rc then call quitit address command 'LZX e -m -a "'patch(LZXfile,0)'" "'destpath'" "'patch(LZXsubdir||selentry,1)'"' if rc>0 then call quitit(getcatstr(11,'Error while extracting from archive.')) lister read desthandle '"'destpath'"' force LZXfile=destpath||selentry end else LZXfile=winpath||selentry LZXdir=1 LZXsubdir='' listLZX=1 end lister select handle '"'selentry'"' off lister refresh handle if LZXdir then do if cmd='BROWSE' then do oldhandle=handle /* The following makes lzxdir open it's own lister window. Uncomment to make it true */ /* lister new */ /* handle=result */ lister set handle title getcatstr(0,'LZXDir listed archive') lister set handle source address command 'Copy >NIL: T:LZXDir.list'oldhandle 'T:LZXDir.list'handle end else do if ~oldLZXdir then lister empty handle /* use a new cache */ lister set handle title getcatstr(0,'LZXDir listed archive') end call showLZXdir end else if cmd='BROWSE' then command scandir new winpath else do if entries=0 then winpath='' command scandir winpath end return dodelete: askdelete=1 if LZXdir then do if entries=0 then call quitit if notmove then do lister set handle busy on if askdelete then do lister query handle numselfiles nfiles=result lister query handle numseldirs ndirs=result dopus request '"'getcatstr(5,'Warning: you cannot get back'lf'what you delete! OK to delete:'lf||lf'%s file(s) and'lf'%s drawer(s) (and their contents)?',nfiles,ndirs)'"' getcatstr(6,'Proceed|Cancel') if ~rc then call quitit end call getall end actionfile_1="" call open('actionfile','T:actionfile'handle,'w') do i=1 to entries if type.i>0 then wild='/#?' else wild='' call writeln('actionfile','"'patch(LZXsubdir||name.i,1)||wild'"') actionfile_1=actionfile_1||'"'patch(LZXsubdir||name.i,1)||wild'" ' lister remove handle '"'name.i'"' end call close('actionfile') lister set handle progress '-1' getcatstr(7,'Deleting from archive...') address command 'LZX d -m "'patch(LZXfile,0)'" 'actionfile_1 if rc>0 then do topline=getcatstr(8,'Error while deleting from archive.') listLZX=1 call showLZXdir end else lister refresh handle address command 'Delete >NIL: T:actionfile'handle 'QUIET' address command 'Delete >NIL: T:LZXDir.list'handle 'QUIET' /* archive has changed */ lister set handle busy off end else do command delete lister wait handle end return docopy: if entries=0 then call quitit problem=0 src=winpath s_LZXdir=LZXdir s_LZXfile=LZXfile s_LZXsubdir=LZXsubdir lister query dest if rc>0&LZXdir then call quitit(getcatstr(9,'No destination selected!')) parse var result desthandle . /* only need first destination */ call checkLZXdir(desthandle) if s_LZXdir then do lister set handle busy on lister set desthandle busy on if LZXdir then winpath='T:LZXDir'handle'/'LZXsubdir call getall call LZXextract if LZXdir then do src=winpath call LZXadd end else if problem then do lister set desthandle busy off lister read desthandle '"'destpath'"' force end else do do i=1 to entries lister query handle entry '"'name.i'"' stem fileinfo. if fileinfo.type>0 then fileinfo.size=0 lister add desthandle '"'name.i'"' fileinfo.size fileinfo.type fileinfo.date fileinfo.protstring fileinfo.comment end lister refresh desthandle end end else if LZXdir then do lister set handle busy on if ~notmove then do cuthere=lastpos('/',LZXfile) if cuthere=0 then cuthere=pos(':',LZXfile) name=substr(LZXfile,cuthere+1) if left(LZXfile,length(src))==src then do name=substr(LZXfile,length(src)+1) parse var name name '/' lister query handle entry '"'name'"' stem fileinfo. if fileinfo.selected then call quitit(getcatstr(19,'You can''t move an archive into itself!')) end end lister set desthandle busy on call getall call LZXadd end else do /* normal copy or move */ if notmove then command copy else command move lister wait handle end lister set handle busy off lister set desthandle busy off if (s_LZXdir|LZXdir)&~notmove&~problem then do LZXdir=s_LZXdir LZXfile=s_LZXfile LZXsubdir=s_LZXsubdir lister query handle abort if result then call quitit(getcatstr(3,'Aborted...')) lister set handle busy off lister wait handle call dodelete end return dogetsizes: if LZXdir then do lister set handle busy on lister set handle progress '-1' getcatstr(14,'Scanning directories...') lister query handle numseldirs ndirs=result lister query handle seldirs stem dname. n=1 do i=0 to dname.count-1 dirname.n=dname.i lister query handle entry '"'dirname.n'"' stem fileinfo. if fileinfo.size=0 then n=n+1 end dirsize.=0 dirsecs.=0 ndirs=n-1 call readlist(0) lister set handle busy off end else command getsizes return domakedir: lister set handle busy on dopus request '"MAKEDIR not supported yet for LZXDir V1.1!'lf'Simply make an Directory (f.ex. in T:)'lf'and copy it into the LZX file..."' '"_fUCK yA!!!"' /* dopus getstring '"'getcatstr(15,'Enter directory name or archive name.lzx')'" 31 ""' getcatstr(16,'OK|Cancel') dirtomake=result if dirtomake==''|dirtomake='RESULT' then call quitit now=date('i')*86400+time('s') if LZXdir then do /* create empty dir in archive */ call createdirs(dirtomake'/') address command 'cd T:LZXDir'handle'/' address command 'LZX a -m -e -r "'patch(LZXfile,0)'" T:LZXDir'handle'/ T:LZXDir'handle'/#?' if rc>0 then topline=getcatstr(13,'Error while adding to archive.') else do lister add handle '"'dirtomake'" -1 1' now '----rwed' lister refresh handle end address command 'Delete >NIL: T:LZXDir'handle 'ALL QUIET' address command 'Delete >NIL: T:LZXDir.list'handle 'QUIET' end else if upper(right(dirtomake,4))=='.LZX' then /* create new archive */ if open('emptyarchive',winpath||dirtomake,'w') then do call writech('emptyarchive','0'x) call close('emptyarchive') command protect 'NAME "'winpath||dirtomake'" CLEAR e' lister add handle '"'dirtomake'" 1 -1' now '----rw-d' lister refresh handle end else topline=getcatstr(17,'Error creating archive.') else do /* normal makedir */ lister set handle busy off command makedir 'NOICON NAME "'dirtomake'"' end */ return showLZXdir: lister clear handle lister set handle busy on lister set handle progress '-1' getcatstr(1,'Listing archive...') lister set handle handler 'LZXDir-handler'portno lister set handle path LZXfile'/'LZXsubdir lister refresh handle full now=date('i')*86400+time('s') ndirs=0 call readlist(1) return readlist: arg show /* showdir or getsizes? */ if ~exists(LZXfile) then call quitit(getcatstr(22,'Error, archive not found.')) if listLZX|~exists('T:LZXDir.list'handle) then call LZXlist call open('tempfile','T:LZXDir.list'handle,'r') do 9 call readln('tempfile') /* waste the first 3 lines */ end compstr=upper(LZXsubdir) complen=length(compstr) nextline=readln('tempfile') do until eof('tempfile') do while pos('%',nextline)=length(nextline) nextline=readln('tempfile') end name=strip(substr(nextline,64,length(nextline))) infoline=nextline if nextline=='-------- -------- ----- --------- --------' then leave comment='' nextline=readln('tempfile') if upper(left(name,complen))==compstr then do name=substr(name,complen+1) if name~==''&pos('"',name)=0 then do if pos('/',name)>0 then do /* it's a dir */ parse var name dirname '/' olddir=0 i=ndirs+1 do while i>1&~olddir i=i-1 olddir=upper(dirname)==upper(dirname.i) end if olddir&~show then do call convertdate dirsize.i=dirsize.i+size if seconds>dirsecs.i then dirsecs.i=seconds end if show&~olddir then do /* a new dir */ ndirs=ndirs+1 dirname.ndirs=dirname lister add handle '"'dirname'" -1 1' now '----rwed' end end else /* it's a file */ if show then do call convertdate lister add handle '"'name'"' size '-1' seconds atts comment end end end end call close('tempfile') if ~show then do i=1 to ndirs lister add handle '"'dirname.i'"' dirsize.i '1' dirsecs.i '----rwed' lister select handle '"'dirname.i'"' on end lister refresh handle full return checkLZXdir: arg checkhandle lister query checkhandle path winpath=result test=upper(winpath) cuthere=pos('.LZX/',test) LZXdir=cuthere>0 if LZXdir then do LZXfile=left(winpath,cuthere+3) LZXsubdir=substr(winpath,cuthere+5) end return LZXextract: lister query handle numdirs anydirs=result>0 mustmove=anydirs&s_LZXsubdir~=='' if mustmove then destpath=winpath'LZXDir'handle'/' else destpath=winpath actionfile_1="" call open('actionfile','T:actionfile'handle,'w') do i=1 to entries if type.i>0 then wild='/#?' else wild='' call writeln('actionfile','"'patch(s_LZXsubdir||name.i,1)||wild'"') actionfile_1=actionfile_1||'"'patch(s_LZXsubdir||name.i,1)||wild'" ' end call close('actionfile') if anydirs then LZXcmd='x' else LZXcmd='e' lister set handle progress '-1' getcatstr(10,'Extracting from archive...') address command 'LZX ' LZXcmd ' -m -a "'patch(s_LZXfile,0)'" "'destpath'" 'actionfile_1 problem=rc>0 if problem then topline=getcatstr(11,'Error while extracting from archive.') else if notmove then do do i=1 to entries lister select handle '"'name.i'"' off end lister refresh handle end if mustmove then do address command 'Rename >NIL: "'winpath'LZXDir'handle'/'s_LZXsubdir'#?" "'winpath'" QUIET' address command 'Delete >NIL: "'winpath'LZXDir'handle'" ALL QUIET' end address command 'Delete >NIL: T:actionfile'handle 'QUIET' return LZXadd: mustcopy=upper(right(src,length(LZXsubdir)))~==upper(LZXsubdir) if mustcopy then do /* all files must be copied to T: before they can be added */ homedir='T:LZXDir'handle'/' call createdirs end else homedir=left(src,length(src)-length(LZXsubdir)) actionfile_1="" call open('actionfile','T:actionfile'handle,'w') call writeln('actionfile','"'patch(homedir,0)'"') actionfile_1=actionfile_1||'"'patch(homedir,0)'" ' if s_LZXdir then call writeln('actionfile','#?') actionfile_1=actionfile_1||'#? ' else do do i=1 to entries call writeln('actionfile','"'patch(LZXsubdir||name.i,0)'"') actionfile_1=actionfile_1||'"'patch(LZXsubdir||name.i,0)'" ' if mustcopy then address command 'Copy "'src||name.i'" "T:LZXDir'handle'/'LZXsubdir'"' end end call close('actionfile') lister set desthandle progress '-1' getcatstr(12,'Adding to archive...') address command 'LZX r -m -e -r "'patch(LZXfile,0)'" 'actionfile_1 problem=rc>0 if problem then topline=getcatstr(13,'Error while adding to archive.') else if notmove then do do i=1 to entries lister select handle '"'name.i'"' off end lister refresh handle end address command 'Delete >NIL: T:actionfile'handle 'QUIET' if mustcopy|s_LZXdir then address command 'Delete >NIL: T:LZXDir'handle 'ALL QUIET' call swapactive listLZX=1 call showLZXdir call swapactive return LZXlist: address command 'LZX >T:LZXDir.list'handle 'v "'LZXfile'"' if rc>0 then call quitit(getcatstr(2,'Error while listing archive.')) return swapactive: swaphandle=handle handle=desthandle desthandle=swaphandle return createdirs: parse arg subdir dirstocreate='T:LZXDir'handle'/'LZXsubdir||subdir here=0 mdstring='' do until here=0 here=pos('/',dirstocreate,here+1) if here>0 then mdstring=mdstring '"'left(dirstocreate,here-1)'"' end address command 'MakeDir >NIL:' mdstring return getall: lister query handle numseldirs ndirs=result lister query handle seldirs do n=1 to ndirs parse var result '"' name.n '"' result type.n=1 end lister query handle numselfiles nfiles=result lister query handle selfiles do n=ndirs+1 to ndirs+nfiles parse var result '"' name.n '"' result type.n=-1 end entries=ndirs+nfiles return convertdate: /* convert a file's datestamp to seconds past 01-Jan-78 */ parse var infoline size . infoline=substr(infoline,25,length(infoline)) parse var infoline day '-' month '-' year ' ' hours ':' minutes ':' seconds atts . minus=day='00' if minus then day='01' century=19+(year<78) month=pos(month,' JanFebMarAprMayJunJulAugSepOctNovDec')/3 month=right(month,2,'0') if month='00' then month='01' seconds=seconds+minutes*60+hours*3600+(date('i',century||year||month||day,'s')-minus)*86400 return getfirstone: lister query handle firstsel selentry=result lister query handle entry selentry stem fileinfo. selentry=fileinfo.name filetype=fileinfo.type return patch: /* patch filenames containing strange characters */ parse arg patched,apostrophe verstr='*#?|%()[]~' if apostrophe then verstr=verstr"'" pos=1 do until here=0 here=verify(substr(patched,pos),verstr,'m') if here>0 then do pos=pos+here+1 patched=insert("'",patched,pos-3) end end if left(patched,1)='@' then patched='*'patched return patched getcatstr: parse arg msgno,msgstring,insert.1,insert.2 if catalog~=0 then msgstring=getcatalogstr(catalog,msgno,msgstring) i=0 do while pos('%s',msgstring)>0 parse var msgstring fore '%s' aft i=i+1 msgstring=fore||insert.i||aft end return msgstring syntax: call quitit('Syntax Error' rc',' errortext(rc) 'in line' sigl'.') quitit: parse arg topline lister clear handle progress lister set handle busy off if catalog~=0 then call closecatalog(catalog) if topline~=='' then dopus request '"'topline'"' getcatstr(4,'OK') exit