Set Buffer 8
Global ER,PA1$,PA2$
Dim A$(5)
Dim PTYP$(8)
Dim PTP$(8)
LF$=Chr$(10)
For I=1 To 7 : Read PDATA$ : PTYP$(I)=PDATA$ : Next 
Data "LHA","LZX","UNZIP","DMS","UNARJ","PPACK","UNRAR"
CHESTA=1
'----------------------------------------------------
'Tooltypes auslesen
'
WBY=Ex Wb Height
WBX=Ex Wb Width
TTYPE1$=Ex Get Tooltype("DFACE","XPOS")
TTYPE2$=Ex Get Tooltype("DFACE","YPOS")
TTYPE3$=Ex Get Tooltype("DFACE","ICONIFY")
WINX=Val(TTYPE1$)
WINY=Val(TTYPE2$)
If WINX<0 Then WINX=0
If WINY<0 Then WINY=0
If(WINX+250)>WBX Then WINX=(WBX-250)
If(WINY+120)>WBY Then WINY=(WBY-120)
Ex Tooltype Done 
'----------------------------------------------------
'Prefs laden 
'
If Exist("config")
   Open In 1,"config"
   Line Input #1,PA1$
   Line Input #1,PA2$
   Input #1,PREFPACK
   Input #1,CHESTA
   For I=1 To 7 : Line Input #1,PTYP$(I) : Next I
   Close 1
End If 
'----------------------------------------------------
Ex Wind Open 1,WINX,WINY,250,120,$20+$40+$200,14,0
Ex Wind Title 1,"DeCruncherFace V1.05"
Ex Gadgets Init 0,1,6
For I=1 To 2
   Ex Labels Init I,"LHA,LZH,LZX,ZIP,DMS,ARJ,PP,RUN,RAR,AUTO"
Next 
Ex Def Cycle 1,30,30,80,15,Ex Labels(1),"Packer",4,1
Ex Def Button 2,30,60,80,15,"DePack",16,1
Ex Def Button 3,130,30,80,15,"Prefs",16,1
Ex Def Button 4,130,60,80,15,"About",16,1
Ex Def Button 5,130,90,80,15,"Quit",16,1
Ex Def Button 6,30,90,80,15,"Test",16,1
Ex Gadgets Open 1
Ex Set Cycle 1,PREFPACK,1
CP=PREFPACK
If TTYPE3$="YES"
   Ex Wind Zip 1
End If 
Ex Wind Active 1
SCHLEIFE:
For I=1 To 6
   Ex Gadget Unlock I,1
Next 
If CP=6 Then Ex Gadget Lock 6,1
TM=0
Do 
   Multi Wait 
   MSG=Ex Get Msg(1)
   If MSG
      Ex Reply Msg 
      If MSG=$200
         GG=Ex Get Key
         Ex Wind Zip 1
      End If 
      If MSG=$20
         GG=Ex Get Key
      End If 
      If MSG=$40
         GG=Ex Get Key
         If GG=1
            CP=Ex Get Part
            If CP=6
               Ex Gadget Lock 6,1
            End If 
            If CP<>6
               Ex Gadget Unlock 6,1
            End If 
         End If 
      End If 
      If GG=5
         FERTIG
      End If 
      If GG=2
         Exit 
      End If 
      If GG=4
         Goto ABOUT
      End If 
      If GG=3
         Goto PREFS
      End If 
      If GG=6
         TM=1 : Exit 
      End If 
   End If 
Loop 
ZEIGER:
P=CP+1
For I=1 To 6
   Ex Gadget Lock I,1
Next 
On P Goto LHA,LHA,LHA,ZIP,DMS,ARJ,PP,APLUS,ARJ,AUTO
'----------------------------------------------- 
LHA:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO1:
If P=2 or P=1
   HOLD$=PTYP$(1)
End If 
If P=3
   HOLD$=PTYP$(2)
