home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magazyn Amiga Shareware Floppies
/
ma26.dms
/
ma26.adf
/
LhaDir
/
LhADir.dopus
< prev
next >
Wrap
Text File
|
2021-01-22
|
17KB
|
731 lines
/*
$VER: LhADir.dopus 1.7 (6.5.94)
Copyright © 1993-1994 by EAV Productions International
Placed in the public domain. No restrictions on distribution or usage.
This ARexx script for Directory Opus allows you to show the contents
(files and directories) of LhA archive files in a DOpus window and operate
on them as with a normal directory.
Possible arguments (not case sensitive) for LhADir.dopus:
GETDIR, BROWSE, PARENT, ROOT, DELETE, COPY, MOVE, MAKEDIR, GETSIZES,
READ, ANSIREAD, HEXREAD, SHOW, PLAY, LOOPPLAY, PRINT, ICONINFO, RUN,
VERSION, MULTIVIEW, AMIGAGUIDE, VIEWTEK, RETINADISPLAY.
*/
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='a'x /* ascii code for linefeed */
parse arg command portname . '"' selected '"'
upper command
if portname~=='' then
address(portname)
else
portname=address()
parse var portname '.' port /* port number */
busy on /* busy mouse pointer on */
status 3 /* get active window */
win=result
status 9 win /* get number of selected entries */
entries=result
checkabort /* reset abort flag */
call checkconfig
call checklhadir(win)
if selected~=='' then do
filetype=-1
entries=1
end
else
if entries>0 then
call getnextone
topline=""
listlha=0
notmove=command~='MOVE'
if pos('|'command'|','|GETDIR|BROWSE|PARENT|ROOT|DELETE|COPY|MOVE|MAKEDIR|GETSIZES|')>0 then
interpret 'call do'command
else do
n=entries
async=pos('|'command'|','|READ|ANSIREAD|HEXREAD|')>0
internal=async|pos('|'command'|','|SHOW|PLAY|LOOPPLAY|PRINT|ICONINFO|RUN|')>0
if entries=0|async|(internal&~(lhadir&entries>0))|command='VERSION' then
n=1
do n
checkabort /* did the user press both mouse buttons? */
if result then
call quitit "Aborted..."
if entries>0 then do
call getnextone
if lhadir then do
if filetype>0 then
call quitit "Error, cannot view directories."
address command 'LhA e -q -x2 -Qo "'patch(lhafile)'" T: "'patch(lhasubdir||selected)'"'
if rc>0 then
call quitit "Error while extracting file."
thisfile='"T:'selected'"'
end
else
if internal then
thisfile=''
else
thisfile='"'selected'"'
end
if internal then do
interpret "'"command thisfile"'"
abort=result~=0
end
else do
if ~lhadir&entries>0 then
thisfile='"'winpath||selected'"'
query screenname
if result=0 then
screenname=portname /* for compatibility */
else
screenname=result
select /* external commands */
when command='VERSION' then
call doversion
when command='MULTIVIEW' then
address command 'MultiView' thisfile 'PUBSCREEN' screenname
when command='AMIGAGUIDE' then
address command 'AmigaGuide' thisfile 'PUBSCREEN' screenname
when command='VIEWTEK' then
address command 'Work:OtherTools/VT >NIL:' thisfile
when command='RETINADISPLAY' then
address command 'Work:RetinaTools/RetinaDisplay' thisfile
otherwise
call quitit "Error, LhADir.dopus does not support the command '"command"'."
end
abort=0
end
busy on
if lhadir&entries>0 then do
if async then do
if ~show('l','rexxsupport.library') then
call addlib('rexxsupport.library',0,-30) /* needed for delay() */
call delay(75) /* wait a bit before deleting */
end
delete '"T:'selected'"'
busy on
end
if thisfile~=='' then do
selectfile '"'selected'" 0 1' /* deselect item */
if topline=="" then
topline="OK"
end
if abort then
call quitit
end
end
call quitit topline /* finished */
dobrowse:
dogetdir:
if entries>0 then
if filetype>0 then /* list a new dir */
if lhadir then
lhasubdir=lhasubdir||selected'/'
else
winpath=winpath||selected'/'
else do /* list an archive file */
if pos('|'upper(right(selected,4)'|'),'|.LHA|.LZH|.RUN|')=0 then
call quitit "Error, LhADir.dopus can only list LhA archives."
if lhadir then do
request "This is an archive in an archive."lf"Extract it to 'T:' and then list it?"
uset=result
if uset then
destpath='T:'
else do
busy on
status 13 1-win /* get window path */
destpath=result
if result=='' then
call quitit "Aborted..."
request "Use the current destination window"lf"'"destpath"' instead?"
if ~result then
call quitit "Aborted..."
end
busy on
toptext "Extracting from archive..."
address command 'LhA e -q -x2 -a -C0 -Qo "'patch(lhafile)'" "'destpath'" "'patch(lhasubdir||selected)'"'
if rc>0 then
call quitit "Error while extracting from archive."
if ~uset&command='GETDIR' then
rescan 1-win
lhafile=destpath||selected
end
else
lhafile=winpath||selected
lhadir=1
lhasubdir=''
listlha=1
end
else /* rescan current dir */
if lhadir then do
status 6 /* get number of entries */
listlha=result>0
end
if command='BROWSE' then do
selectfile '"'selected'" 0 1'
call swapactive
end
if lhadir then do
call showlhadir
topline="OK"
end
else
status 13 win set '"'winpath'"'
return
doparent:
if lhadir&lhasubdir~=='' then do
cuthere=lastpos('/',lhasubdir,length(lhasubdir)-1)
lhasubdir=left(lhasubdir,cuthere)
call showlhadir
topline="OK"
end
else
parent
return
doroot:
if lhadir&lhasubdir~=='' then do
lhasubdir=''
call showlhadir
topline="OK"
end
else
root
return
dodelete:
if lhadir then do
if entries=0 then
call quitit
if notmove then do
if askdelete then do
request "Do you really wish to delete selected entries"lf"from archive?"
if ~result then
call quitit "Aborted..."
busy on
end
call getall
end
call open('actionfile','T:actionfile'port,'w')
do i=1 to entries
if type.i>0 then
wild='/#?'
else
wild=''
call writeln('actionfile','"'patch(lhasubdir||name.i)||wild'"')
removefile '"'name.i'" 0'
end
call close('actionfile')
toptext "Deleting from archive..."
address command 'LhA d -q -Qp -Qo "'patch(lhafile)'" @T:actionfile'port
if rc>0 then do
topline="Error while deleting from archive."
listlha=1
call showlhadir
end
else do
topline="OK"
displaydir
end
delete 'T:actionfile'port
delete 'T:LhADir.list'port /* archive contents has changed */
busy on
end
else do
if notmove then
restore
delete
end
return
domove:
docopy:
if entries=0 then
call quitit
problem=0
source=winpath
s_lhadir=lhadir
s_lhafile=lhafile
s_lhasubdir=lhasubdir
call checklhadir(1-win)
if s_lhadir then do
if winpath=='' then do
errortext="No destination directory selected!"
toptext errortext
notify errortext
call quitit
end
if lhadir then
winpath='T:LhADir'port'/'lhasubdir
call getall
call lhaextract
if lhadir then do
source=winpath
call lhaadd
end
else
rescan 1-win
end
else
if lhadir then do
call getall
call lhaadd
end
else do /* normal copy/move */
restore
if notmove then
copy
else
move
end
if (s_lhadir|lhadir)&~notmove&~problem then do
lhadir=s_lhadir
lhafile=s_lhafile
lhasubdir=s_lhasubdir
call dodelete
end
return
domakedir:
result=''
getstring '"Enter directory name or archive name.lha"'
dirtomake=result
if dirtomake=='' then
call quitit
now=date('i')*86400+time('s')
if lhadir then do /* create empty dir in archive */
call createdirs dirtomake'/'
address command 'LhA a -q -e -r -Qo "'patch(lhafile)'" T:LhADir'port'/' '"'patch(lhasubdir||dirtomake)'"'
if rc>0 then
topline="Error while adding to archive."
else do
topline="Directory created."
addfile '"'dirtomake'" 0 1' now '"" ----RWED 0 1'
end
delete 'T:LhADir'port
delete 'T:LhADir.list'port
busy on
end
else do
if upper(right(dirtomake,4))=='.LHA' then /* create new archive */
if open('emptyarchive',winpath||dirtomake,'w') then do
call writech('emptyarchive','0'x)
call close('emptyarchive')
topline="Empty archive created."
addfile '"'dirtomake'" 1 -1' now '"" ----RWED 0 1'
end
else
topline="Error creating archive."
else do /* normal makedir */
restore
makedir '"'dirtomake'"'
end
end
return
dogetsizes:
if lhadir then do
status 6 win /* get total number of entries */
all=result
status 8 win /* get number of dirs selected */
seldirs=result
n=1
do i=1 to all
getentry i
dirname.n=result
fileinfo '"'result'" /'
parse var result '/' filesize '/' '/' type '/' select '/'
if type>0&select&filesize=0 then
n=n+1
end
dirsize.=0
dirsecs.=0
ndirs=n-1
call readlist(0)
end
getsizes
return
doversion:
if entries=0 then
thisfile='REXX:LhADir.dopus'
toptext "Searching for version string..."
address command 'Version >T:Version.temp' thisfile 'FILE FULL'
call open('tempfile','T:Version.temp','r')
topline=readln('tempfile')
call close ('tempfile')
delete 'T:Version.temp'
return
checklhadir:
arg checkwindow
status 13 checkwindow /* get window path */
winpath=result
test=upper(winpath)
cuthere=pos('.LHA/',test)
if cuthere=0 then
cuthere=pos('.LZH/',test)
if cuthere=0 then
cuthere=pos('.RUN/',test)
lhadir=cuthere>0
if lhadir then do
lhafile=left(winpath,cuthere+3)
lhasubdir=substr(winpath,cuthere+5)
end
return
lhaextract:
status 8 win /* get number of dirs selected */
anydirs=result>0
mustmove=anydirs&s_lhasubdir~==''
if mustmove then
destpath=winpath'LhADir'port'/'
else
destpath=winpath
call open('actionfile','T:actionfile'port,'w')
do i=1 to entries
if type.i>0 then
wild='/#?'
else
wild=''
call writeln('actionfile','"'patch(s_lhasubdir||name.i)||wild'"')
end
call close('actionfile')
if anydirs then
lhacmd='x'
else
lhacmd='e -x2'
toptext "Extracting from archive..."
address command 'LhA' lhacmd '-q -a -C0 -Qo "'patch(s_lhafile)'" "'destpath'" @T:actionfile'port
problem=rc>0
if problem then
topline="Error while extracting from archive."
else do
topline="OK"
if notmove then
none
end
if mustmove then do
do i=1 to entries
move '"'winpath'LhADir'port'/'s_lhasubdir||name.i'" "'winpath'"'
end
delete '"'winpath'LhADir'port'"'
end
delete 'T:actionfile'port
busy on
return
lhaadd:
mustcopy=upper(right(source,length(lhasubdir)))~==upper(lhasubdir)
if mustcopy then do /* all files must be copied to T: before they can be added */
homedir='T:LhADir'port'/'
call createdirs
end
else
homedir=left(source,length(source)-length(lhasubdir))
call open('actionfile','T:actionfile'port,'w')
call writeln('actionfile','"'patch(homedir)'"')
if s_lhadir then
call writeln('actionfile','#?')
else do
do i=1 to entries
call writeln('actionfile','"'patch(lhasubdir||name.i)'"')
if mustcopy then do
copy '"'source||name.i'" "T:LhADir'port'/'lhasubdir'"'
busy on
end
end
end
call close('actionfile')
toptext "Adding to archive..."
address command 'LhA r -q -e -r -Qo "'patch(lhafile)'" @T:actionfile'port
problem=rc>0
if problem then
topline="Error while adding to archive."
else do
topline="OK"
if notmove then
none
end
delete 'T:actionfile'port
if mustcopy|s_lhadir then
delete 'T:LhADir'port
busy on
call swapactive
listlha=1
call showlhadir
call swapactive
return
lhalist:
address command 'LhA >T:LhADir.list'port 'vv -N -Qw -Qo "'lhafile'"'
if rc>0 then do
setwintitle '"<Directory not available>"'
call quitit "Error while listing archive."
end
return
getnextone:
getnextselected
selected=result
if follow then
scrolltoshow '"'selected'"'
fileinfo '"'selected'" /'
parse var result '/' '/' '/' filetype '/'
return
getall:
status 6 win /* get total number of entries */
all=result
n=1
do i=1 to all
getentry i
name.n=result
fileinfo '"'result'" /'
parse var result '/' '/' '/' type.n '/' select '/'
if select then
n=n+1
if n>entries then
leave
end
return
createdirs:
parse arg subdir
dirstocreate='T:LhADir'port'/'lhasubdir||subdir
here=0
do forever
here=pos('/',dirstocreate,here+1)
if here=0 then
leave
makedir '"'left(dirstocreate,here-1)'"'
end
busy on
return
swapactive:
otherwindow
win=1-win
return
showlhadir:
status 13 win set '"'lhafile'/'lhasubdir'"'
toptext "Listing archive..." /* toptext obscures error message */
setwintitle '"LhADir listed archive"'
now=date('i')*86400+time('s')
ndirs=0
call readlist(1)
return
readlist:
arg show /* showdir or getsizes? */
if listlha|~exists('T:LhADir.list'port) then
call lhalist
call open('tempfile','T:LhADir.list'port,'r')
nextline=readln('tempfile')
parse var nextline 21 whicharc "':"
if upper(whicharc)~==upper(lhafile) then do /* it's another archive's list */
call close('tempfile')
call lhalist
call open('tempfile','T:LhADir.list'port,'r')
call readln('tempfile')
end
do 2
call readln('tempfile') /* waste these 2 lines */
end
compstr=upper(lhasubdir)
complen=length(compstr)
nextline=readln('tempfile')
do forever
name=nextline
infoline=readln('tempfile')
do while substr(infoline,22,1)~=='%'
name=infoline
infoline=readln('tempfile')
end
if name=='-------- ------- ----- --------- --------' then
leave
nextline=readln('tempfile')
if left(nextline,1)==':' then do
parse var nextline 3 comment
nextline=readln('tempfile')
end
else
comment=''
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
do i=ndirs to 1 by -1
if upper(dirname)==upper(dirname.i) then do
olddir=1
if ~show then do
toptext winpath||name
parse var infoline size . 24 datestamp 42
dirsize.i=dirsize.i+size
seconds=convertdate(datestamp)
if seconds>dirsecs.i then
dirsecs.i=seconds
end
leave
end
end
if show&~olddir then do /* a new dir */
ndirs=ndirs+1
dirname.ndirs=dirname
addfile '"'dirname'" 0 1' now '"" ----RWED 0 0'
end
end
else /* it's a file */
if show then do
parse var infoline size . 24 datestamp 42 43 atts .
seconds=convertdate(datestamp)
addfile '"'name'"' size '-1' seconds '"'comment'"' atts '0 0'
end
end
end
end
call close('tempfile')
if ~show then
do i=1 to ndirs
addfile '"'dirname.i'"' dirsize.i '1' dirsecs.i '"" ----RWED 0 0'
selectfile '"'dirname.i'"'
end
displaydir
return
convertdate: /* convert a file's date stamp to seconds past 01-Jan-78 */
parse arg day '-' month '-' year ' ' hours ':' minutes ':' seconds
century=19+(year<78)
month=pos(month,' JanFebMarAprMayJunJulAugSepOctNovDec')/3
month=right(month,2,'0')
return seconds+minutes*60+hours*3600+date('i',century||year||month||day,'s')*86400
patch: /* patch filenames containing pattern matching tokens */
parse arg patched
pos=1
do forever
here=verify(substr(patched,pos),'#?|%()[]~*','m')
if here=0 then
leave
pos=pos+here+1
patched=insert("'",patched,pos-3)
end
return patched
syntax:
call quitit "Syntax Error" rc"," errortext(rc) "in line" sigl"."
checkconfig:
query dirflags
olddirflags=result
if olddirflags<0 then /* bug in DOpus? */
olddirflags=256+olddirflags
if bittst(d2c(olddirflags),5) then do
request "The config setting 'Re-read changed buffers'"lf"must be switched off. Shall I do this for you?"
if ~result then do
remember /* something to restore */
call quitit "Error, config setting 'Re-read changed buffers' must be switched off."
end
modify dirflags olddirflags-32
end
remember /* remember user settings */
busy on
query updateflags
follow=bittst(d2c(result),1) /* scroll window to follow operations? */
modify updateflags 0 /* no progress indicator */
query deleteflags
askdelete=bittst(d2c(result),0) /* ask before deleting? */
modify deleteflags 8 /* don't ask when deleting internal */
modify iconflags 0 /* no icons please */
return
quitit:
parse arg topline
restore /* restore user settings */
if topline~=="" then
toptext topline /* display final message */
if pos("Error",topline)>0 then beep /* an error occurred */
busy off /* busy mouse pointer off */
exit /* stop script here */