AmigActive 13/AACD13.ISO/AACD/System/EASys/EASys!_update_481_to_482/EASys!/Programs/ArchiveManager.rexx

OS/2 REXX Batch file | 2000-08-01 | 37KB | 1,767 lines

/*
  EASys! System © TNE) 1998

  ArchiveManager.rexx
  Pack/unpack common archiving formats comfortably and intuitive.

  Date:        07/2000
  Author:      Thomas Neidhardt (TNE), Deutschland, Erlangen

  InterNet:    [e-mail]

  Needs:       RexxReqTools Package by Rafael D'Halleweyn ( [e-mail] )
               and the EASys! Configuration Environment.

  Referenced by:  ${RefTable/ArchiveManager}
*/

PARSE ARG UserArgs
OPTIONS RESULTS
OPTIONS FAILAT 30

CALL Init

QuitEasy=0
wbargs=0
cliargs=0
flist=0
fliste=0
startargs=0

UserArgs=STRIP(UserArgs,'B',' ')

SELECT
WHEN POS('AS_EasyMail:',UserArgs)>0 THEN
DO
 IF GetClip('EasyMail')=1 THEN EXIT 0 /* prevent second startup at EasySave */

 EasyMail=1
 CALL SetClip('EasyMail',1)
END

WHEN POS('AS_EasyArc:',UserArgs)>0 THEN
DO
 IF GetClip('EasyArc')=1 THEN EXIT 0

 EasyArc=1
 CALL SetClip('EasyArc',1)
END

WHEN POS('-FList',UserArgs)>0 THEN
DO
 flist=1
 fliste=1
 lefts=''
 rights=''
 PARSE VAR UserArgs lefts'-FList 'rights
 filelist_tmp=STRIP(WORD(rights,1),'B','"')
 rights=RIGHT(rights,LENGTH(rights)-LENGTH(WORD(rights,1)))
 UserArgs=lefts''rights
 IF ReadFileList(filelist_tmp)=0 THEN EXIT 0
END

OTHERWISE NOP
END /* SELECT */

l=LENGTH(UserArgs)
SELECT
 WHEN EasyMail=1 THEN NOP
 WHEN EasyArc=1 THEN
 DO
  IF ShowMessage('ArchiveManager.15',,,,AppName)=0 THEN
  DO
   QuitEasy=1
   CALL ExitMe
  END

  CALL ReadDir('AS_EasyArc:')
  CALL ActionRequest
  CALL ExitMe
 END

 WHEN LEFT(UserArgs,5)='-list' THEN
 DO
  PARSE VAR UserArgs '-list 'UserArgs

  IF l>6 THEN CLIargs=1
  ELSE WBargs=1
  CALL GetFileSelection()

  DO k=1 to Files.count
   CALL ListArc(ftype.k,Files.k)
  END
  CALL ExitMe
 END

 WHEN LEFT(UserArgs,5)='-pack' THEN
 DO
  p=POS('-files',UserArgs)
  IF p=0 THEN
   CALL GetSelectedIcons()
  ELSE
  DO
   PARSE VAR UserArgs left'-files 'UserArgs
   CLIargs=1
   CALL GetFileSelection()
   UserArgs=left
  END

  autoPack=1
  type=LEFT(UserArgs,8)

  IF type='-packLha' THEN
  DO
   methode=lha
   PARSE VAR UserArgs '-packLha 'DestPath
  END

  IF type='-packZip' THEN
  DO
   methode=zip
   PARSE VAR UserArgs '-packZip 'DestPath
  END

  DestPath=STRIP(DestPath,'B',' ')
  DestPath=STRIP(DestPath,'B','"')
  IF DestPath='' THEN DestPath=Path.1
  IF ~(RIGHT(DestPath,1)='/' | RIGHT(DestPath,1)=':') THEN DestPath=DestPath'/'
  ActualPathArc=DestPath
  DestPath=DestPath''FileName.1

  CALL PackBundle
  CALL ExitMe
 END

 WHEN LEFT(UserArgs,9)='-unpackTo' THEN
 DO
  p=POS('-files',UserArgs)
  IF p=0 THEN
   CALL GetSelectedIcons()
  ELSE
  DO
   PARSE VAR UserArgs left'-files 'UserArgs
   CLIargs=1
   CALL GetFileSelection()
   UserArgs=left
  END

  autoUnpack=1
  PARSE VAR UserArgs '-unpackTo 'DestPath
  DestPath=STRIP(DestPath,'B','"')

  IF DestPath='' THEN DestPath=Path.1
  IF ~(RIGHT(DestPath,1)='/' | RIGHT(DestPath,1)=':') THEN DestPath=DestPath'/'

  DO k=1 to Files.count
    CALL Unpack
  END
  CALL ExitMe
 END

 WHEN WB_port=1 & ~fliste=1 & (POS('-pack',UserArgs)>0 | POS('-unpack',UserArgs)>0 | POS('-sendMail',UserArgs)>0 | UserArgs='' | UserArgs='USERARGS') THEN
 DO
  wbargs=1
  IF GetSelectedIcons()=0 THEN
  DO
   CALL Startup
   CALL ExitMe
  END
  ELSE CALL SetActualPath
 END

 WHEN WB_port=0 & ~fliste=1 & (POS('-pack',UserArgs)>0 | POS('-unpack',UserArgs)>0 | POS('-sendMail',UserArgs)>0 | UserArgs='' | UserArgs='USERARGS') THEN
 DO
  CALL StartUp
  CALL ExitMe
 END

 WHEN POS(':',UserArgs)>0 | POS('/',UserArgs)>0 THEN cliargs=1

 WHEN UserArgs="??" THEN
 DO
  IF EXISTS('EASys!_bin:'Language'/cm.help') THEN ADDRESS COMMAND 'type EASys!_bin:'Language'/cm.help'
  ELSE ADDRESS COMMAND 'type EASys!_bin:english/cm.help'
  EXIT 0
 END
 OTHERWISE NOP
END /* SELECT */


l=LENGTH(UserArgs)
SELECT
 WHEN UserArgs='' & (FILES.1='' | FILES.1='FILES.1') THEN
 DO
  IF WB_port=1 THEN wbargs=1
  CALL Startup
 END
 OTHERWISE NOP
END /* SELECT */

sendmail=0