End If 
If TM=0
   If CHESTA=1
      PATH[PA2$]
      F2$=Param$
   Else 
      F2$=PA2$
   End If 
   
   If F2$=""
      Goto SCHLEIFE
   End If 
   G$=Chr$(34)+HOLD$+Chr$(34)+" x "+Chr$(34)+F1$+Chr$(34)+" "+Chr$(34)+F2$+Chr$(34)+Chr$(0)
End If 
If TM=1
   G$=Chr$(34)+HOLD$+Chr$(34)+" t "+Chr$(34)+F1$+Chr$(34)+Chr$(0)
End If 
DEPACK
Goto SCHLEIFE
'--------------------------------------------------- 
ZIP:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO3:
If TM=0
   If CHESTA=1
      PATH[PA2$]
      F2$=Param$
   Else 
      F2$=PA2$
   End If 
   If F2$=""
      Goto SCHLEIFE
   End If 
   G$=Chr$(34)+PTYP$(3)+Chr$(34)+" "+Chr$(34)+F1$+Chr$(34)+" -x -d "+Chr$(34)+F2$+Chr$(34)
End If 
If TM=1
   G$=Chr$(34)+PTYP$(3)+Chr$(34)+" -t "+Chr$(34)+F1$+Chr$(34)
End If 

DEPACK

Goto SCHLEIFE
'------------------------------------------------
DMS:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO4:
If TM=0
   G$=Chr$(34)+PTYP$(4)+Chr$(34)+" write "+Chr$(34)+F1$+Chr$(34)
End If 
If TM=1
   G$=Chr$(34)+PTYP$(4)+Chr$(34)+" view "+Chr$(34)+F1$+Chr$(34)
End If 

DEPACK

Goto SCHLEIFE
'------------------------------------------------
ARJ:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO5:
If P=6
   HOLD$=PTYP$(5)
End If 
If P=9
   HOLD$=PTYP$(7)
End If 
If TM=0
   If CHESTA=1
      PATH[PA2$]
      F2$=Param$
   Else 
      F2$=PA2$
   End If 
   If F2$=""
      Goto SCHLEIFE
   End If 
   A$(1)="cd "+Chr$(34)+F2$+Chr$(34)
   A$(2)=Chr$(34)+HOLD$+Chr$(34)+" x "+Chr$(34)+F1$+Chr$(34)
   Open Out 1,"ram:script"
   For I=1 To 2
      Print #1,A$(I); : Print #1,Chr$(10);
   Next I
   Close 1
   Open Out 1,"ram:puffer"
   Print #1,"execute ram:script"; : Print #1,Chr$(10);
   Print #1,"wait 3 secs"; : Print #1,Chr$(10);
   Print #1,"endshell"; : Print #1,Chr$(10);
   Close 1
   Exec "newshell con:0/0/640/256/Packer-Ausgabe/close from ram:puffer"
End If 
If TM=1
   G$=Chr$(34)+HOLD$+Chr$(34)+" t "+Chr$(34)+F1$+Chr$(34)
   DEPACK
End If 
Goto SCHLEIFE
'--------------------------------------------------
PP:
If TM=1 Then TM=0 : Goto SCHLEIFE
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
If CHESTA=1
   PATH[PA2$]
   F2$=Param$
Else 
   F2$=PA2$
End If 
If F2$=""
   Goto SCHLEIFE
End If 
G$=Chr$(34)+PTYP$(6)+Chr$(34)+"  nodel "+Chr$(34)+F1$+Chr$(34)+" to "+Chr$(34)+F2$+Chr$(34)

DEPACK

Goto SCHLEIFE
'----------------------------------------------------
APLUS:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO6:
If TM=0
   If CHESTA=1
      PATH[PA2$]
      F2$=Param$
   Else 
      F2$=PA2$
   End If 
   If F2$=""
      Goto SCHLEIFE
   End If 
   G$=Chr$(34)+F1$+Chr$(34)+" "+Chr$(34)+F2$+Chr$(34)
