Set Buffer 8
Global ER,PA1$,PA2$
Dim A$(5)
Dim PTYP$(8)
Dim PTP$(8)
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.04"
Ex Gadgets Init 0,1,6
Ex Labels Init 1,"LHA,LZH,LZX,ZIP,DMS,ARJ,PP,RUN,RAR,AUTO"
Ex Labels Init 2,"LHA,LZH,LZX,ZIP,DMS,ARJ,PP,RUN,RAR,AUTO"
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 
SCHLEIFE:
For I=1 To 6
   Ex Gadget Unlock I,1
Next 
If CP=6 Then Ex Gadget Lock 6,1
TM=0
Ex Wind Active 1
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,LZX,ZIP,DMS,ARJ,PP,APLUS,RAR,AUTO
'----------------------------------------------- 
LHA:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO1:
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$(1)+Chr$(34)+" x "+Chr$(34)+F1$+Chr$(34)+" "+Chr$(34)+F2$+Chr$(34)+Chr$(0)
End If 
If TM=1
   G$=Chr$(34)+PTYP$(1)+Chr$(34)+" t "+Chr$(34)+F1$+Chr$(34)+Chr$(0)
End If 
CONOPEN
DEPACK
CONCLOSE
Goto SCHLEIFE
'----------------------------------------------- 
LZX:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO2:
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$(2)+Chr$(34)+" x "+Chr$(34)+F1$+Chr$(34)+" "+Chr$(34)+F2$+Chr$(34)
End If 
If TM=1
   G$=Chr$(34)+PTYP$(2)+Chr$(34)+" t "+Chr$(34)+F1$+Chr$(34)
End If 
CONOPEN
DEPACK
CONCLOSE
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 
CONOPEN
DEPACK
CONCLOSE
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 
CONOPEN
DEPACK
CONCLOSE
Goto SCHLEIFE
'------------------------------------------------
ARJ:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO5:
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)+PTYP$(5)+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
   CONOPEN
   A$="execute "+Chr$(34)+"ram:script"+Chr$(34)+Chr$(0)
   Dreg(1)=Varptr(A$)
   Dreg(2)=0
   Dreg(3)=ER
   EXE=Doscall(-222)
   A$="echo Please Press Left Mousebutton"+Chr$(0)
   Dreg(1)=Varptr(A$)
   Dreg(2)=0
   Dreg(3)=ER
   EXE=Doscall(-222)
   Ex Mouse Wait 
   CONCLOSE
   Kill "ram:script"
End If 
If TM=1
   G$=Chr$(34)+PTYP$(5)+Chr$(34)+" t "+Chr$(34)+F1$+Chr$(34)
   CONOPEN
   DEPACK
   CONCLOSE
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)
CONOPEN
DEPACK
CONCLOSE
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 
CONOPEN
DEPACK
CONCLOSE
Goto SCHLEIFE
'----------------------------------------------------- 
RAR:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO7:
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)+PTYP$(7)+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
   CONOPEN
   A$="execute "+Chr$(34)+"ram:script"+Chr$(34)+Chr$(0)
   Dreg(1)=Varptr(A$)
   Dreg(2)=0
   Dreg(3)=ER
   EXE=Doscall(-222)
   A$="echo Please Press Left Mousebutton"+Chr$(0)
   Dreg(1)=Varptr(A$)
   Dreg(2)=0
   Dreg(3)=ER
   EXE=Doscall(-222)
   Ex Mouse Wait 
   CONCLOSE
   Kill "ram:script"
End If 
If TM=1
   G$=Chr$(34)+PTYP$(7)+Chr$(34)+" t "+Chr$(34)+F1$+Chr$(34)
   CONOPEN
   DEPACK
   CONCLOSE
End If 
Goto SCHLEIFE
'----------------------------------------------------- 
AUTO:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
CHECK$=Lower$(Right$((F1$),4))
If CHECK$=".lha" Then Goto AUTO1
If CHECK$=".lzh" Then Goto AUTO1
If CHECK$=".lzx" Then Goto AUTO2
If CHECK$=".zip" Then Goto AUTO3
If CHECK$=".dms" Then Goto AUTO4
If CHECK$=".arj" Then Goto AUTO5
If CHECK$=".run" Then Goto AUTO6
If CHECK$=".rar" Then Goto AUTO7
Goto SCHLEIFE
'----------------------------------------------------- 
ABOUT:
For I=1 To 6
   Ex Gadget Lock I,1
Next 
REQ$=""
REQ$=REQ$+"  DFace is Freeware, but don't "+Chr$(10)
REQ$=REQ$+"    spread it manipulated !    "+Chr$(10)+Chr$(10)
REQ$=REQ$+"   This Program was designed   "+Chr$(10)
REQ$=REQ$+"  with Amos_Pro V2.0 and AMIPS "+Chr$(10)+Chr$(10)
REQ$=REQ$+"Written in 5/96 by Andreas Wenk"+Chr$(10)
REQ$=REQ$+"E-Mail: sks@wizard.art-line.de "+Chr$(10)
REQ$=REQ$+"   or sks@legobbs.art-line.de  "
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
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$
         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
         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
         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
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 CONOPEN
   CONSOLE$="CON:0/0/640/200/Packer-Ausgabe-Fenster"+Chr$(0)
   Dreg(1)=Varptr(CONSOLE$)
   Dreg(2)=1006
   ER=Doscall(-30)
End Proc
Procedure CONCLOSE
   Shared ER
   Dreg(1)=ER
   EXE=Doscall(-36)
End Proc
Procedure DEPACK
   Shared G$,ER
   Dreg(1)=Varptr(G$)
   Dreg(2)=0
   Dreg(3)=ER
   EXE=Doscall(-222)
   MG$="echo please press mousebutton"+Chr$(0)
   Dreg(1)=Varptr(MG$)
   Dreg(2)=0
   Dreg(3)=ER
   EXE=Doscall(-222)
   Ex Mouse Wait 
End Proc