home *** CD-ROM | disk | FTP | other *** search
/ Brotikasten / BROTCD01.iso / exoten / msx / accpack.pma / ACCPACK.PAS < prev   
Pascal/Delphi Source File  |  1993-05-26  |  5KB  |  204 lines
  1. {$R-,I+}
  2.  
  3. PROGRAM ACCPACK30;
  4.  
  5. VAR
  6.   INFILE:FILE;
  7.   OUTFILE:FILE;
  8.   BUF1:ARRAY [1..4096] OF BYTE;
  9.   INNAME,OUTNAME:STRING[12];
  10.   A,B,C,H,L:INTEGER;
  11.   OK:BOOLEAN;
  12.  
  13.  
  14. PROCEDURE EMPAQUETAR;
  15. BEGIN
  16.   OK:=TRUE;
  17.   OUTNAME:=PARAMSTR(2);
  18.   ASSIGN(OUTFILE,OUTNAME+'.ACC');
  19.   {$I-}
  20.   RESET(OUTFILE);
  21.   {$I+}
  22.   OK:=(IORESULT=0);
  23.   IF NOT OK THEN REWRITE(OUTFILE);
  24.   B:=FILESIZE(OUTFILE);
  25.   SEEK(OUTFILE,B);
  26.   WRITELN;
  27.   WRITELN('ACCPACK v. 3.0 (c) 1990 by Associacio Catalunya Crackers');
  28.   FOR C:=3 TO PARAMCOUNT DO
  29.   BEGIN
  30.     INNAME:=PARAMSTR(C);
  31.     ASSIGN(INFILE,INNAME);
  32.     OK:=TRUE;
  33.     {$I-}
  34.     RESET(INFILE);
  35.     {$I+}
  36.     OK:=(IORESULT=0);
  37.     IF NOT OK THEN
  38.       BEGIN WRITELN;WRITELN('File no exist .......!!') END
  39.     ELSE
  40.     BEGIN
  41.       FOR A:=1 TO 4 DO
  42.         BUF1[A]:=255-A;
  43.       BUF1[5]:=LENGTH(INNAME);
  44.       FOR A:=6 TO (LENGTH(INNAME)+5) DO
  45.       BUF1[A]:=ORD(INNAME[A-5]);
  46.       A:=FILESIZE(INFILE);
  47.       H:=A DIV 256;
  48.       L:=A MOD 256;
  49.       A:=L+(H*256);
  50.       BUF1[50]:=L;BUF1[51]:=H;
  51.       WRITELN;
  52.       WRITE('Add. ',INNAME,'.. ',A,' BLOCKS ');
  53.       BLOCKWRITE(OUTFILE,BUF1,1);
  54.       WHILE NOT EOF(INFILE) DO
  55.       BEGIN
  56.         IF (FILESIZE(INFILE)-FILEPOS(INFILE))>31 THEN
  57.         BEGIN
  58.           BLOCKREAD(INFILE,BUF1,32);
  59.           BLOCKWRITE(OUTFILE,BUF1,32);
  60.         END
  61.         ELSE
  62.         IF (FILESIZE(INFILE)-FILEPOS(INFILE))>15 THEN
  63.         BEGIN
  64.           BLOCKREAD(INFILE,BUF1,16);
  65.           BLOCKWRITE(OUTFILE,BUF1,16);
  66.         END
  67.         ELSE
  68.         IF (FILESIZE(INFILE)-FILEPOS(INFILE))>7 THEN
  69.         BEGIN
  70.           BLOCKREAD(INFILE,BUF1,8);
  71.           BLOCKWRITE(OUTFILE,BUF1,8);
  72.         END
  73.         ELSE
  74.         IF (FILESIZE(INFILE)-FILEPOS(INFILE))>3 THEN
  75.         BEGIN
  76.           BLOCKREAD(INFILE,BUF1,4);
  77.           BLOCKWRITE(OUTFILE,BUF1,4);
  78.         END
  79.         ELSE
  80.         IF (FILESIZE(INFILE)-FILEPOS(INFILE))>1 THEN
  81.         BEGIN
  82.           BLOCKREAD(INFILE,BUF1,2);
  83.           BLOCKWRITE(OUTFILE,BUF1,2);
  84.         END
  85.         ELSE
  86.         BEGIN
  87.           BLOCKREAD(INFILE,BUF1,1);
  88.           BLOCKWRITE(OUTFILE,BUF1,1);
  89.         END;
  90.         WRITE('*');
  91.       END;
  92.     END;
  93.     CLOSE(INFILE);
  94.   END;
  95.   CLOSE(OUTFILE);
  96. END;
  97.  
  98.  
  99.  
  100.  
  101.  
  102. PROCEDURE DESEMPAQUETAR;
  103. BEGIN
  104.   INNAME:=PARAMSTR(2);
  105.   ASSIGN(INFILE,INNAME+'.ACC');
  106.   {$I-}
  107.   RESET(INFILE);
  108.   {$I+}
  109.   OK:=(IORESULT=0);
  110.   IF NOT OK THEN BEGIN WRITELN;WRITELN('Archive  no exist ......!!') END
  111.   ELSE
  112.   BEGIN
  113.     WRITELN;
  114.     WRITELN('ACCPACK v. 3.0 (c) 1990 by Associacio Catalunya Crackers');
  115.     REPEAT
  116.       writeln;
  117.       OUTNAME:='';
  118.       BLOCKREAD(INFILE,BUF1,1);
  119.       FOR A:=6 TO BUF1[5]+5 DO
  120.       OUTNAME:=OUTNAME+CHR(BUF1[A]);
  121.       ASSIGN(OUTFILE,OUTNAME);
  122.       REWRITE(OUTFILE);
  123.       L:=BUF1[50];H:=BUF1[51];
  124.       B:=L+(H*256);
  125.       WRITE('Restoring ',OUTNAME,' .. ',B,' BLOCKS ');
  126.       REPEAT
  127.         IF B>31 THEN
  128.         BEGIN
  129.           B:=B-32;
  130.           BLOCKREAD(INFILE,BUF1,32);
  131.           BLOCKWRITE(OUTFILE,BUF1,32);
  132.         END
  133.         ELSE
  134.         IF B>15 THEN
  135.         BEGIN
  136.           B:=B-16;
  137.           BLOCKREAD(INFILE,BUF1,16);
  138.           BLOCKWRITE(OUTFILE,BUF1,16);
  139.         END
  140.         ELSE
  141.         IF B>7 THEN
  142.         BEGIN
  143.           B:=B-8;
  144.           BLOCKREAD(INFILE,BUF1,8);
  145.           BLOCKWRITE(OUTFILE,BUF1,8);
  146.         END
  147.         ELSE
  148.         IF B>3 THEN
  149.         BEGIN
  150.           B:=B-4;
  151.           BLOCKREAD(INFILE,BUF1,4);
  152.           BLOCKWRITE(OUTFILE,BUF1,4);
  153.         END
  154.         ELSE
  155.         IF B>1 THEN
  156.         BEGIN
  157.           B:=B-2;
  158.           BLOCKREAD(INFILE,BUF1,2);
  159.           BLOCKWRITE(OUTFILE,BUF1,2);
  160.         END
  161.         ELSE
  162.         BEGIN
  163.           B:=B-1;
  164.           BLOCKREAD(INFILE,BUF1,1);
  165.           BLOCKWRITE(OUTFILE,BUF1,1);
  166.         END;
  167.         WRITE('*');
  168.       UNTIL B=0;
  169.       CLOSE(OUTFILE);
  170.      UNTIL(EOF(INFILE));
  171.      CLOSE(INFILE);
  172.    END;
  173. END;
  174.  
  175. PROCEDURE NOPARAM;
  176. BEGIN
  177.   WRITELN;WRITELN;
  178.   WRITELN('ACCPACK Ver. 3.0 (c) 1990 by A.C.C.');
  179.   writeln('Use: ACCPACK <Option> <Archive> <Filename> [<Filename>]');
  180.   writeln;
  181.   writeln('Options:');
  182.   writeln('            -A ............... Add files in archive');
  183.   writeln('            -E ............... Extract all files');
  184.   writeln;writeln;
  185. end;
  186.  
  187.  
  188.  
  189.  
  190.  
  191. (*    --------------------- Start of the program -----------------    *)
  192. BEGIN
  193.   OK:=FALSE;
  194.   if paramcount >0 then
  195.     if (paramstr(1)='-A') or (paramstr(1)='-a') or (paramstr(1)='-E') or
  196.     (paramstr(1)='-e') then OK:=true;
  197.   if not OK then NOPARAM
  198.   else
  199.   begin
  200.     if (paramstr(1)='-A') or (paramstr(1)='-a') then EMPAQUETAR;
  201.     if (paramstr(1)='-E') or (paramstr(1)='-e') then DESEMPAQUETAR;
  202.   end;
  203. END.
  204.