End If 
If TM=1
   G$=Chr$(34)+F1$+Chr$(34)+" -t"
End If 

DEPACK

Goto SCHLEIFE
'----------------------------------------------------- 
AUTO:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
CHECK$=Lower$(Right$((F1$),4))
If CHECK$=".lha" Then P=1 : Goto AUTO1
If CHECK$=".lzh" Then P=2 : Goto AUTO1
If CHECK$=".lzx" Then P=3 : Goto AUTO1
If CHECK$=".zip" Then Goto AUTO3
If CHECK$=".dms" Then Goto AUTO4
If CHECK$=".arj" Then P=6 : Goto AUTO5
If CHECK$=".run" Then Goto AUTO6
If CHECK$=".rar" Then P=9 : Goto AUTO5
Goto SCHLEIFE
'----------------------------------------------------- 
ABOUT:
For I=1 To 6
   Ex Gadget Lock I,1
Next 
REQ$=""
REQ$=REQ$+" DFace is Freeware, but don't spread it manipulated ! "+LF$
REQ$=REQ$+"Please spread only the original LHA-File with complete"+LF$
REQ$=REQ$+"contents ! I don't give any guaranty, that DFace works"+LF$
REQ$=REQ$+" without errors ! Use DFace at your own risk because  "+LF$
REQ$=REQ$+"  I'm not responsible for any crashes of your system  "+LF$+LF$
REQ$=REQ$+"   DFace was designed with Amos_Pro V2.0 and AMIPS    "+LF$
REQ$=REQ$+"   Written in 6/96 by Andreas Wenk  Klingelholl 99    "+LF$
REQ$=REQ$+"              42281 Wuppertal - Germany               "+LF$+LF$
REQ$=REQ$+" E-Mail: sks@wizard.art-line.de/sks@legoland.aworld.de"+LF$
REQ$=REQ$+"  sks@blue-box.dssd.sub.org ... Please contact me, if "+LF$
REQ$=REQ$+"           you have wishes and criticism !            "
RQ=Ex Request(2,"About DFace...",REQ$,"Shut up")
Goto SCHLEIFE
'----------------------------------------------------
PREFS:
For I=1 To 6
   Ex Gadget Lock I,1