l=LENGTH(UserArgs)
SELECT
 WHEN (LEFT(UserArgs,9)='-sendMail') THEN
 DO
   sendmail=1
   IF l>10 THEN UserArgs=RIGHT(UserArgs,l-10)

   /* EasySave directory notification operation by MultiNotify */

   IF EasyMail=1 THEN
   DO
    IF ShowMessage('ArchiveManager.16',,,,AppName)=0 THEN
    DO
     QuitEasy=1
     CALL ExitMe
    END

    CALL ReadDir('AS_EasyMail:')
   END

   destaddr=''
   IF POS('@',WORD(UserArgs,1))>0 THEN
   DO
     destaddr=WORD(UserArgs,1)
   END

   SELECT
    WHEN fliste=1 THEN ADDRESS COMMAND 'copy 'filelist_tmp' 'FileList' CLONE QUIET'
    OTHERWISE
    DO
      IF (open(fTMP,FileList,'write')) THEN
      DO
        DO k=1 to Files.count
          r=writeln(fTMP,Files.k)
          r=writeln(fTMP,Path.k)
          r=writeln(fTMP,FileName.k)
          r=writeln(fTMP,Prefix.k)
          r=writeln(fTMP,Suffix.k)
        END
        r=close(fTMP)
      END
    END
   END

   IF Files.count>10 | onedir=1 THEN
    CALL QueryPackActions
   ELSE
   DO
    sendarc=1
    sendfiles=2
    CALL mkReqFList(1)
    Action=ShowMessage('ArchiveManager.20',,,,AppName,reqFList)
    SELECT
      WHEN Action=sendarc THEN CALL QueryPackActions
      WHEN Action=sendfiles THEN
      DO
        ADDRESS COMMAND '${RefTable/Net-Start-MailOffl} 'destaddr' -FList 'FileList
        CALL DELAY(400)
      END
      OTHERWISE CALL ExitMe
    END /* SELECT */
   END
 END

 WHEN fliste=1 THEN
 DO
   CALL ActionRequest
   CALL ExitMe
 END

 WHEN ~(UserArgs='') & (FILES.1='' | FILES.1='FILES.1') THEN
 DO
  CALL FileParser
  DO k=1 to Files.count
      CALL ActionRequest
  END
  CALL ExitMe
 END

 OTHERWISE
 DO
    CALL ActionRequest
    CALL ExitMe
 END
END /* SELECT UserArgs */

CALL ExitMe

/* ---------------------- */
ReadDir:
PARSE ARG Dir

/* Dir must end up with '/' or ':' */

r=PRAGMA('DIRECTORY',Dir)
ADDRESS COMMAND 'list >T:'TempPath' ALL FILES LFORMAT "%p*n%n"'
IF ~Open(fTMP,'T:'TempPath,'READ') THEN CALL Err_ShowMessage('T:'TempPath)
i=0
l=LENGTH(Dir)
DO FOREVER
 i=i+1

 origPath=READLN(fTMP)
 IF EOF(fTMP) THEN LEAVE

 fnam=READLN(fTMP)
 IF EOF(fTMP) THEN LEAVE

 Files.i=Dir''origPath''fnam
 FileName.i=origPath''fnam

 pos=LASTPOS('.',fnam)
 IF pos>1 THEN Prefix.i=LEFT(fnam,pos-1)
 ELSE Prefix.i=fnam

 Path.i=Dir
 fType.i=GetType(Files.i)
END
r=Close(fTMP)
Files.count=i-1

RETURN
/* ---------------------- */
GetType:
PARSE ARG sz_file

IF ~EXISTS(sz_file) | sz_file='' THEN RETURN '???'
IF IsDir(sz_file)=1 THEN RETURN 'DIRECTORY'

l=''
r=Open(fFILE,sz_file,'READ')
l=ReadLn(fFILE)'___________'
r=Close(fFile)

sfx=UPPER(RIGHT(sz_file,4))
usz_file=UPPER(sz_file)

SELECT
 /* archive */
 WHEN LEFT(l,3)='444d53'x THEN type='DMS'
 WHEN UPPER(SUBSTR(l,3,3))='-LH' THEN type='LHA'
 WHEN LEFT(l,3)='4c5a58'x THEN type='LZX'
 WHEN LEFT(l,3)='58504b'x THEN type='XPK'
 WHEN sfx='.TAR' THEN type='TAR'
 WHEN LEFT(l,4)='504b0304'x THEN type='ZIP'
 WHEN sfx='.RUN' THEN type='RUN'
 WHEN sfx='.TGZ' THEN type='TGZ'
 WHEN sfx='.ARJ' THEN type='ARJ'
 WHEN sfx='.ARC' THEN type='ARC'
 WHEN RIGHT(usz_file,7)='.TAR.GZ' THEN type='TGZ'

 OTHERWISE type='UNKNOWN'
END /* SELECT */

RETURN type
/* ------------------------- */
IsDir:     PROCEDURE
PARSE ARG name

IF name='' THEN RETURN -1

r=PRAGMA('DIRECTORY',name)
IF ~(r='') THEN
   DirFlag=1
ELSE
DO
 IF ~Exists(name) THEN
   DirFlag=-1
 ELSE
   DirFlag=0
END

r=PRAGMA('DIRECTORY','T:')
RETURN DirFlag
/* ---------------------- */
WriteFileList:

IF (open(fTMP, FileList, 'write')) THEN
DO
  DO k=1 to Files.count
    r=writeln(fTMP,Files.k)
    r=writeln(fTMP,Path.k)
    r=writeln(fTMP,FileName.k)
    r=writeln(fTMP,Prefix.k)
    r=writeln(fTMP,Suffix.k)
  END
  r=close(fTMP)
END
ELSE
  CALL ExitMe

RETURN
/* ---------------------- */
ReadFileList:
PARSE ARG list
i=0

IF ~Open(TMP,list,'read') THEN CALL ExitMe
DO UNTIL EOF(TMP)
 i=i+1
 Files.i=READLN(TMP)
 Path.i=READLN(TMP)
 FileName.i=READLN(TMP)
 Prefix.i=READLN(TMP)
 Suffix.i=READLN(TMP)

 IF getalltypes=1 THEN
 DO
  ftype.i=getType(Files.i)
  fclass.i=class
  feditor.i=editor
  fprinter.i=printer
  fviewer.i=viewer
 END
END

Result=Close(TMP)

n=i-1
Files.count=n
Path=Path.n

IF ~(Files.1='') THEN RETURN 1
ELSE RETURN 0
/* ---------------------- */
Startup:

CALL PlaySample(SampleStartup)

Arbeite_Datei=1
Arbeite_GUI_lha=2
Arbeite_GUI_Zip=3
Arbeite_GUI_UU=4
Arbeite_XPK=5
help=6
Cancel=0

DO FOREVER  /* for online-Help Support and retrace */

  /* Show Action Panel */
  Action=ShowMessage('ArchiveManager.1',,,,AppName)

  SELECT
   WHEN Action=Cancel THEN CALL ExitMe

   WHEN Action=Arbeite_Datei THEN
   DO
     IF GetFileSelection()=0 THEN EXIT 0

     DO k=1 to Files.count
         CALL ActionRequest
     END
     CALL ExitMe
   END

   WHEN Action=Arbeite_GUI_lha THEN
   DO
     CALL GUI_lha
     CALL ExitMe
   END

   WHEN Action=Arbeite_GUI_Zip THEN
   DO
     CALL GUI_Zip
     CALL ExitMe
   END

   WHEN Action=Arbeite_GUI_UU THEN
   DO
     ADDRESS COMMAND '${RefTable/Archive-guiUU}'
     CALL ExitMe
   END

   WHEN Action=Arbeite_XPK THEN
   DO
     ADDRESS COMMAND '${RefTable/Archive-xpkDropper}'
     CALL ExitMe
   END

   WHEN Action=help THEN ADDRESS COMMAND '${RefTable/Text-ViewGuide} EASys!:Help/'Language'/EASys!_CM.guide'

   OTHERWISE NOP
  END /* SELECT Action */

