home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / ENTERPRS / CPM / UTILS / A / ARC20.ARC / ARC.PAS < prev    next >
Pascal/Delphi Source File  |  1989-11-22  |  5KB  |  119 lines
  1. program arc;    { ARCCPM Version 2.0 }
  2.  
  3. (* TR 101189 *)
  4.  
  5. {$I CLINE127.INC }    (* 127-Character Commandline Patch *)
  6. {$I ARCDEF.INC }      (* ARCCPM Variable Type Definition *)
  7.  
  8. (* Vordefinierte Variablen des Hauptprogramms: Default-Einstellung *)
  9.  
  10. const title    = 'ARC for CP/M, TURBO-Version 22.11.89 (TR)';
  11.       kludge   : boolean    = true;   (* Komprimieren versuchen   *)
  12.       force    : boolean    = false;  (* nicht immer crunchen     *)
  13.       warn     : boolean    = true;   (* Fehlermeldungen anzeigen *)
  14.       note     : boolean    = true;   (* Hinweise anzeigen        *)
  15.       keepbak  : boolean    = false;  (* Kein ARC-Backup anlegen  *)
  16.       pass     : string[10] = '';     (* Kein Passwortschutz      *)
  17.       cmd      : char       = #0;     (* noch kein Befehl gueltig *)
  18.       empty    = 'Archive empty - nothing done!';
  19.  
  20. (* Globale Variablen des Hauptprogramms *)
  21.  
  22. var   arg                            : arglist;
  23.       time                           : boolean;
  24.       cmdstr,arcname,newname,bakname : filenam;
  25.       arcpath                        : str4;
  26.       newarc,oldarc                  : binfile;
  27.       pcount                         : byte;
  28.       gi,arcdate,arctime             : integer;
  29.  
  30. (* Globale Variablen fuer Unterprogramme gemeinsam *)
  31.  
  32.       orgfile                        : binfile;
  33.       header                         : headtype;
  34.       did                            : flaglist;
  35.       found,bdummy                   : boolean;
  36.  
  37. {$I ARCMISC.INC }    (* Grundfunktionen, Mathe   *)
  38. {$I ARCFUNC.INC }    (* Binaer-File-I/O          *)
  39. {$I ARCDIR.INC }     (* Directory-Funktionen     *)
  40. {$I ARCIO.INC }      (* ARC-File-I/O             *)
  41. {$I ARCSQU.INC }     (* Un/Squeezing             *)
  42. {$I ARCLZW.INC }     (* Un/Crunching (LZW)       *)
  43. {$I ARCPACK.INC }    (* Komprimieren/Expandieren *)
  44. {$I ARCLST.INC }     (* ARC-Inhalt zeigen        *)
  45. {$I ARCEXT.INC }     (* Dateien extrahieren      *)
  46. {$I ARCDEL.INC }     (* Dateien loeschen         *)
  47. {$I ARCADD.INC }     (* Dateien einfuegen        *)
  48.  
  49. procedure showhelp;
  50. begin
  51.   write(
  52. '          ARCCPM - an ARCHIVE Utility for CP/M-80 (V 2.2 & 3.0)'^M^J,
  53. '          -----------------------------------------------------'^M^J,
  54. '              Version 2.0  - Turbo Pascal 3.00A -  Nov.1989'^M^J^J,
  55. '              Public domain by      Reimer Mellin, Muenchen'^M^J,
  56. '              Enhanced Rewriting by     Tilmann Reh, Siegen'^M^J^J,
  57. '              > NOTE: FOR PRIVATE NON-COMMERCIAL USE ONLY <'^M^J^J,
  58. '                               U S A G E :'^M^J^J,
  59. '            ARC adelmvx (bknstw) (g<passw>) <arch> (<fname>..)'^M^J^J,
  60. '           a   = add files to archive   b   = keep backup of archive'^M^J,
  61. '           d   = delete from archive    k   = force crunching'^M^J,
  62. '           x,e = extract from archive   n   = suppress notes'^M^J,
  63. '           l,v = list files in archive  s   = store only'^M^J,
  64. '           m   = move files to archive  t   = set date and time'^M^J,
  65. '           g   = Encrypt/decrypt entry  w   = suppress warnings'^M^J^J,
  66. '           ( Refer to ARCCPM.DOC for complete documentation ... )'^M^J);
  67.   end;
  68.  
  69. (*----- MAIN -----*)
  70.  
  71. begin
  72.   if paramcount<2 then showhelp else begin
  73.     writeln(^M^J,title,^M^J);
  74.     time:=(bdoshl(12)>=$30);
  75.     cmdstr:=paramstr(1); arcname:=paramstr(2);
  76.     pcount:=pred(pred(paramcount));
  77.     for gi:=1 to pcount do arg[gi]:=paramstr(succ(succ(gi)));
  78.     gi:=pos(':',arcname);
  79.     if gi=0 then arcpath:='' else begin
  80.       arcpath:=copy(arcname,1,gi); delete(arcname,1,gi); end;
  81.     makefnam(arcname,'.ARC',arcname);
  82.     makefnam(arcname,'.$$$',newname);   (* ARCPATH erst bei OPENARC *)
  83.     makefnam(arcname,'.BAK',bakname);
  84.     gi:=1; repeat
  85.       case cmdstr[gi] of
  86.         'A','D','E','L','M','V','X' : begin
  87.                if cmd<>#0 then begin
  88.                  writeln('Cannot mix ',cmd,' and ',cmdstr[gi]);
  89.                  halt; end;
  90.                cmd:=cmdstr[gi];
  91.                end;
  92.         'B': keepbak:=true;
  93.         'W': warn:=false;
  94.         'N': note:=false;
  95.         'S': kludge:=false;
  96.         'K': force:=true;
  97.         'T': time:=false;
  98.         'G': begin
  99.                pass:=copy(cmdstr,succ(gi),gi+21);
  100.                gi:=length(cmdstr);
  101.                end;
  102.         '-','/':;
  103.         else begin
  104.           writeln(cmdstr[gi],' is an unknown command!');
  105.           halt; end;
  106.         end;
  107.       gi:=succ(gi);
  108.     until gi>length(cmdstr);
  109.     if cmd=#0 then begin writeln('I have nothing to do ...'); halt; end;
  110.     get_global_datetime;
  111.     case cmd of
  112.       'A','M' : addarc;
  113.       'D'     : delarc;
  114.       'E','X' : extarc;
  115.       'V','L' : lstarc;
  116.       end;
  117.     end;
  118.   end.
  119.