home *** CD-ROM | disk | FTP | other *** search
/ The Best of Mecomp Multimedia 1 / Mecomp-CD.iso / amiga / packer / decruncherface / source / dface105.amos / dface105.amosSourceCode
AMOS Source Code  |  1996-06-10  |  11KB  |  461 lines
  1. Set Buffer 8
  2. Global ER,PA1$,PA2$
  3. Dim A$(5)
  4. Dim PTYP$(8)
  5. Dim PTP$(8)
  6. LF$=Chr$(10)
  7. For I=1 To 7 : Read PDATA$ : PTYP$(I)=PDATA$ : Next 
  8. Data "LHA","LZX","UNZIP","DMS","UNARJ","PPACK","UNRAR"
  9. CHESTA=1
  10. '----------------------------------------------------
  11. 'Tooltypes auslesen
  12. '
  13. WBY= Extension_17_007A 
  14. WBX= Extension_17_0068 
  15. TTYPE1$= Extension_17_0C84("DFACE","XPOS")
  16. TTYPE2$= Extension_17_0C84("DFACE","YPOS")
  17. TTYPE3$= Extension_17_0C84("DFACE","ICONIFY")
  18. WINX=Val(TTYPE1$)
  19. WINY=Val(TTYPE2$)
  20. If WINX<0 Then WINX=0
  21. If WINY<0 Then WINY=0
  22. If(WINX+250)>WBX Then WINX=(WBX-250)
  23. If(WINY+120)>WBY Then WINY=(WBY-120)
  24.  Extension_17_0C9C 
  25. '----------------------------------------------------
  26. 'Prefs laden 
  27. '
  28. If Exist("config")
  29.    Open In 1,"config"
  30.    Line Input #1,PA1$
  31.    Line Input #1,PA2$
  32.    Input #1,PREFPACK
  33.    Input #1,CHESTA
  34.    For I=1 To 7 : Line Input #1,PTYP$(I) : Next I
  35.    Close 1
  36. End If 
  37. '----------------------------------------------------
  38.  Extension_17_00A0 1,WINX,WINY,250,120,$20+$40+$200,14,0
  39.  Extension_17_01B8 1,"DeCruncherFace V1.05"
  40.  Extension_17_04FA 0,1,6
  41. For I=1 To 2
  42.     Extension_17_1120 I,"LHA,LZH,LZX,ZIP,DMS,ARJ,PP,RUN,RAR,AUTO"
  43. Next 
  44.  Extension_17_05F4 1,30,30,80,15, Extension_17_1156(1),"Packer",4,1
  45.  Extension_17_0542 2,30,60,80,15,"DePack",16,1
  46.  Extension_17_0542 3,130,30,80,15,"Prefs",16,1
  47.  Extension_17_0542 4,130,60,80,15,"About",16,1
  48.  Extension_17_0542 5,130,90,80,15,"Quit",16,1
  49.  Extension_17_0542 6,30,90,80,15,"Test",16,1
  50.  Extension_17_052C 1
  51.  Extension_17_0822 1,PREFPACK,1
  52. CP=PREFPACK
  53. If TTYPE3$="YES"
  54.     Extension_17_016A 1
  55. End If 
  56.  Extension_17_0110 1
  57. SCHLEIFE:
  58. For I=1 To 6
  59.     Extension_17_08AC I,1
  60. Next 
  61. If CP=6 Then Extension_17_0894 6,1
  62. TM=0
  63. Do 
  64.    Multi Wait 
  65.    MSG= Extension_17_077E(1)
  66.    If MSG
  67.        Extension_17_0790 
  68.       If MSG=$200
  69.          GG= Extension_17_075C 
  70.           Extension_17_016A 1
  71.       End If 
  72.       If MSG=$20
  73.          GG= Extension_17_075C 
  74.       End If 
  75.       If MSG=$40
  76.          GG= Extension_17_075C 
  77.          If GG=1
  78.             CP= Extension_17_076C 
  79.             If CP=6
  80.                 Extension_17_0894 6,1
  81.             End If 
  82.             If CP<>6
  83.                 Extension_17_08AC 6,1
  84.             End If 
  85.          End If 
  86.       End If 
  87.       If GG=5
  88.          FERTIG
  89.       End If 
  90.       If GG=2
  91.          Exit 
  92.       End If 
  93.       If GG=4
  94.          Goto ABOUT
  95.       End If 
  96.       If GG=3
  97.          Goto PREFS
  98.       End If 
  99.       If GG=6
  100.          TM=1 : Exit 
  101.       End If 
  102.    End If 
  103. Loop 
  104. ZEIGER:
  105. P=CP+1
  106. For I=1 To 6
  107.     Extension_17_0894 I,1
  108. Next 
  109. On P Goto LHA,LHA,LHA,ZIP,DMS,ARJ,PP,APLUS,ARJ,AUTO
  110. '----------------------------------------------- 
  111. LHA:
  112. FISEL
  113. F1$=Param$
  114. If F1$="" Then Goto SCHLEIFE
  115. AUTO1:
  116. If P=2 or P=1
  117.    HOLD$=PTYP$(1)
  118. End If 
  119. If P=3
  120.    HOLD$=PTYP$(2)
  121. End If 
  122. If TM=0
  123.    If CHESTA=1
  124.       PATH[PA2$]
  125.       F2$=Param$
  126.    Else 
  127.       F2$=PA2$
  128.    End If 
  129.    
  130.    If F2$=""
  131.       Goto SCHLEIFE
  132.    End If 
  133.    G$=Chr$(34)+HOLD$+Chr$(34)+" x "+Chr$(34)+F1$+Chr$(34)+" "+Chr$(34)+F2$+Chr$(34)+Chr$(0)
  134. End If 
  135. If TM=1
  136.    G$=Chr$(34)+HOLD$+Chr$(34)+" t "+Chr$(34)+F1$+Chr$(34)+Chr$(0)
  137. End If 
  138. DEPACK
  139. Goto SCHLEIFE
  140. '--------------------------------------------------- 
  141. ZIP:
  142. FISEL
  143. F1$=Param$
  144. If F1$="" Then Goto SCHLEIFE
  145. AUTO3:
  146. If TM=0
  147.    If CHESTA=1
  148.       PATH[PA2$]
  149.       F2$=Param$
  150.    Else 
  151.       F2$=PA2$
  152.    End If 
  153.    If F2$=""
  154.       Goto SCHLEIFE
  155.    End If 
  156.    G$=Chr$(34)+PTYP$(3)+Chr$(34)+" "+Chr$(34)+F1$+Chr$(34)+" -x -d "+Chr$(34)+F2$+Chr$(34)
  157. End If 
  158. If TM=1
  159.    G$=Chr$(34)+PTYP$(3)+Chr$(34)+" -t "+Chr$(34)+F1$+Chr$(34)
  160. End If 
  161.  
  162. DEPACK
  163.  
  164. Goto SCHLEIFE
  165. '------------------------------------------------
  166. DMS:
  167. FISEL
  168. F1$=Param$
  169. If F1$="" Then Goto SCHLEIFE
  170. AUTO4:
  171. If TM=0
  172.    G$=Chr$(34)+PTYP$(4)+Chr$(34)+" write "+Chr$(34)+F1$+Chr$(34)
  173. End If 
  174. If TM=1
  175.    G$=Chr$(34)+PTYP$(4)+Chr$(34)+" view "+Chr$(34)+F1$+Chr$(34)
  176. End If 
  177.  
  178. DEPACK
  179.  
  180. Goto SCHLEIFE
  181. '------------------------------------------------
  182. ARJ:
  183. FISEL
  184. F1$=Param$
  185. If F1$="" Then Goto SCHLEIFE
  186. AUTO5:
  187. If P=6
  188.    HOLD$=PTYP$(5)
  189. End If 
  190. If P=9
  191.    HOLD$=PTYP$(7)
  192. End If 
  193. If TM=0
  194.    If CHESTA=1
  195.       PATH[PA2$]
  196.       F2$=Param$
  197.    Else 
  198.       F2$=PA2$
  199.    End If 
  200.    If F2$=""
  201.       Goto SCHLEIFE
  202.    End If 
  203.    A$(1)="cd "+Chr$(34)+F2$+Chr$(34)
  204.    A$(2)=Chr$(34)+HOLD$+Chr$(34)+" x "+Chr$(34)+F1$+Chr$(34)
  205.    Open Out 1,"ram:script"
  206.    For I=1 To 2
  207.       Print #1,A$(I); : Print #1,Chr$(10);
  208.    Next I
  209.    Close 1
  210.    Open Out 1,"ram:puffer"
  211.    Print #1,"execute ram:script"; : Print #1,Chr$(10);
  212.    Print #1,"wait 3 secs"; : Print #1,Chr$(10);
  213.    Print #1,"endshell"; : Print #1,Chr$(10);
  214.    Close 1
  215.    Exec "newshell con:0/0/640/256/Packer-Ausgabe/close from ram:puffer"
  216. End If 
  217. If TM=1
  218.    G$=Chr$(34)+HOLD$+Chr$(34)+" t "+Chr$(34)+F1$+Chr$(34)
  219.    DEPACK
  220. End If 
  221. Goto SCHLEIFE
  222. '--------------------------------------------------
  223. PP:
  224. If TM=1 Then TM=0 : Goto SCHLEIFE
  225. FISEL
  226. F1$=Param$
  227. If F1$="" Then Goto SCHLEIFE
  228. If CHESTA=1
  229.    PATH[PA2$]
  230.    F2$=Param$
  231. Else 
  232.    F2$=PA2$
  233. End If 
  234. If F2$=""
  235.    Goto SCHLEIFE
  236. End If 
  237. G$=Chr$(34)+PTYP$(6)+Chr$(34)+"  nodel "+Chr$(34)+F1$+Chr$(34)+" to "+Chr$(34)+F2$+Chr$(34)
  238.  
  239. DEPACK
  240.  
  241. Goto SCHLEIFE
  242. '----------------------------------------------------
  243. APLUS:
  244. FISEL
  245. F1$=Param$
  246. If F1$="" Then Goto SCHLEIFE
  247. AUTO6:
  248. If TM=0
  249.    If CHESTA=1
  250.       PATH[PA2$]
  251.       F2$=Param$
  252.    Else 
  253.       F2$=PA2$
  254.    End If 
  255.    If F2$=""
  256.       Goto SCHLEIFE
  257.    End If 
  258.    G$=Chr$(34)+F1$+Chr$(34)+" "+Chr$(34)+F2$+Chr$(34)
  259. End If 
  260. If TM=1
  261.    G$=Chr$(34)+F1$+Chr$(34)+" -t"
  262. End If 
  263.  
  264. DEPACK
  265.  
  266. Goto SCHLEIFE
  267. '----------------------------------------------------- 
  268. AUTO:
  269. FISEL
  270. F1$=Param$
  271. If F1$="" Then Goto SCHLEIFE
  272. CHECK$=Lower$(Right$((F1$),4))
  273. If CHECK$=".lha" Then P=1 : Goto AUTO1
  274. If CHECK$=".lzh" Then P=2 : Goto AUTO1
  275. If CHECK$=".lzx" Then P=3 : Goto AUTO1
  276. If CHECK$=".zip" Then Goto AUTO3
  277. If CHECK$=".dms" Then Goto AUTO4
  278. If CHECK$=".arj" Then P=6 : Goto AUTO5
  279. If CHECK$=".run" Then Goto AUTO6
  280. If CHECK$=".rar" Then P=9 : Goto AUTO5
  281. Goto SCHLEIFE
  282. '----------------------------------------------------- 
  283. ABOUT:
  284. For I=1 To 6
  285.     Extension_17_0894 I,1
  286. Next 
  287. REQ$=""
  288. REQ$=REQ$+" DFace is Freeware, but don't spread it manipulated ! "+LF$
  289. REQ$=REQ$+"Please spread only the original LHA-File with complete"+LF$
  290. REQ$=REQ$+"contents ! I don't give any guaranty, that DFace works"+LF$
  291. REQ$=REQ$+" without errors ! Use DFace at your own risk because  "+LF$
  292. REQ$=REQ$+"  I'm not responsible for any crashes of your system  "+LF$+LF$
  293. REQ$=REQ$+"   DFace was designed with Amos_Pro V2.0 and AMIPS    "+LF$
  294. REQ$=REQ$+"   Written in 6/96 by Andreas Wenk  Klingelholl 99    "+LF$
  295. REQ$=REQ$+"              42281 Wuppertal - Germany               "+LF$+LF$
  296. REQ$=REQ$+" E-Mail: sks@wizard.art-line.de/sks@legoland.aworld.de"+LF$
  297. REQ$=REQ$+"  sks@blue-box.dssd.sub.org ... Please contact me, if "+LF$
  298. REQ$=REQ$+"           you have wishes and criticism !            "
  299. RQ= Extension_17_04E2(2,"About DFace...",REQ$,"Shut up")
  300. Goto SCHLEIFE
  301. '----------------------------------------------------
  302. PREFS:
  303. For I=1 To 6
  304.     Extension_17_0894 I,1
  305. Next 
  306.  Extension_17_00A0 2,100,30,250,150,$40+$200,14,0
  307.  Extension_17_01B8 2,"Prefs Window"
  308.  Extension_17_04FA 0,2,8
  309.  Extension_17_0542 1,10,30,105,15,"Archive-Path",16,2
  310.  Extension_17_0542 2,125,30,100,15,"Output-Path",16,2
  311.  Extension_17_0542 3,30,120,50,15,"Save",16,2
  312.  Extension_17_0542 4,90,120,50,15,"Use",16,2
  313.  Extension_17_0542 5,150,120,50,15,"Abort",16,2
  314.  Extension_17_05F4 6,30,70,70,15, Extension_17_1156(2),"Packer",4,2
  315.  Extension_17_0542 7,125,70,100,15,"Packer-Path",16,2
  316.  Extension_17_06E8 8,170,100,0,0,"Destination Request",0,2
  317.  Extension_17_052C 2
  318.  Extension_17_07BC 8,CHESTA,2
  319.  Extension_17_0822 6,CP,2
  320. MERK=CP
  321. PU1$=PA1$ : PU2$=PA2$
  322. For I=1 To 7 : PTP$(I)=PTYP$(I) : Next I
  323. PCHESTA=CHESTA
  324. SCHLEIFE2:
  325.  Extension_17_0110 2
  326. Do 
  327.    Multi Wait 
  328.    MSG= Extension_17_077E(2)
  329.    If MSG
  330.        Extension_17_0790 
  331.       If MSG=$200
  332.          PA1$=PU1$ : PA2$=PU2$
  333.          CP=MERK
  334.          Goto PREFSEND
  335.       End If 
  336.       If MSG=$40
  337.          GH= Extension_17_075C 
  338.       End If 
  339.       If GH=5
  340.          PA1$=PU1$ : PA2$=PU2$
  341.          For I=1 To 7 : PTYP$(I)=PTP$(I) : Next I
  342.          CP=MERK
  343.          CHESTA=PCHESTA
  344.          Goto PREFSEND
  345.       End If 
  346.       If GH=1
  347.          PATH[PA1$]
  348.          PA1$=Param$
  349.          If PA1$=""
  350.             PA1$=PU1$
  351.          End If 
  352.       End If 
  353.       If GH=2
  354.          PATH[PA2$]
  355.          PA2$=Param$
  356.          If PA2$=""
  357.             PA2$=PU2$
  358.          End If 
  359.       End If 
  360.       If GH=3
  361.          Open Out 1,"Config"
  362.          Print #1,PA1$
  363.          Print #1,PA2$
  364.          Print #1,PB
  365.          Print #1, Extension_17_091C(8,2)
  366.          For I=1 To 7 : Print #1,PTYP$(I) : Next I
  367.          Close 1
  368.           Extension_17_0822 1,CP,1
  369.          CHESTA= Extension_17_091C(8,2)
  370.          Goto PREFSEND
  371.       End If 
  372.       If GH=4
  373.           Extension_17_0822 1,CP,1
  374.          CHESTA= Extension_17_091C(8,2)
  375.          Goto PREFSEND
  376.       End If 
  377.       If GH=6
  378.          PB= Extension_17_076C : CP=PB
  379.       End If 
  380.       If GH=7
  381.          If CP=0
  382.             PTYP$(1)= Extension_17_04BC(0,0,"LHA anw�hlen","","","")
  383.             If PTYP$(1)=""
  384.                PTYP$(1)=PTP$(1)
  385.             End If 
  386.          End If 
  387.          If CP=2
  388.             PTYP$(2)= Extension_17_04BC(0,0,"LZX anw�hlen","","","")
  389.             If PTYP$(2)=""
  390.                PTYP$(2)=PTP$(2)
  391.             End If 
  392.          End If 
  393.          If CP=3
  394.             PTYP$(3)= Extension_17_04BC(0,0,"UNZIP anw�hlen","","","")
  395.             If PTYP$(3)=""
  396.                PTYP$(3)=PTP$(3)
  397.             End If 
  398.          End If 
  399.          If CP=4
  400.             PTYP$(4)= Extension_17_04BC(0,0,"DMS anw�hlen","","","")
  401.             If PTYP$(4)=""
  402.                PTYP$(4)=PTP$(4)
  403.             End If 
  404.          End If 
  405.          If CP=5
  406.             PTYP$(5)= Extension_17_04BC(0,0,"UNARJ anw�hlen","","","")
  407.             If PTYP$(5)=""
  408.                PTYP$(5)=PTP$(5)
  409.             End If 
  410.          End If 
  411.          If CP=6
  412.             PTYP$(6)= Extension_17_04BC(0,0,"PPACK anw�hlen","","","")
  413.             If PTYP$(6)=""
  414.                PTYP$(6)=PTP$(6)
  415.             End If 
  416.          End If 
  417.          If CP=8
  418.             PTYP$(7)= Extension_17_04BC(0,0,"UNRAR anw�hlen","","","")
  419.             If PTYP$(7)=""
  420.                PTYP$(7)=PTP$(7)
  421.             End If 
  422.          End If 
  423.       End If 
  424.    End If 
  425. Loop 
  426. PREFSEND:
  427.  Extension_17_00E0 2
  428.  Extension_17_0514 2
  429.  Extension_17_0110 1
  430. Goto SCHLEIFE
  431. '----------------------------------------------------- 
  432. Procedure FERTIG
  433.     Extension_17_00E0 1
  434.     Extension_17_0514 1
  435.    End 
  436. End Proc
  437. Procedure FISEL
  438.    Shared CP
  439.    SUF$=""
  440.    If CP=0 Then SUF$="#?.lha"
  441.    If CP=1 Then SUF$="#?.lzh"
  442.    If CP=2 Then SUF$="#?.lzx"
  443.    If CP=3 Then SUF$="#?.zip"
  444.    If CP=4 Then SUF$="#?.dms"
  445.    If CP=5 Then SUF$="#?.arj"
  446.    If CP=7 Then SUF$="#?.run"
  447.    If CP=8 Then SUF$="#?.rar"
  448.    FILE$= Extension_17_04BC(0,0,"Archiv w�hlen",PA1$,"",SUF$)
  449. End Proc[FILE$]
  450. Procedure PATH[DF$]
  451.    PATH$= Extension_17_0CDC(1,"Zielschublade w�hlen",DF$)
  452. End Proc[PATH$]
  453. Procedure DEPACK
  454.    Shared G$
  455.    Open Out 1,"ram:puffer"
  456.    Print #1,G$; : Print #1,Chr$(10);
  457.    Print #1,"Wait 4 secs"; : Print #1,Chr$(10);
  458.    Print #1,"endshell"; : Print #1,Chr$(10);
  459.    Close 1
  460.    Exec "newshell con:0/0/640/256/Packer-Ausgabe/close/auto from ram:puffer"
  461. End Proc