END /* FOREVER */
RETURN

/* ---------------------- */
GetFileSelection:

/*
 RETURN 2  signals that files have been handed over by arguments
 flist or from workbench by wbargs or from cli
*/

FileName.1=''
Files.1='FILES.1'
Files.count=0
Path.1=''
ContinuedMode=0

SELECT
 WHEN cliargs=1 THEN
 DO
  r=FileParser()
  cliargs=0
  IF r=0 THEN StartArgs=SelectFiles()
  ELSE StartArgs=2
 END

 WHEN flist=1 THEN
 DO
  r=ReadFileList(filelist_tmp)
  flist=0
  IF r=0 THEN StartArgs=SelectFiles()
  ELSE StartArgs=2
 END

 WHEN wbargs=1 THEN
 DO
  r=GetSelectedIcons()
  wbargs=0
  IF r=0 THEN StartArgs=SelectFiles()
  ELSE StartArgs=2
 END

 OTHERWISE StartArgs=SelectFiles()
END /* SELECT */

IF StartArgs=0 THEN
 RETURN 0
ELSE
DO
 CALL SetActualPath
 RETURN StartArgs
END
/* ---------------------- */
SetActualPath:
i=Files.count
ActualPath=Path.1
Path=Path.i
LastSelected=FileName.1 /* remember */

CALL WriteFileList(FileList)  /* Prepare a FileList for external Processes */
ADDRESS COMMAND 'SetEnv Flags/ActualPath "'ActualPath'"'

RETURN
/* ---------------------- */
SelectFiles:
wbargs=0
cliargs=0
flist=0

Drive=LEFT(ActualPath,POS(':',ActualPath))
ADDRESS COMMAND 'assign >NIL: "'ConvSpecial(Drive)'" EXISTS'

IF RC>0 | ActualPath='' THEN ActualPath="SYS:"
ELSE IF ~EXISTS(ActualPath) THEN ActualPath="SYS:"

IF ~(firstSelection=1) THEN CALL PlaySample(SampleChooseFiles)
IF LastSelected='LASTSELECTED' THEN LastSelected=''

UserArgs=ShowMessage(FileReq,ActualPath,LastSelected,,AppName)
IF UserArgs='' THEN RETURN 0
ELSE ContinuedMode=1

CALL FileParser

firstSelection=1
RETURN 1
/* ---------------------- */
GetSelectedIcons:
OPTIONS RESULTS

ADDRESS WORKBENCH
GETATTR WINDOWS NAME window_list STEM window_list

i=1
DO w=0 TO window_list.count-1
 activewin=window_list.w
 IF ~(RIGHT(activewin,1)=':') & w>0 THEN activewin=activewin'/'

 GETATTR OBJECT WINDOW.ICONS.SELECTED.COUNT NAME activewin
 numselected=RESULT
 IF numselected>0 & w>0 THEN
 DO
  DO j=0 TO numselected-1
   GETATTR OBJECT WINDOW.ICONS.SELECTED.j.NAME NAME activewin
   Files.i=activewin''RESULT
   CALL Analyze

   i=i+1
  END
 END
END
i=i-1
Files.count=i

IF ~(Files.1='' | Files.1='FILES.1') THEN RETURN 1
ELSE RETURN 0

/* ------------------------- */
FileParser:

IF Files.1='' | Files.1='FILES.1' | POS(':',UserArgs)=0 THEN
DO
 i=0

 DO forever
  i=i+1

  Files.i=''
  PrognameBegPos=0
  DevicePos=0
  DirPos=0
  SfxBegin=0

  IF ( POS('"', UserArgs)=0 ) THEN
   PARSE VAR UserArgs Files.i UserArgs
  ELSE
   PARSE VAR UserArgs Files.i '"' UserArgs       /* parse the line */

  IF ( Files.i=" ") THEN
  DO
   IF ( POS('"', UserArgs)=0 ) THEN
    PARSE VAR UserArgs Files.i UserArgs
   ELSE
    PARSE VAR UserArgs Files.i '"' UserArgs       /* parse the line */
  END

  Files.i=strip(Files.i,'T',' ')
  Files.i=strip(Files.i,'B','"')

  IF (Files.i='') THEN
  DO                    /* Break if end of Command-line */
   Files.count=i-1
   LEAVE
  END

  DevicePos=LASTPOS(':',Files.i)

  IF (DevicePos=0) THEN
  DO
   ADDRESS COMMAND 'cd >ENV:'TempPath
   Path.i=MyGetENV(TempPath)

   ADDRESS COMMAND 'delete >NIL: ENV:'TempPath' QUIET'

   IF (RIGHT(Path.i,1)=':') THEN
     Files.i=Path.i || Files.i
   ELSE
     Files.i=Path.i || '/' || Files.i
  END

  CALL Analyze
 END
END
ELSE
DO i=1 TO Files.count
 PrognameBegPos=0
 DevicePos=0
 DirPos=0
 SfxBegin=0

 CALL Analyze
END

IF ~(Files.1='' | Files.1='FILES.1') THEN RETURN 1
ELSE RETURN 0

/*----------------------------------*/
Analyze:

Files.i=STRIP(Files.i,'T','/')
LengF=LENGTH(Files.i)
DevicePos=LASTPOS(':',Files.i)
DirPos=LASTPOS('/',Files.i)

IF DirPos>1 THEN
DO
 PrognameBegPos=DirPos
 Path_Dir.i=LEFT(Files.i, DirPos)
 Path.i=strip(Path_Dir.i,'T','/')
END
ELSE
DO
 PrognameBegPos=DevicePos
 Path.i=LEFT(Files.i, DevicePos)
 Path_Dir.i=Path.i
END

Numchars=LengF - PrognameBegPos
Device.i=LEFT(Files.i, Devicepos)
FileName.i=RIGHT(Files.i, LengF-PrognameBegPos)

SfxBegin=LASTPOS('.',FileName.i)

IF SfxBegin=0 THEN
DO
 Prefix.i=FileName.i
 Suffix.i=''
END
ELSE
DO
 Prefix.i=LEFT(FileName.i,SfxBegin-1)
 Suffix.i=UPPER(RIGHT(Files.i, NumChars-SfxBegin))
END

ftype.i=getType(Files.i)
IF ftype.i='DIRECTORY' THEN onedir=1

Path=Path.i
RETURN 1
/* ---------------------- */
ActionRequest:

Aminet=0
IF (UPPER(Left(Path,6))="AMINET" | UPPER(Left(Path,3))="SET") THEN
DO
 CALL ActionsAminet
 RETURN
END

IF Files.count=1 & ~(ftype.1='UNKNOWN') & ~(onedir=1) THEN CALL QueryUnpackActions
ELSE CALL QueryPackActions
RETURN

/* ---------------------- */
QueryPackActions:

CALL PlaySample(SampleAction)

/* Create a limited length FileList Text for the Requester */

RtFileList='   'Files.1

