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.03"
Ex Gadgets Init 0,1,5
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,80,90,80,15,"Quit",16,1
Ex Gadgets Open 1
Ex Set Cycle 1,PREFPACK,1
CP=PREFPACK
If TTYPE3$="YES"
   Ex Wind Zip 1
End If 
SCHLEIFE:
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
         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 
   End If 
Loop 
ZEIGER:
P=CP+1
On P Goto LHA,LHA,LZX,ZIP,DMS,ARJ,PP,APLUS,RAR,AUTO
'----------------------------------------------- 
LHA:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO1:
If CHESTA=1
   PATH[PA2$]
   F2$=Param$
Else 
   F2$=PA2$
End If 

If F2$="" Then Goto SCHLEIFE
G$=Chr$(34)+PTYP$(1)+Chr$(34)+" x "+Chr$(34)+F1$+Chr$(34)+" "+Chr$(34)+F2$+Chr$(34)+Chr$(0)
CONOPEN
DEPACK
CONCLOSE
Goto SCHLEIFE
'----------------------------------------------- 
LZX:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO2:
If CHESTA=1
   PATH[PA2$]
   F2$=Param$
Else 
   F2$=PA2$
End If 
If F2$="" Then Goto SCHLEIFE
G$=Chr$(34)+PTYP$(2)+Chr$(34)+" x "+Chr$(34)+F1$+Chr$(34)+" "+Chr$(34)+F2$+Chr$(34)
CONOPEN
DEPACK
CONCLOSE
Goto SCHLEIFE
'----------------------------------------------- 
ZIP:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO3:
If CHESTA=1
   PATH[PA2$]
   F2$=Param$
Else 
   F2$=PA2$
End If 
If F2$="" Then Goto SCHLEIFE
G$=Chr$(34)+PTYP$(3)+Chr$(34)+" "+Chr$(34)+F1$+Chr$(34)+" -x -d "+Chr$(34)+F2$+Chr$(34)
CONOPEN
DEPACK
CONCLOSE
Goto SCHLEIFE
'------------------------------------------------
DMS:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO4:
G$=Chr$(34)+PTYP$(4)+Chr$(34)+" write "+Chr$(34)+F1$+Chr$(34)
CONOPEN
DEPACK
CONCLOSE
Goto SCHLEIFE
'------------------------------------------------
ARJ:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO5:
If CHESTA=1
   PATH[PA2$]
   F2$=Param$
Else 
   F2$=PA2$
End If 
If F2$="" Then Goto SCHLEIFE
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"
Goto SCHLEIFE
'--------------------------------------------------
PP:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
If CHESTA=1
   PATH[PA2$]
   F2$=Param$
Else 
   F2$=PA2$
End If 
If F2$="" Then Goto SCHLEIFE
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 CHESTA=1
   PATH[PA2$]
   F2$=Param$
Else 
   F2$=PA2$
End If 
If F2$="" Then Goto SCHLEIFE
G$=Chr$(34)+F1$+Chr$(34)+" "+Chr$(34)+F2$+Chr$(34)
CONOPEN
DEPACK
CONCLOSE
Goto SCHLEIFE
'----------------------------------------------------- 
RAR:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO7:
If CHESTA=1
   PATH[PA2$]
   F2$=Param$
Else 
   F2$=PA2$
End If 
If F2$="" Then Goto SCHLEIFE
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"
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:
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 4/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:
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