home *** CD-ROM | disk | FTP | other *** search
/ CBM Funet Archive / cbm-funet-archive-2003.iso / cbm / crossplatform / converters / msdos / zip2d64.arj / ZIP2D64.PAS < prev   
Pascal/Delphi Source File  |  1993-11-24  |  4KB  |  139 lines
  1. {$7b}$m 16384,0,0{$7d}
  2.  
  3. TYPE BLOCKTYPE=ARRAY [0..255] OF BYTE;
  4.  
  5.  
  6.  
  7. VAR TRACK, SECTOR, MAX_SECTOR: BYTE;
  8.  
  9.     INFILE, OUTFILE: FILE;
  10.  
  11.     TRACK_DATA: ARRAY [0..8192] OF BYTE;
  12.  
  13.     SECTOR_FLAG: ARRAY [0..20] OF BYTE;
  14.  
  15.     I, BLOCK_COUNT: INTEGER;
  16.  
  17.  
  18.  
  19. FUNCTION READ_SECTOR (VAR F: FILE; TRACK: BYTE): INTEGER;
  20.  
  21. LABEL eRROR;
  22.  
  23. VAR TRK, SEC, MAX_SEC, LEN, REP, REPNUM, CHRA: BYTE;
  24.  
  25.     I, J, COUNT: INTEGER;
  26.  
  27. BEGIN
  28.  
  29.   BLOCKREAD (F, TRK, 1);
  30.  
  31.   BLOCKREAD (F, SEC, 1);
  32.  
  33.   IF ((TRK AND 63) <> TRACK) OR (SECTOR_FLAG [SEC] <> 0) OR (SEC > MAX_SECTOR) THEN
  34.  
  35.   BEGIN
  36.  
  37.  
  38.  
  39. eRROR:
  40.  
  41.     READ_SECTOR:=1;
  42.  
  43.     WRITELN ('fILE IS CORRUPTED.');
  44.  
  45.     EXIT;
  46.  
  47.   END;
  48.  
  49.  
  50.  
  51.   SECTOR_FLAG [SEC]:=1;
  52.  
  53.   IF ((TRK AND 128) = 128) THEN
  54.  
  55.   BEGIN
  56.  
  57.     WRITE ('1');
  58.  
  59.     BLOCKREAD (F, LEN, 1);
  60.  
  61.     BLOCKREAD (F, REP, 1);
  62.  
  63.     COUNT:=0;
  64.  
  65.     FOR I:=0 TO LEN-1 DO
  66.  
  67.     BEGIN
  68.  
  69.       IF (EOF (F)) THEN GOTO eRROR;
  70.  
  71.       BLOCKREAD (F, CHRA, 1);
  72.  
  73.       IF (CHRA <> REP) THEN
  74.  
  75.       BEGIN
  76.  
  77.         TRACK_DATA [SEC SHL 8+COUNT]:=CHRA;
  78.  
  79.         INC (COUNT);
  80.  
  81.       END ELSE
  82.  
  83.         BEGIN
  84.  
  85.           BLOCKREAD (F, REPNUM, 1);
  86.  
  87.           IF (EOF (F)) THEN GOTO eRROR;
  88.  
  89.           BLOCKREAD (F, CHRA, 1);
  90.  
  91.           I:=I+2;
  92.  
  93.           FOR J:=0 TO REPNUM-1 DO
  94.  
  95.           BEGIN
  96.  
  97.             TRACK_DATA [SEC SHL 8+COUNT]:=CHRA;
  98.  
  99.             INC (COUNT);
  100.  
  101.           END;
  102.  
  103.         END;
  104.  
  105.     END;
  106.  
  107.   END ELSE
  108.  
  109.   IF ((TRK AND 64) = 64) THEN
  110.  
  111.   BEGIN
  112.  
  113.     WRITE ('2');
  114.  
  115.     IF (EOF (F)) THEN GOTO eRROR;
  116.  
  117.     BLOCKREAD (F, CHRA, 1);
  118.  
  119.     FILLCHAR (TRACK_DATA [SEC SHL 8], 256, CHRA);
  120.  
  121.   END ELSE
  122.  
  123.   BEGIN
  124.  
  125.     WRITE ('3');
  126.  
  127.     BLOCKREAD (F, TRACK_DATA [SEC SHL 8], 256, I);
  128.  
  129.     IF (I<>256) THEN GOTO eRROR;
  130.  
  131.   END;
  132.  
  133.   READ_SECTOR:=0;
  134.  
  135. END;
  136.  
  137.  
  138.  
  139. FUNCTION OPENFILE (P:BYTE): INTEGER;
  140.  
  141. BEGIN
  142.  
  143.   IF (P>1) THEN CLOSE (INFILE);
  144.  
  145.   ASSIGN (INFILE, CHR (P+48)+'!'+PARAMSTR (1));
  146.  
  147.   {$7b}$i-{$7d}
  148.  
  149.   RESET (INFILE, 1);
  150.  
  151.   IF (IORESULT<>0) THEN
  152.  
  153.   BEGIN
  154.  
  155.     WRITELN ('eRROR OPENING FILE');
  156.  
  157.     OPENFILE:=1;
  158.  
  159.     EXIT;
  160.  
  161.   END;
  162.  
  163.   {$7b}$i+{$7d}
  164.  
  165.   IF (P=1) THEN SEEK (INFILE, 4) ELSE SEEK (INFILE, 2);
  166.  
  167.   OPENFILE:=0;
  168.  
  169. END;
  170.  
  171.  
  172.  
  173. LABEL eRROR, eRROR2;
  174.  
  175. BEGIN
  176.  
  177.   WRITELN;
  178.  
  179.   WRITELN ('zIPcODE 2 d64 - eXTRACT zIPCODE DISKS TO c64s .d64 IMAGES');
  180.  
  181.   IF (PARAMCOUNT<>2) THEN
  182.  
  183.   BEGIN
  184.  
  185.     WRITELN ('uSAGE: ZIP2D64 <ZIPCODE FILE> <D64 IMAGE>');
  186.  
  187.   END ELSE
  188.  
  189.   BEGIN
  190.  
  191.     IF (POS ('.D64', PARAMSTR (2)) > 0) THEN ASSIGN (OUTFILE, PARAMSTR (2)) ELSE
  192.  
  193.       ASSIGN (OUTFILE, PARAMSTR (2)+'.d64');
  194.  
  195.     REWRITE (OUTFILE, 1);
  196.  
  197.  
  198.  
  199.     BLOCK_COUNT:=0;
  200.  
  201.     FOR TRACK:=1 TO 35 DO
  202.  
  203.     BEGIN
  204.  
  205.       FILLCHAR (TRACK_DATA, SIZEOF (TRACK_DATA), 0);
  206.  
  207.       IF (TRACK>=1) AND (TRACK<=17) THEN MAX_SECTOR:=20;
  208.  
  209.       IF (TRACK>=18) AND (TRACK<=24) THEN MAX_SECTOR:=18;
  210.  
  211.       IF (TRACK>=25) AND (TRACK<=30) THEN MAX_SECTOR:=17;
  212.  
  213.       IF (TRACK>=31) AND (TRACK<=35) THEN MAX_SECTOR:=16;
  214.  
  215.  
  216.  
  217.       CASE TRACK OF
  218.  
  219.         1: IF (OPENFILE (1) <>0) THEN GOTO eRROR2;
  220.  
  221.         9: IF (OPENFILE (2) <>0) THEN GOTO eRROR2;
  222.  
  223.         17: IF (OPENFILE (3) <>0) THEN GOTO eRROR2;
  224.  
  225.         26: IF (OPENFILE (4) <>0) THEN GOTO eRROR2;
  226.  
  227.       END;
  228.  
  229.  
  230.  
  231.       FILLCHAR (SECTOR_FLAG, SIZEOF (SECTOR_FLAG), 0);
  232.  
  233.       WRITE ('tRACK ', TRACK,' ');
  234.  
  235.       FOR SECTOR:=0 TO MAX_SECTOR DO
  236.  
  237.       BEGIN
  238.  
  239.         INC (BLOCK_COUNT);
  240.  
  241.         IF (READ_SECTOR (INFILE, TRACK) <>0) THEN GOTO eRROR;
  242.  
  243.       END;
  244.  
  245.       BLOCKWRITE (OUTFILE, TRACK_DATA, MAX_SECTOR*256+256);
  246.  
  247.       WRITELN;
  248.  
  249.     END;
  250.  
  251.  
  252.  
  253.     CLOSE (INFILE);
  254.  
  255.     CLOSE (OUTFILE);
  256.  
  257.   END;
  258.  
  259.   EXIT;
  260.  
  261.  
  262.  
  263.   eRROR:  
  264.  
  265.     CLOSE (INFILE);
  266.  
  267.   eRROR2:
  268.  
  269.     CLOSE (OUTFILE);
  270.  
  271.     HALT (2);
  272.  
  273. END.
  274.  
  275.  
  276.  
  277.