IF Files.count>1 THEN
DO n=2 TO Files.count WHILE n<=8
 RtFileList=RtFileList''CR'   'Files.n
END

IF Files.count>8 THEN RtFileList=RtFileList''CR'   ...'

DO FOREVER
  Methode=ShowMessage('ArchiveManager.3',,,,AppName,RtFileList)
  If Methode=help THEN
    ADDRESS COMMAND '${RefTable/Text-ViewGuide} EASys!:Help/'Language'/EASys!_CM.guide'
  ELSE
    LEAVE
END

If Methode=end THEN CALL ExitMe

CALL PackBundle
CALL FurtherPackActions
RETURN

/* ------------ Bundle to an Archive */
PackBundle:

DO k=1 to Files.count
 CALL Pack

 IF(RC>9) THEN
    PackError=1
 ELSE
    CALL AddIcon
END

l=LENGTH(Archive)
p=LASTPOS('/',Archive)
q=LASTPOS(':',Archive)
IF p>0 THEN
 ArcName=RIGHT(Archive,l-p)
ELSE
 ArcName=RIGHT(Archive,l-q)

CALL UpdateWB(ActualPathArc,ArcName)
RETURN

/* ---------------------- */
Pack:

Console='>"'ConsoleType''ReqLE'/'ReqTE'/500/40/'AppName' pack: 'FileName.k' ../AUTO/NOCLOSE"'

Packer_dms='EASys!_bin:DMS.exe'
Packer_lha='EASys!_bin:lha' console '-aryeZh -H0 -0 -v1 a'
Packer_lzh='EASys!_bin:lha' console '-aryeZh -H0a0f -0 -v1 a'
Packer_tar='EASys!_bin:TAR' console '-rv'
Packer_zip='EASys!_bin:ZIP' console '-ruv -9'
Packer_xpack='EASys!_bin:xpack' console 'METHOD NUKE MINSIZE 640'

sfx1=''

IF Methode=xpk THEN
DO
   Archive=Files.k
   Packer=Packer_xpack

   /* tell, that xpk NUKE will be done in place */

   Action=ShowMessage('ArchiveManager.13',,,,AppName,Files.k)
   If Action=end THEN CALL ExitMe

   ADDRESS COMMAND Packer '"'Archive'"'
   RETURN 1
END

IF ~(autoPack=1) THEN CALL QueryPackToDir

r=PRAGMA('DIRECTORY',Path.k)  /* change to Dir */

SELECT
 WHEN Methode=zip THEN
 DO
    IF ~(UPPER(RIGHT(DestPath,4))='.ZIP') THEN sfx1='.zip'
    Archive=DestPath''sfx1
    Packer=Packer_zip

    ADDRESS COMMAND Packer '"'DestPath'" "'FileName.k'"'
    RETURN 1
 END

 WHEN Methode=lha THEN
 DO
    IF ~(UPPER(RIGHT(DestPath,4))='.LHA') THEN sfx1='.lha'
    Archive=DestPath''sfx1
    Packer=Packer_lha

    ADDRESS COMMAND Packer '"'Archive'" "'FileName.k'"'
    RETURN 1
 END

 WHEN Methode=lzh THEN
 DO
    IF ~(UPPER(RIGHT(DestPath,4))='.LZH') THEN sfx1='.lzh'
    Archive=DestPath''sfx1
    Packer=Packer_lzh

    ADDRESS COMMAND Packer '"'DestPath'" "'FileName.k'"'
    RETURN 1
 END

 WHEN Methode=tar THEN
 DO
    IF ~(UPPER(RIGHT(DestPath,4))='.TAR') THEN sfx1='.tar'
    Archive=DestPath''sfx1
    Packer=Packer_tar

    IF k=1 THEN    /* name only once */
    DO
       TarDir='T:tar_out'ProcessNumber
       TarOutFile=TarDir'/tar.out'
       ADDRESS COMMAND 'makedir >NIL: 'TarDir

       r=PRAGMA('DIRECTORY',TarDir)  /* change to TarDir for Taring */
    END

    ADDRESS COMMAND Packer '"'Files.k'"'

    IF k=Files.count THEN
    DO
       r=PRAGMA('DIRECTORY','T:')  /* leave the TarDir before removing */

       ADDRESS COMMAND
       'move 'TarOutFile' "'Archive'" QUIET'
       'delete >NIL: 'TarDir' ALL QUIET'
    END
 END

 OTHERWISE NOP
END /* SELECT */

r=PRAGMA('DIRECTORY','T:')
RETURN 1

/* ---------------------- */
FurtherPackActions:

IF sendmail=1 THEN
DO
  ADDRESS COMMAND '${RefTable/Net-Start-MailOffl} 'destaddr' -f "'Archive'"'
  CALL ExitMe
END

IF PackError=1 THEN
DO
  ADDRESS COMMAND 'delete >NIL: "'Archive'" QUIET'
  PackError=0
  RETURN
END

/* Signal Packing has been completed */

CALL PlaySample(SampleAction)

DO FOREVER
 IF ~EXISTS(Archive) THEN
 DO
  IF WB_port=1 THEN
  DO
   ADDRESS WORKBENCH
   WINDOW WINDOWS ActualPathArc CLOSE
  END

  LEAVE
 END

 str_AttrSource=GetFileAttributes(Archive)
 Action=ShowMessage('ArchiveManager.4',,,,AppName,str_AttrSource)

 SELECT
  WHEN Action=1 THEN CALL ExitMe
  WHEN Action=2 THEN CALL MoveArc(Archive,'copy')
  WHEN Action=3 THEN CALL MoveArc(Archive,'move')
  WHEN Action=4 THEN ADDRESS COMMAND '${RefTable/File-Trash} "'Archive'"'
  WHEN Action=5 THEN ADDRESS COMMAND '${RefTable/File-Comment} "'Archive'"'
  WHEN Action=0 THEN CALL ListArc(GetType(Archive),Archive)
  OTHERWISE NOP
 END
END

CALL ExitMe

/* ---------------------- */
QueryPackToDir:

IF(k=1) THEN
DO
 /* get, which name to give the archive */

 SelectedString=ShowMessage('ArchiveManager.8',,,Prefix.k,AppName)
 IF (Action=0 | SelectedString="") THEN CALL ExitMe

 IF sendMail=1 THEN
 DO
  DestPath='T:'SelectedString
  RETURN
 END

 /* get, where to pack the archive */

 DestPath=ShowMessage('ArchiveManager.7',ActualPathArc,,,AppName,FileName.k)
 IF DestPath='' THEN CALL ExitMe

 ActualPathArc=DestPath

 ADDRESS COMMAND
 'setenv Flags/ActualPathArc "'DestPath'"'
 'setenv Flags/ActualPath "'DestPath'"'

 DestPath=DestPath''SelectedString
END
RETURN

/* ---------------------- */
AddIcon:
IF EXISTS(Files.k'.info') & (Methode=lha | Methode=lzh | Methode=zip) THEN
DO
 r=PRAGMA('DIRECTORY',Path.k)  /* change to Dir */
 ADDRESS COMMAND Packer '"'Archive'" "'FileName.k'.info"'
END
RETURN