Next 
Ex Wind Open 2,100,30,250,150,$40+$200,14,0
Ex Wind Title 2,"Prefs Window"
Ex Gadgets Init 0,2,8
Ex Def Button 1,10,30,105,15,"Archive-Path",16,2
Ex Def Button 2,125,30,100,15,"Output-Path",16,2
Ex Def Button 3,30,120,50,15,"Save",16,2
Ex Def Button 4,90,120,50,15,"Use",16,2
Ex Def Button 5,150,120,50,15,"Abort",16,2
Ex Def Cycle 6,30,70,70,15,Ex Labels(2),"Packer",4,2
Ex Def Button 7,125,70,100,15,"Packer-Path",16,2
Ex Def Checkbox 8,170,100,0,0,"Destination Request",0,2
Ex Gadgets Open 2
Ex Set Checkbox 8,CHESTA,2
Ex Set Cycle 6,CP,2
MERK=CP
PU1$=PA1$ : PU2$=PA2$
For I=1 To 7 : PTP$(I)=PTYP$(I) : Next I
PCHESTA=CHESTA
SCHLEIFE2:
Ex Wind Active 2
Do 
   Multi Wait 
   MSG=Ex Get Msg(2)
   If MSG
      Ex Reply Msg 
      If MSG=$200
         PA1$=PU1$ : PA2$=PU2$
         CP=MERK
         Goto PREFSEND
      End If 
      If MSG=$40
         GH=Ex Get Key
      End If 
      If GH=5
         PA1$=PU1$ : PA2$=PU2$
         For I=1 To 7 : PTYP$(I)=PTP$(I) : Next I
         CP=MERK
         CHESTA=PCHESTA
         Goto PREFSEND
      End If 
      If GH=1
         PATH[PA1$]
         PA1$=Param$
         If PA1$=""
            PA1$=PU1$
         End If 
      End If 
      If GH=2
         PATH[PA2$]
         PA2$=Param$
         If PA2$=""
            PA2$=PU2$
         End If 
      End If 
      If GH=3
         Open Out 1,"Config"
         Print #1,PA1$
         Print #1,PA2$
         Print #1,PB
         Print #1,Ex Get Checkbox(8,2)
         For I=1 To 7 : Print #1,PTYP$(I) : Next I
         Close 1
         Ex Set Cycle 1,CP,1
         CHESTA=Ex Get Checkbox(8,2)
         Goto PREFSEND
      End If 
      If GH=4
         Ex Set Cycle 1,CP,1
         CHESTA=Ex Get Checkbox(8,2)
         Goto PREFSEND
      End If 
      If GH=6
         PB=Ex Get Part : CP=PB
      End If 
      If GH=7
         If CP=0
            PTYP$(1)=Ex Filesel$(0,0,"LHA anwählen","","","")
            If PTYP$(1)=""
               PTYP$(1)=PTP$(1)
            End If 
         End If 
         If CP=2
            PTYP$(2)=Ex Filesel$(0,0,"LZX anwählen","","","")
            If PTYP$(2)=""
               PTYP$(2)=PTP$(2)
            End If 
         End If 
         If CP=3
            PTYP$(3)=Ex Filesel$(0,0,"UNZIP anwählen","","","")
            If PTYP$(3)=""
               PTYP$(3)=PTP$(3)
            End If 
         End If 
         If CP=4
            PTYP$(4)=Ex Filesel$(0,0,"DMS anwählen","","","")
            If PTYP$(4)=""
               PTYP$(4)=PTP$(4)
            End If 
         End If 
         If CP=5
            PTYP$(5)=Ex Filesel$(0,0,"UNARJ anwählen","","","")
            If PTYP$(5)=""
               PTYP$(5)=PTP$(5)
            End If 
         End If 
         If CP=6
            PTYP$(6)=Ex Filesel$(0,0,"PPACK anwählen","","","")
            If PTYP$(6)=""
               PTYP$(6)=PTP$(6)
            End If 
         End If 
         If CP=8
            PTYP$(7)=Ex Filesel$(0,0,"UNRAR anwählen","","","")
            If PTYP$(7)=""
               PTYP$(7)=PTP$(7)
            End If 
         End If 
      End If 
   End If 
Loop 
PREFSEND:
Ex Wind Close 2
Ex Gadgets Close 2
Ex Wind Active 1
Goto SCHLEIFE
'----------------------------------------------------- 
Procedure FERTIG
   Ex Wind Close 1
   Ex Gadgets Close 1
   End 
End Proc
Procedure FISEL
   Shared CP
   SUF$=""
   If CP=0 Then SUF$="#?.lha"
   If CP=1 Then SUF$="#?.lzh"
   If CP=2 Then SUF$="#?.lzx"
   If CP=3 Then SUF$="#?.zip"
   If CP=4 Then SUF$="#?.dms"
   If CP=5 Then SUF$="#?.arj"
   If CP=7 Then SUF$="#?.run"
   If CP=8 Then SUF$="#?.rar"
   FILE$=Ex Filesel$(0,0,"Archiv wählen",PA1$,"",SUF$)
End Proc[FILE$]
Procedure PATH[DF$]
   PATH$=Ex Devsel$(1,"Zielschublade wählen",DF$)
End Proc[PATH$]
Procedure DEPACK
   Shared G$
   Open Out 1,"ram:puffer"
   Print #1,G$; : Print #1,Chr$(10);
   Print #1,"Wait 4 secs"; : Print #1,Chr$(10);
   Print #1,"endshell"; : Print #1,Chr$(10);
   Close 1
   Exec "newshell con:0/0/640/256/Packer-Ausgabe/close/auto from ram:puffer"
End Proc