home *** CD-ROM | disk | FTP | other *** search
- /**
- * $Id$
- *
- * Extract Aminet archives
- *
- * Copyright © 1995 HiSoft. All Rights Reserved.
- **/
- ADDLIB('rexxsupport.library',0,-30,0)
-
- OPTIONS RESULTS
-
- ADDRESS Twist
- PARSE ARG dbfilename,rela_x,rela_y,shiftkeys
- OPEN dbfilename
-
- DBLENGTH = LENGTH(dbfilename)
-
- do n = 1 to DBLENGTH by 1
- X = right(dbfilename,n)
- Y = Substr(X,1,1)
- IF Y = "/" then do
- VIEWERLOCATION = left(dbfilename,DBLENGTH-n) || '/Viewer.DB'
- n = DBLENGTH
- END
- end
-
- GETDBFORMMODE
-
- GETDBFORMFIELD "Archivefield"
- ARCHIVE = result
-
- GETDBFORMFIELD "FileName"
- ARCHIVENAME = result
-
- ARCLENGTH = LENGTH(ARCHIVE)
-
- FILETYPE = SUBSTR(ARCHIVE, (ARCLENGTH-2), 3)
- FILETYPE = UPPER(FILETYPE)
-
- IF exists('ENV:all') = 1 then do
-
- DELETE('ENV:all')
-
- END
-
-
- CALL CLEANENV
-
- IF FILETYPE = "ARC" | FILETYPE = "LZH" | FILETYPE = "LHA" then do
-
- ADDRESS COMMAND 'setenv all `echo a`'
- ADDRESS COMMAND 'setenv drawer `RequestFile RAM: TITLE="Select a drawer to extract the ' || ARCHIVENAME || ' to." DRAWERSONLY`'
-
- CALL TESTFORFILES
-
- ADDRESS COMMAND 'lha x "' || ARCHIVE || '" `type ENV:drawer` >CON: <env:all'
- DELETE('ENV:drawer')
- DELETE('ENV:all')
- EXIT
- End
-
- IF FILETYPE = "LZX" then do
-
- ADDRESS COMMAND 'setenv all `echo a`'
- ADDRESS COMMAND 'setenv drawer `RequestFile RAM: TITLE="Select a drawer to extract the ' || ARCHIVENAME || ' to." DRAWERSONLY`'
-
-
-
- ADDRESS COMMAND 'LZX x "' || ARCHIVE || '" `type ENV:drawer` >CON: <env:all'
- DELETE('ENV:drawer')
- DELETE('ENV:all')
- EXIT
- End
-
-
- IF FILETYPE = "DMS" then do
-
- GETDBFORMFIELD "DMS_WriteTo"
- DMS_WRITETO = result
-
- GETDBFORMFIELD "DMS_STARTSTOP"
- DMS_STARTSTOP = result
-
- IF DMS_STARTSTOP = "0-79" | DMS_STARTSTOP = "" then do
- DMS_START = "0"
- DMS_END = "79"
- END
-
- IF DMS_STARTSTOP = "0-40" then do
- DMS_START = "0"
- DMS_END = "40"
- END
-
- IF DMS_STARTSTOP = "40-79" then do
- DMS_START = "40"
- DMS_END = "79"
- END
-
- IF exists(ARCHIVE) = 0 then do
- SAY "File is not on this CD"
- EXIT
- END
-
- ADDRESS COMMAND 'DMS write "' || ARCHIVE || '" TO "' || DMS_WRITETO || '" LOW "' || DMS_START || '" HIGH "' || DMS_END || '" >CON:'
- EXIT
- END
-
- IF FILETYPE = "RUN" then do
- ADDRESS COMMAND 'setenv drawer `RequestFile RAM: TITLE="Select a drawer to extract the ' || ARCHIVENAME || ' to." DRAWERSONLY`'
- IF exists('ENV:drawer') = 0 then do
- EXIT
- END
-
- IF exists(ARCHIVE) = 0 then do
- SAY "File is not on this CD"
- EXIT
- END
-
- ADDRESS COMMAND '"' || ARCHIVE || '" `type ENV:drawer` >CON:'
- DELETE('ENV:drawer')
- EXIT
- END
-
- IF FILETYPE ~= "ARC" | FILETYPE ~= "LZH" | FILETYPE ~= "LHA" ~= "RUN" | FILETYPE ~= "DMS" then do
- GETDBFORMFIELD "Viewer.Viewer"
- FILE_VIEWER = result
-
- IF FILE_VIEWER = "" then do
-
- FILE_VIEWER = "MultiView"
-
- IF exists('ENV:AminetViewer') = 1 then do
- Open(input, 'ENV:AminetViewer', R)
- FILE_VIEWER = Readln(input)
- END
-
- SETDBFORMFIELD Viewer.Viewer FILE_VIEWER
-
- END
-
- IF exists(VIEWERLOCATION) = 0 then do
- SAY "Viewer database cannot be found"
- EXIT
- END
-
- OPEN VIEWERLOCATION
- 'SELECTALL WHERE "Viewer == \"' || FILE_VIEWER ||'\""',
- 'STEM VIEWER'
-
- FILEVIEWER = VIEWER.ViewerPath
-
- ADDRESS COMMAND 'setenv AminetViewer "'|| FILE_VIEWER ||'"'
- ADDRESS COMMAND 'COPY ENV:AminetViewer ENVARC:'
- ADDRESS COMMAND ' "' || FILEVIEWER || '" <NIL: >NIL: "' || ARCHIVE || '" '
- EXIT
- END
-
- TESTFORFILES:
- IF exists('ENV:drawer') = 0 then do
- EXIT
- END
- IF exists(ARCHIVE) = 0 then do
- SAY "File is not on this CD"
- CALL EXITSCRIPT
- END
- RETURN
-
- CLEANENV:
- IF exists('ENV:drawer') = 1 then do
- DELETE('ENV:drawer')
- END
- IF exists('ENV:all') = 1 then do
- DELETE('ENV:all')
- END
- RETURN
-
- EXITSCRIPT:
- EXIT
- RETURN
-