/* ---------------------- */
QueryUnpackActions:

k=1  /* Unpacking only with one File as Argument */

UnPack=1
ShowContents=2
copy=3
move=4
Delete=5
help=6
Cancel=0

CALL PlaySample(SampleAction)

/* query actions on selected archive */

str_AttrSource=GetFileAttributes(Files.k)

DO FOREVER

 IF ~EXISTS(Files.k) THEN CALL ExitMe

 DO FOREVER
   Action=ShowMessage('ArchiveManager.5',,,,AppName,str_AttrSource)
   If Action=help THEN
     ADDRESS COMMAND '${RefTable/Text-ViewGuide} EASys!:Help/'Language'/EASys!_CM.guide'
   ELSE
     LEAVE
 END

 SELECT
  WHEN Action=Copy THEN CALL MoveArc(Files.k,'copy')
  WHEN Action=Move THEN CALL MoveArc(Files.k,'move')
  WHEN Action=Delete THEN ADDRESS COMMAND '${RefTable/File-Trash} "'Files.k'"'
  WHEN Action=ShowContents THEN
  DO
    CALL ListArc(ftype.k,Files.k)
    CALL UnArcQuestion
    RETURN
  END

  WHEN Action=UnPack THEN
  DO
    CALL UnPack
    RETURN
  END

  WHEN Action=Cancel THEN CALL ExitMe
  OTHERWISE NOP
 END
END
RETURN

/* ---------------------- */
UnArcQuestion:

Cancel=0
entpacken=1
zeigen=2
copy=3
move=4
delete=5

/* unpack now ?  or what else? */

DO FOREVER

 IF ~EXISTS(Files.k) THEN CALL ExitMe

 Action=ShowMessage('ArchiveManager.6',,,,AppName,str_AttrSource)
 SELECT
  WHEN Action=entpacken THEN
  DO
     CALL UnPack
     LEAVE
  END

  WHEN Action=zeigen THEN CALL ListArc(ftype.k,Files.k)
  WHEN Action=Copy THEN CALL MoveArc(Files.k,'copy')
  WHEN Action=Move THEN CALL MoveArc(Files.k,'move')
  WHEN Action=delete THEN ADDRESS COMMAND '${RefTable/File-Trash} "'Files.k'"'
  WHEN Action=Cancel THEN CALL ExitMe
  OTHERWISE NOP
 END
END
RETURN

/* ---------------------- */
UnPack:

/* Preset Dest */
IF Aminet=0 THEN DestPath="T:"

/* Destination Request only, if...*/
IF (Aminet=0 & ~(ftype.k='UNKNOWN')) THEN
DO

 CALL PlaySample(SampleUnpackTo)

 ActualPath=TestPath(ActualPathUnArc)

 /* get, where to unpack the archive */

 DestPath=ShowMessage('ArchiveManager.10',ActualPath,,,AppName)
 IF DestPath='' THEN CALL ExitMe

 ActualPathUnArc=DestPath
 ADDRESS COMMAND
 'setenv Flags/ActualPathUnArc "'DestPath'"'
 'setenv Flags/ActualPath "'DestPath'"'

END

r=PRAGMA('DIRECTORY',DestPath)


/* ---- type detection ---- */

CALL PlaySample(SampleUnPack)

Console='>"'ConsoleType ReqLE'/'ReqTE'/500/40/'AppName' unpack: 'FileName.k' .../AUTO/NOCLOSE"'

UnPacker_arc='EASys!_bin:ARC 'console' x'
UnPacker_arj='EASys!_bin:unARJ 'console' x'
UnPacker_dms='EASys!_bin:DMS.exe <'console' write'
UnPacker_lha='EASys!_bin:LHA 'console' -am x'
UnPacker_lzh='EASys!_bin:LHA 'console' -am x'
UnPacker_lzx='EASys!_bin:LZX 'console' -e x'
UnPacker_TAR='EASys!_bin:TAR 'console' -xvf'
UnPacker_TGZ='EASys!_bin:unTGZ 'console' '
UnPacker_zip='EASys!_bin:unZIP 'console' -axoL'
UnPacker_zoo='EASys!_bin:ZOO 'console' x'

SELECT
 WHEN ftype.k="LHA" THEN ADDRESS COMMAND UnPacker_lha '"'Files.k'" "'DestPath'"'
 WHEN ftype.k="LZH" THEN ADDRESS COMMAND UnPacker_lha '"'Files.k'" "'DestPath'"'
 WHEN ftype.k="LZX" THEN ADDRESS COMMAND UnPacker_lzx '"'Files.k'" "'DestPath'"'
 WHEN ftype.k="ZIP" THEN ADDRESS COMMAND UnPacker_zip '"'Files.k'" -d' '"'DestPath'"'
 WHEN ftype.k="RUN" THEN ADDRESS COMMAND '"'Files.k'"' Console '-x "'DestPath'"'
 WHEN ftype.k="TGZ" THEN ADDRESS COMMAND UnPacker_tgz '"'Files.k'" "'DestPath'"'
 WHEN ftype.k="TAR" THEN
 DO
  /* tell, that TAR will restore Files to original Path */

  Action=ShowMessage('ArchiveManager.14',,,,AppName,Files.k)
  IF Action=0 THEN CALL ExitMe

  ADDRESS COMMAND UnPacker_TAR '"'Files.k'"'
 END

 WHEN ftype.k="ARJ" THEN
 DO
   /* tell, where the archive will be unpacked (T:) */
   Action=ShowMessage('ArchiveManager.11',,,,AppName)
   If Action=1 THEN ADDRESS COMMAND UnPacker_arj '"'Files.k'"'
 END

 WHEN ftype.k="DMS" THEN
 DO
   /* tell, that DMS will unpack to DF0: */
   Action=ShowMessage('ArchiveManager.12',,,,AppName)
   If Action=1 THEN ADDRESS COMMAND UnPacker_dms '"'Files.k'" DF0:'
 END

 WHEN ftype.k="ZOO" THEN ADDRESS COMMAND UnPacker_zoo '"'Files.k'" "'DestPath'"'
 WHEN ftype.k="ARC" THEN ADDRESS COMMAND UnPacker_arc '"'Files.k'"'
 OTHERWISE NOP
END

CALL UpdateWB(DestPath,'')

IF autoUnpack=1 | Aminet=1 THEN RETURN
ELSE CALL FurtherUnpackActions
RETURN

/* ---------------------- */
FurtherUnpackActions:

Cancel=0
Copy=1
Move=2
Delete=3
Presentate=4
FM=5

str_AttrSource=GetFileAttributes(Files.k)
CALL PlaySample(SampleAction)

DO FOREVER

 IF ~EXISTS(Files.k) THEN CALL ExitMe

 /* ask further actions for the unpacked archive */

 Action=ShowMessage('ArchiveManager.9',,,,AppName,str_AttrSource)
 SELECT
  WHEN Action=Cancel THEN CALL ExitMe
  WHEN Action=Copy THEN CALL MoveArc(Files.k,'copy')
  WHEN Action=Move THEN CALL MoveArc(Files.k,'move')
  WHEN Action=Delete THEN ADDRESS COMMAND '${RefTable/File-Trash} "'Files.k'"'
  WHEN Action=FM THEN ADDRESS COMMAND '${RefTable/File-Manager} -DIR "'DestPath'"'
  WHEN Action=Presentate THEN
  DO
    OriginalPath=MyGetENV('Flags/ActualPath')

    ADDRESS COMMAND
    'setenv Flags/ActualPath "'DestPath'"'
    '${RefTable/File-Presentate} -DIR "'DestPath'"'
    'setenv Flags/ActualPath "'OriginalPath'"'
  END

  OTHERWISE NOP
 END
END

RETURN

/* ---------------------- */
ActionsAminet:

Aminet=1

IF ~EXISTS("RAM:Test") THEN ADDRESS COMMAND 'makedir RAM:Test'

DestPath='RAM:Test/'

TalkBefore=TalkToUser
TalkToUser="0"

k=1
CALL UnPack

OriginalPath=MyGetENV('Flags/ActualPath')

r=PRAGMA('DIRECTORY','T:')

ADDRESS COMMAND
'EASys!_bin:CopyIcon >NIL: "ENV:sys/def_drawer" "RAM:Test"'
'setenv Flags/ActualPath "'DestPath'"'
'${RefTable/File-Presentate} -DIR "'DestPath'"'
'setenv Flags/ActualPath "'OriginalPath'"'
'list >'tmpfile' RAM:Test/~(#?.info) LFORMAT "EASys!_bin:IconKill *"%s%s*""'
'EASys!_bin:swipe >NIL: RAM:Test FORCE ALL QUIET'
'execute 'tmpfile
'delete >NIL: 'tmpfile
'EASys!_bin:IconKill RAM:Test'

TalkToUser=TalkBefore

RETURN 1

/* ---------------------- */
GUI_lha:

ADDRESS COMMAND '${RefTable/Archive-guiLHA}'
CALL ExitMe
RETURN 1

/* ---------------------- */
GUI_Zip:

ADDRESS COMMAND '${RefTable/Archive-guiPKAZIP}'
CALL ExitMe
RETURN 1

/* ---------------------- */
ListArc:
PARSE ARG type,file

IF EXISTS(MyGetENV('RefTable/Archive-unarcGUI')) THEN
DO
 ADDRESS COMMAND '${RefTable/Archive-unarcGUI} "'file'"'
 RETURN
END

IF EXISTS(ArcListFile) THEN
DO
 CALL ShowArcList
 RETURN
END

CALL PlaySample(SampleShowContents)

list_arc="EASys!_bin:Lister >"ArcListFile" v"
list_arj="EASys!_bin:unARJ >"ArcListFile" l"
list_dms="EASys!_bin:DMS.exe >"ArcListFile" view"
list_lha="EASys!_bin:LHA >"ArcListFile" v"
list_lzh="EASys!_bin:LHA >"ArcListFile" v"
list_lzx="EASys!_bin:lzx >"ArcListFile" l"
list_run="EASys!_bin:LHA >"ArcListFile" v"
list_tar="EASys!_bin:TAR >"ArcListFile" -tRvf"
list_tgz="EASys!_bin:untgz -v >"ArcListFile" "
list_zip="EASys!_bin:unZIP >"ArcListFile" -lv"
list_zoo="EASys!_bin:ZOO >"ArcListFile" v"

SELECT
 WHEN type="LHA" THEN ADDRESS COMMAND List_lha '"'file'"'
 WHEN type="LZX" THEN ADDRESS COMMAND List_LZX '"'file'"'
 WHEN type="LZH" THEN ADDRESS COMMAND List_lha '"'file'"'
 WHEN type="ZIP" THEN ADDRESS COMMAND List_zip '"'file'"'
 WHEN type="DMS" THEN ADDRESS COMMAND List_dms '"'file'"'
 WHEN type="ARJ" THEN ADDRESS COMMAND List_arj '"'file'"'
 WHEN type="ARC" THEN ADDRESS COMMAND List_arc '"'file'"'
 WHEN type="RUN" THEN ADDRESS COMMAND List_run '"'file'"'
 WHEN type="TAR" THEN ADDRESS COMMAND List_TAR '"'file'"'
 WHEN type="TGZ" THEN ADDRESS COMMAND List_TGZ '"'file'"'
 WHEN type="ZOO" THEN ADDRESS COMMAND List_zoo '"'file'"'
 OTHERWISE ADDRESS COMMAND List_arc '"'file'"'
END

CALL ShowArcList

RETURN

/* ---------------------- */
ShowArcList:

/* ADDRESS COMMAND '${RefTable/Text-ViewASCII}' ArcListFile */
ADDRESS COMMAND '${RefTable/Archive-unarcGUI}' ArcListFile

RETURN

/* ---------------------- */
GetFileAttributes:
PARSE ARG CheckedFile

BytesTemp='ENV:CM_Bytes'ProcessNumber
AttrFile='T:CM_Attr_'ProcessNumber

ADDRESS COMMAND 'list >'AttrFile' "'CheckedFile'" LFORMAT "    %n*n    %p*n    %l Bytes *n    %d   %t*n    %c"'

IF (open(fTMP, AttrFile, 'read')) THEN
DO
   str_Attr=READLN(fTMP)
   str_Attr=str_Attr CR READLN(fTMP)
   str_Attr=str_Attr CR LEFT(READLN(fTMP), 85)
   str_Attr=str_Attr CR READLN(fTMP)
   str_Attr=str_Attr CR LEFT(READLN(fTMP), 85)

   Result=Close(fTMP)

   ADDRESS COMMAND 'delete >NIL: 'AttrFile' QUIET'
END

RETURN str_Attr

/* ------------------------- */
GetBytes:
PARSE ARG checkedfile

BytesTemp='T:FM_Bytes'ProcessNumber
AttrFile='T:FM_Attr_'ProcessNumber
DirChecked=0

aFile=ConvSpecial(CheckedFile)

IF IsDir(CheckedFile)=1 THEN
  RETURN 'DIRECTORY'
ELSE
DO
  ADDRESS COMMAND 'list >'BytesTemp' "'aFile'" LFORMAT "%l"'

  IF RC>0 THEN RETURN "???"

  IF ~Open(fTMP,BytesTemp,'read') THEN CALL Err_ShowMessage(msg_no_r''BytesTemp)
  ELSE
  DO
    Bytes=VALUE(ReadLn(fTMP))
    StrBytes=Bytes' Bytes'
    r=Close(fTMP)
  END

  ADDRESS COMMAND 'delete >NIL: 'BytesTemp' QUIET'
  RETURN Bytes
END

/* ------------------------- */
ShowMessage:

PARSE ARG Mesg,ReqPath,ReqFile,PresetString,Parameter1,Parameter2,Parameter3,Parameter4,Parameter5,Parameter6

drop Action
ReqType=''

MsgFile='EASys!_rexx:'Language'/'Mesg
IF ~(Open(fTMP, MsgFile, 'read')) THEN CALL Err_ShowMessage
ELSE
DO
  ReqType=ReadLn(fTMP)  /* read Requester-Type */

  Line=ReadLn(fTMP)  /* read Title-Line */
  CALL Substitutions
  ReqTitle=Line

  Line=ReadLn(fTMP)  /* free line after Title */

  Message=''

  DO UNTIL EOF(fTMP)

    Line=ReadLn(fTMP)
    CALL Substitutions

    IF POS(">>>", Line) > 0 THEN
    DO
      rtBtns=STRIP(Line,'L','>')
      LEAVE
    END
    ELSE
        Message=Message''CR''Line
  END

  r=Close(fTMP)
END

uReqType=UPPER(ReqType)
pubname=getpubscreen()
IF ~(pubname='') THEN r=setpubscreen(pubname' Default')

SELECT
 WHEN (uReqType='MULTI REQUEST') THEN
 DO
  r=rtezrequest(Message,rtBtns,ReqTitle,PosTags)
  RETURN r
 END

 WHEN (uReqType='GET ONE FILE') THEN
 DO
  r=rtfilerequest(ReqPath,ReqFile,ReqTitle,rtBtns,ONEFILE_TAG, Files)
  RETURN r
 END

 WHEN (uReqType='GETFILES') THEN
 DO
  r=rtfilerequest(ReqPath,ReqFile,ReqTitle,rtBtns, FILE_TAGS, Files)
  RETURN r
 END

 WHEN (uReqType='GETPATH') THEN
 DO
  r=rtfilerequest(ReqPath,,ReqTitle,rtBtns, DIR_TAGS)
  RETURN r
 END

 WHEN (uReqType='GETSTRING') THEN
 DO
  r=rtgetstring(PresetString,Message,ReqTitle,rtBtns,GStags,Action)
  RETURN r
 END

 WHEN (uReqType='GETSTRING SIMPLE') THEN
 DO
  r=rtgetstring(PresetString,Message,ReqTitle,,GStags,Action)
  RETURN r
 END

 WHEN (uReqType='CONSOLE') THEN
 DO
  ShowConsole='CON:'ReqLE'/'ReqTE'/'ConW'/'ConH'/'ReqTitle'/NOCLOSE'
  IF ~(Open(Con,ShowConsole,'write')) THEN
  DO
      MsgFile=ThisConsole
      CALL Err_ShowMessage
      ConStat=0
  END

  ConStat=1
  r=WriteLn(Con,Message)

  RETURN 1
 END

 OTHERWISE CALL Err_ShowMessage  /* Error if arrived here */
END /* SELECT */

RETURN

/* ------------------------- */
Substitutions:

IF POS("%1", Line) > 0 THEN             /* substitution parameters for each message */
DO UNTIL POS("%1", Line)=0            /* and per line */
   parse var Line part1 '%1' part2
   Line=part1''parameter1''part2
END

IF POS("%2", Line) > 0 THEN
DO UNTIL POS("%2", Line)=0
   parse var Line part1 '%2' part2
   Line=part1''parameter2''part2
END

IF POS("%3", Line) > 0 THEN
DO UNTIL POS("%3", Line)=0
   parse var Line part1 '%3' part2
   Line=part1''parameter3''part2
END

IF POS("%4", Line) > 0 THEN
DO UNTIL POS("%4", Line)=0
   parse var Line part1 '%4' part2
   Line=part1''parameter4''part2
END

RETURN

/* ------------------------- */
mkReqFList:
PARSE ARG begincount
reqFList='   'Files.begincount'        'GetBytes(Files.begincount)' Bytes'

next=begincount+1
DO f=next to Files.count UNTIL f-begincount>7
   reqFList=reqFList CR'   'Files.f'        'GetBytes(Files.f)' Bytes'
END

IF Files.count>8 THEN reqFlist=reqFlist''CR'   'Path.1'...'
RETURN

/* ---------------------- */
MakeTab:
PARSE ARG pos,text,tabappend
numspace=pos-LENGTH(text)
DO space=1 TO numspace
 text=text' '
END
RETURN text''tabappend

/* ---------------------- */
MoveArc:
PARSE ARG TheFile,copyFlag

ADDRESS COMMAND 'setenv Flags/ActualPathDest "'TestPath(MyGetENV('Flags/ActualMoveArc'))'"'

IF (copyFlag='copy') THEN ADDRESS COMMAND '${RefTable/File-CopyServer} "'TheFile'"'
ELSE ADDRESS COMMAND '${RefTable/File-MoveServer} "'TheFile'"'

ADDRESS COMMAND 'setenv Flags/ActualMoveArc "${Flags/ActualPathDest}"'

RETURN
/* ---------------------- */
Err_ShowMessage:

 Message=AppName':' CR CR "Sorry, an error has occured:" CR CR "    "MsgFile CR CR "... exiting."
 rtBtns='Oh no!'
 Action=rtezrequest(Message,rtBtns,ReqTitle,PosTags)
 CALL ExitMe

RETURN
/* ---------------------- */
PlaySample:
PARSE ARG Sample

IF (TalkToUser="0") THEN RETURN

IF EXISTS('ENV:ProcessTalk') THEN
DO
  ProcessTalk=Strip(SubWord(MyGetENV("ProcessTalk"),2),'T',']')

  ADDRESS COMMAND 'status >ENV:VoiceSTATUS PROCESS 'ProcessTalk
  VStatus=MyGetENV('VoiceSTATUS')

  IF POS(Play_Voice_Cmd,VStatus)>0 THEN ADDRESS COMMAND 'break' ProcessTalk 'c'
END

ADDRESS COMMAND Play_Voice Sample

RETURN
/* ---------------------- */
MyGetENV:     PROCEDURE
PARSE ARG name

TheFile="ENV:"name
IF (Open(fTMP, TheFile, 'read')) THEN
DO
  ENVvalue=ReadLn(fTMP)
  r=Close(fTMP)
END
ELSE
  ENVvalue=''

RETURN ENVvalue
/* ---------------------- */
TestPath:
PARSE ARG tstpath

Drive=LEFT(tstpath,POS(':',tstpath))
ADDRESS COMMAND 'assign >NIL: "'ConvSpecial(Drive)'" EXISTS'

IF RC>0 | tstpath='' THEN tstpath="SYS:"
ELSE IF ~EXISTS(tstpath) THEN tstpath="SYS:"

RETURN tstpath

/* ------------------------- */
ConvSpecial:
PARSE ARG File

posi=POS('~',File)
IF posi>0 THEN File=INSERT("'",File,posi-1)

posi=POS('(',File)
IF posi>0 THEN File=INSERT("'",File,posi-1)

posi=POS(')',File)
IF posi>0 THEN File=INSERT("'",File,posi-1)

posi=POS('[',File)
IF posi>0 THEN File=INSERT("'",File,posi-1)

posi=POS(']',File)
IF posi>0 THEN File=INSERT("'",File,posi-1)

posi=POS('{',File)
IF posi>0 THEN File=INSERT("'",File,posi-1)

posi=POS('}',File)
IF posi>0 THEN File=INSERT("'",File,posi-1)

posi=POS('+',File)
IF posi>0 THEN File=INSERT("'",File,posi-1)

posi=POS('#',File)
IF posi>0 THEN File=INSERT("'",File,posi-1)

posi=POS('?',File)
IF posi>0 THEN File=INSERT("'",File,posi-1)

RETURN File

/* ---------------------- */
UpdateWB:
PARSE ARG wbpath,selicon

IF WB_port=1 THEN
DO
 /* >= OS3.5 */
 ADDRESS WORKBENCH
 WINDOWTOFRONT wbPath

 IF WORKBENCH.LASTERROR=205 THEN
 DO
  ADDRESS WORKBENCH
  WINDOW wbPath OPEN
 END
 ELSE
 DO
  ADDRESS WORKBENCH
  MENU WINDOW wbPath INVOKE WINDOW.UPDATE
 END

 ADDRESS WORKBENCH
 MENU WINDOW wbPath INVOKE WINDOW.SHOW.ALLFILES
/* MENU WINDOW wbPath INVOKE WINDOW.VIEWBY.NAME */

 IF ~(selicon='' | selicon='SELICON') THEN
 DO
  ADDRESS WORKBENCH
  ICON WINDOW wbPath NAMES selicon SELECT
 END
END
RETURN


/* ---------------------- */
Init:

AppName='© EASys!) CM'
FileReq='ArchiveManager.2'
CR='0a'x

Language=GetClip('Language')
IF ~EXISTS('EASys!_rexx:'Language'/ArchiveManager.1') THEN Language='english'

ProcessNumber=PRAGMA('ID')

IF SHOW('P','WORKBENCH') THEN WB_port=1

CALL FORBID

MaxTitleChars=MyGetENV("RefTable/GUI-ShellTitleChars")

ConsoleType=MyGetENV("RefTable/GUI-ConsoleType")
IF (ConsoleType="") THEN ConsoleType="CON:"

ConsoleSize=MyGetENV("SHELLsize")
IF (ConsoleSize="") THEN ConsoleSize="40/50/600/200"

ReqLE=MyGetENV("RefTable/GUI-ReqLE")  /* Main Window */
ReqTE=MyGetENV("RefTable/GUI-ReqTE")
ReqHeight=MyGetENV("RefTable/GUI-ReqHeight")

PosTags="rt_reqpos=reqpos_topleftscr rt_leftoffset=" ReqLE " rt_topoffset=" ReqTE
EZtags=PosTags
GLtags=PosTags"rtgl_min=0 rtgl_max=1500 rtgl_backfill=true "
GStags=PosTags" rtgs_backfill=false rtgs_width=300"

POINTER_TAGS="rt_reqpos=reqpos_pointer"
DIR_TAGS=PosTags" rtfi_flags=freqf_nofiles|freqf_save rtfi_height=" ReqHeight
FILE_TAGS=PosTags" rtfi_flags=freqf_multiselect|freqf_selectdirs rtfi_height=" ReqHeight

Console='>"'ConsoleType''ConsoleSize'/'AppName' Messages.../AUTO/NOCLOSE/ALT'ReqLE'/'ReqTE'/500/40"'

/* --------- pathes -------- */
r=PRAGMA('DIRECTORY', 'T:')
TempPath='CM-path_'ProcessNumber

ArcListFile='T:CM_List_'ProcessNumber
FileList='T:CM_FileList_'ProcessNumber
AttrSourceFile='T:CM_Attr'ProcessNumber
tmpFile='T:CM_TMP'ProcessNumber

ADDRESS COMMAND 'delete >NIL: 'ArcListFile' FORCE QUIET'

/* ----------- Voice -------- */
TalkToUser=MyGetENV("Flags/TalkToUser")
Play_Voice_Cmd=SubWord(MyGetENV('RefTable/Sound-voice'),1,1)
Play_Voice='run >ENV:ProcessTalk ${RefTable/Sound-voice}'
SampleDir='EASys!:Voice/'Language'/'

SampleAction=SampleDir'ArchiveManagerAction.8SVX'
SampleChooseFiles=SampleDir'ArchiveManagerFile.8SVX'
SampleShowContents=SampleDir'ArchiveManagerContents.8SVX'
SampleStartup=SampleDir'ArchiveManagerStartup.8SVX'
SampleUnpack=SampleDir'ArchiveManagerUnpack.8SVX'
SampleUnpackTo=SampleDir'ArchiveManagerUnpackTo.8SVX'

/*-----specials-----*/

Parameter1=AppName

ActualPath=MyGetENV("Flags/ActualPath")
ActualPathArc=MyGetENV("Flags/ActualPathArc")
ActualPathUnArc=MyGetENV("Flags/ActualPathUnArc")

ActualPathDest=MyGetENV("Flags/ActualPathDest")
ActualMoveArc=MyGetENV("Flags/ActualMoveArc")

/* Packing methods and Request Buttons */

lha=1
lzh=2
zip=3
xpk=4
tar=5
help=6
end=0

RETURN

/* ---------------------- */
ExitMe:

IF EXISTS('ENV:ProcessTalk') THEN ADDRESS COMMAND 'delete >NIL: ENV:ProcessTalk quiet'
IF EXISTS('ENV:VoiceSTATUS') THEN ADDRESS COMMAND 'delete >NIL: ENV:VoiceSTATUS quiet'
IF EXISTS(FileList) THEN ADDRESS COMMAND 'delete >NIL: 'FileList' QUIET'

IF EasyMail=1 THEN
DO
 IF QuitEasy=0 THEN CALL ShowMessage('EasySave.1',,,,AppName,'EasyMail')
 ADDRESS COMMAND 'delete >NIL: AS_EasyMail:#? FORCE ALL QUIET'

 CALL DELAY(300) /* needed so that notification is without effect */
 CALL SetClip('EasyMail',0)
 EXIT 0
END

IF EasyArc=1 THEN
DO
 ADDRESS COMMAND 'delete >NIL: AS_EasyArc:#? FORCE ALL QUIET'

 CALL DELAY(300)
 CALL SetClip('EasyArc',0)
 EXIT 0
END

IF ~(Files.1='' | "FILES.1"=Files.1) THEN
DO
 ADDRESS COMMAND 'assign >NIL: Profile: EXISTS'
 IF RC=0 THEN
 DO
  ADDRESS COMMAND
  'copy ENV:Flags/ActualPath Profile:ENV/Flags CLONE'
  'copy ENV:Flags/ActualPathArc Profile:ENV/Flags CLONE QUIET'
  'copy ENV:Flags/ActualPathUnArc Profile:ENV/Flags CLONE QUIET'
  'copy ENV:Flags/ActualMoveArc Profile:ENV/Flags CLONE QUIET'
 END
 ELSE
 DO
  ADDRESS COMMAND
  'copy ENV:Flags/ActualPath EASys!:Flags CLONE'
  'copy ENV:Flags/ActualPathArc EASys!:Flags CLONE QUIET'
  'copy ENV:Flags/ActualPathUnArc EASys!:Flags CLONE QUIET'
  'copy ENV:Flags/ActualMoveArc EASys!:Flags CLONE QUIET'
 END
END

r=setpubscreen('Workbench Default')
EXIT 0