home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / DEZIP15.ARJ / DEZIP.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-11  |  40KB  |  1,193 lines
  1. Program DeZip;
  2.  
  3. {   DeZip v1.5 (C) Copyright 1989 by R. P. Byrne                              }
  4. {                                                                             }
  5. {   This is a "bare-bones" program to extract files from ZIP archives.        }
  6. {   By "bare-bones", I mean that there is no facility included to do anything }
  7. {   but extraction (ie. no echo to console, no send to printer, etc.).        }
  8. {   If relative pathnames are stored in the Zip file, make sure all of the    }
  9. {   required directories exist on your system before attempting an            }
  10. {   extraction.                                                               }
  11.  
  12. {$M 10240, 0, 0}           { Stack, Min. Heap, Max. Heap}
  13. {$F+}                      { Force far calls }
  14.  
  15. Uses
  16.    Dos,
  17.    Crt,
  18.    MemAlloc,
  19.    StrProcs;
  20.  
  21. Const
  22.    COPYRIGHT = 'DeZip (C) Copyright 1989 by R. P. Byrne';
  23.    VERSION   = 'Version 1.5 - Compiled on March 11, 1989';
  24.  
  25. { Stuff needed generically by all uncompression methods }
  26.  
  27. Const
  28.    MAXNAMES = 20;
  29.  
  30. Var
  31.    InFileSpecs :  Array[1..MAXNAMES] of String;   { Input file specifications }
  32.    MaxSpecs    :  Word;        { Total number of entries in InFileSpecs array }
  33.    OutPath     :  String;      { Output path specification                    }
  34.  
  35.    TenPercent  :  LongInt;
  36.  
  37. { Define ZIP file header types }
  38.  
  39. Const
  40.    LOCAL_FILE_HEADER_SIGNATURE = $04034B50;
  41.  
  42. Type
  43.    Local_File_Header_Type = Record
  44.                              { Signature              :  LongInt; }
  45.                                Extract_Version_Reqd   :  Word;
  46.                                Bit_Flag               :  Word;
  47.                                Compress_Method        :  Word;
  48.                                Last_Mod_Time          :  Word;
  49.                                Last_Mod_Date          :  Word;
  50.                                Crc32                  :  LongInt;
  51.                                Compressed_Size        :  LongInt;
  52.                                Uncompressed_Size      :  LongInt;
  53.                                Filename_Length        :  Word;
  54.                                Extra_Field_Length     :  Word;
  55.                             end;
  56.  
  57. Const
  58.    CENTRAL_FILE_HEADER_SIGNATURE = $02014B50;
  59.  
  60. Type
  61.    Central_File_Header_Type = Record
  62.                                { Signature            :  LongInt; }
  63.                                  MadeBy_Version       :  Word;
  64.                                  Extract_Version_Reqd :  Word;
  65.                                  Bit_Flag             :  Word;
  66.                                  Compress_Method      :  Word;
  67.                                  Last_Mod_Time        :  Word;
  68.                                  Last_Mod_Date        :  Word;
  69.                                  Crc32                :  LongInt;
  70.                                  Compressed_Size      :  LongInt;
  71.                                  Uncompressed_Size    :  LongInt;
  72.                                  Filename_Length      :  Word;
  73.                                  Extra_Field_Length   :  Word;
  74.                                  File_Comment_Length  :  Word;
  75.                                  Starting_Disk_Num    :  Word;
  76.                                  Internal_Attributes  :  Word;
  77.                                  External_Attributes  :  LongInt;
  78.                                  Local_Header_Offset  :  LongInt;
  79.                               End;
  80.  
  81. Const
  82.    END_OF_CENTRAL_DIR_SIGNATURE = $06054B50;
  83.  
  84. Type
  85.    End_of_Central_Dir_Type =  Record
  86.                                { Signature               :  LongInt; }
  87.                                  Disk_Number             :  Word;
  88.                                  Central_Dir_Start_Disk  :  Word;
  89.                                  Entries_This_Disk       :  Word;
  90.                                  Total_Entries           :  Word;
  91.                                  Central_Dir_Size        :  LongInt;
  92.                                  Start_Disk_Offset       :  LongInt;
  93.                                  ZipFile_Comment_Length  :  Word;
  94.                               end;
  95.  
  96. Const
  97.    CRC_32_TAB : Array[0..255] of LongInt = (
  98. $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3,
  99. $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91,
  100. $1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
  101. $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63, $8d080df5,
  102. $3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
  103. $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,
  104. $26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,
  105. $2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab, $b6662d3d,
  106. $76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
  107. $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
  108. $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457,
  109. $65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,
  110. $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb,
  111. $4369e96a, $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,
  112. $5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
  113. $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad,
  114. $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, $73dc1683,
  115. $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,
  116. $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7,
  117. $fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
  118. $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
  119. $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, $4669be79,
  120. $cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9, $5505262f,
  121. $c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
  122. $9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
  123. $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21,
  124. $86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,
  125. $88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45,
  126. $a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d, $3e6e77db,
  127. $aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
  128. $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729, $23d967bf,
  129. $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d
  130. );
  131.  
  132. Const
  133.    BUFSIZE       = 8192;           { Size of buffers for I/O }
  134.  
  135. Type
  136.    BufPtr        = ^BufType;
  137.    BufType      = Array[1..BUFSIZE] of Byte;
  138.  
  139. Var
  140.    ZipName       :  String;         { Name of Zip file to be processed }
  141.    ZipFile       :  File;           { Zip file variable }
  142.    EndFile       :  Boolean;        { End of file indicator for ZipFile }
  143.    ZipBuf        :  BufPtr;         { Input buffer for ZipFile }
  144.    ZipPtr        :  Word;           { Index for ZipFile input buffer }
  145.    ZipCount      :  Word;           { Count of bytes in ZipFile input buffer }
  146.  
  147.    ExtFile       :  File;           { Output file variable }
  148.    ExtBuf        :  BufPtr;         { Output buffer for ExtFile }
  149.    ExtPtr        :  Word;           { Index for ExtFile output buffer }
  150.    ExtCount      :  LongInt;        { Count of characters written to output }
  151.  
  152.    LocalHdr       :  Local_File_Header_Type;  { Storage for a local file hdr }
  153.    Hdr_FileName   : String;
  154.    Hdr_ExtraField : String;
  155.    Hdr_Comment    : String;
  156.  
  157.    Crc32Val      :  LongInt;        { Running CRC (32 bit) value }
  158.  
  159.    Bytes_To_Go   :  LongInt;        { Bytes left to process in compressed file }
  160.  
  161.  
  162. { Stuff needed for unSHRINKing }
  163.  
  164. Const
  165.    MINCODESIZE    =    9;
  166.    MAXCODESIZE    =   13;
  167.    SPECIAL        =  256;
  168.    FIRSTFREE      =  257;
  169.    LZW_TABLE_SIZE =  (1 SHL MAXCODESIZE) - 1;      { 0..8191 }
  170.    LZW_STACK_SIZE =  (1 SHL MAXCODESIZE) - 1;      { 0..8191 }
  171.  
  172. Type
  173.  
  174.    LZW_Table_Rec  =  Record
  175.                         Prefix      :  Integer;
  176.                         Suffix      :  Byte;
  177.                         ChildCount  :  Word;  { If ChildCount = 0 then leaf node }
  178.                      end;
  179.    LZW_Table_Ptr  =  ^LZW_Table_Type;
  180.    LZW_Table_Type =  Array[0..LZW_TABLE_SIZE] of LZW_Table_Rec;
  181.  
  182.    FreeListPtr    =  ^FreeListArray;
  183.    FreeListArray  =  Array[FIRSTFREE..LZW_TABLE_SIZE] of Word;
  184.  
  185.    StackPtr       =  ^StackType;
  186.    StackType      =  Array[0..LZW_STACK_SIZE] of Word;
  187.  
  188. Var
  189.    LZW_Table   :  LZW_Table_Ptr; { Code table for LZW decoding                }
  190.    FreeList    :  FreeListPtr;   { List of free table entries                 }
  191.    NextFree    :  Word;          { Index for free list array                  }
  192.                                  {   FreeList^[NextFree] always contains the  }
  193.                                  {   index of the next available entry in     }
  194.                                  {   the LZW Prefix:Suffix table (LZW_Table^) }
  195.    LZW_Stack   :  StackPtr;      { A stack used to build decoded strings      }
  196.    StackIdx    :  Word;          { Stack array index variable                 }
  197.                                  {   StackIdx always points to the next       }
  198.                                  {   available entry in the stack             }
  199.    SaveByte    :  Byte;          { Our input code buffer - 1 byte long }
  200.    BitsLeft    :  Byte;          { Unprocessed bits in the input code buffer }
  201.    FirstCh     :  Boolean;       { Flag indicating first char being processed }
  202.  
  203.  
  204. { Stuff needed for unREDUCEing }
  205.  
  206. Type
  207.    FollowerSet    =  Record
  208.                         SetSize  :  Word;
  209.                         FSet     :  Array[0..31] of Byte;
  210.                      end;
  211.    FollowerPtr    =  ^FollowerArray;
  212.    FollowerArray  =  Array[0..255] of FollowerSet;
  213.  
  214.    StreamPtr      =  ^StreamArray;
  215.    StreamArray    =  Array[0..4095] of Byte;
  216.  
  217. Var
  218.    Followers   :  FollowerPtr;
  219.    Stream      :  StreamPtr;     { The output stream }
  220.    StreamIdx   :  Word;          { Always points to next pos. to be filled }
  221.    State       :  Byte;
  222.    Len         :  Word;
  223.    V           :  Byte;
  224.  
  225. { --------------------------------------------------------------------------- }
  226.  
  227. Procedure Abort(Msg : String);
  228. Begin
  229.    Writeln;
  230.    Writeln(Msg);
  231.    Writeln('Returning to DOS');
  232.    Writeln;
  233.    Halt;
  234. end {Abort};
  235.  
  236. { --------------------------------------------------------------------------- }
  237.  
  238. Procedure Syntax;
  239. Begin
  240.    Writeln('Usage:  DeZip ZipFileName [OutPathSpec] [FileSpec [...]]');
  241.    Writeln;
  242.    Writeln('Optional file specifications may contain DOS ');
  243.    Writeln('wildcard characters.');
  244.    Writeln;
  245.    Writeln('If no filespecs are entered, *.* is assumed.');
  246.    Writeln;
  247.    Halt;
  248. End;
  249.  
  250. { --------------------------------------------------------------------------- }
  251.  
  252. Function HexLInt(L : LongInt) : String;
  253. Type
  254.    HexType  = Array [0..15] of Char;
  255. Const
  256.    HexChar : HexType = ('0','1','2','3','4','5','6','7',
  257.                         '8','9','A','B','C','D','E','F');
  258. Begin
  259.    HexLInt  := HexChar[(L AND $F0000000) SHR 28] +
  260.                HexChar[(L AND $0F000000) SHR 24] +
  261.                HexChar[(L AND $00F00000) SHR 20] +
  262.                HexChar[(L AND $000F0000) SHR 16] +
  263.                HexChar[(L AND $0000F000) SHR 12] +
  264.                HexChar[(L AND $00000F00) SHR  8] +
  265.                HexChar[(L AND $000000F0) SHR  4] +
  266.                HexChar[(L AND $0000000F)       ] +
  267.                'h';
  268. end {HexLInt};
  269.  
  270. { --------------------------------------------------------------------------- }
  271.  
  272. Function IO_Test : Boolean;
  273. Var
  274.    ErrorCode   :  Word;
  275.    CodeStr     :  String;
  276.    Ok          :  Boolean;
  277. Begin
  278.    Ok := TRUE;
  279.    ErrorCode := IOResult;
  280.    If ErrorCode <> 0 then begin
  281.       Ok := FALSE;
  282.       Case ErrorCode of
  283.            2 : Writeln('File Not Found');
  284.            3 : Writeln('Path Not Found');
  285.            5 : Writeln('Access Denied');
  286.          101 : Writeln('Disk Full');
  287.         else   Writeln('I/O Error # ', ErrorCode);
  288.       end {Case};
  289.    end {if};
  290.    IO_Test := Ok;
  291. end {IO_Test};
  292.  
  293. { --------------------------------------------------------------------------- }
  294.  
  295. Procedure Load_Parms;
  296. Var
  297.    I      : Word;
  298.    Name   : String;
  299.    DosDTA : SearchRec;
  300. Begin
  301.    I := ParamCount;
  302.    If I < 1 then
  303.       Syntax;
  304.  
  305.    ZipName := ParamStr(1);
  306.    For I := 1 to Length(ZipName) do
  307.       ZipName[I] := UpCase(ZipName[I]);
  308.    If Pos('.', ZipName) = 0 then
  309.       ZipName := ZipName  + '.ZIP';
  310.  
  311.    MaxSpecs := 0;
  312.    OutPath := '';
  313.    I := 1;
  314.    While I < ParamCount do begin
  315.       Inc(I);
  316.       Name := ParamStr(I);
  317.       If Name[length(Name)] = '\' then
  318.          Delete(Name, length(Name), 1);
  319.       FindFirst(Name, DIRECTORY, DosDTA);     { outpath spec? }
  320.       If DosError = 0 then begin
  321.          If (DosDTA.Attr AND DIRECTORY) <> 0 then begin   { yup }
  322.             OutPath := Name;
  323.             If OutPath[Length(OutPath)] <> '\' then
  324.                OutPath := OutPath + '\';
  325.          end {then}
  326.          else begin
  327.             If MaxSpecs < MAXNAMES then begin
  328.                Inc(MaxSpecs);
  329.                InFileSpecs[MaxSpecs] := Name;
  330.             end {if};
  331.          end {if};
  332.       end {then}
  333.       else begin
  334.          If MaxSpecs < MAXNAMES then begin
  335.             Inc(MaxSpecs);
  336.             InFileSpecs[MaxSpecs] := Name;
  337.          end {if};
  338.       end {if}
  339.    end {while};
  340.  
  341.    If MaxSpecs = 0 then begin
  342.       MaxSpecs := 1;
  343.       InFileSpecs[1] := '*.*';
  344.    end {if};
  345.  
  346. end {Load_Parms};
  347.  
  348. { --------------------------------------------------------------------------- }
  349.  
  350. Procedure Initialize;
  351. Var
  352.    Code : Integer;
  353. Begin
  354.    Code := Malloc(ZipBuf, SizeOf(ZipBuf^)) OR
  355.            Malloc(ExtBuf, SizeOf(ExtBuf^));
  356.    If Code <> 0 then
  357.       Abort('Not enough memory available to allocate I/O buffers!');
  358. end {Initialize};
  359.  
  360. { --------------------------------------------------------------------------- }
  361.  
  362. { Converted to Turbo Pascal (tm) V4.0 March, 1988 by J.R.Louvau               }
  363. { COPYRIGHT (C) 1986 Gary S. Brown.  You may use this program, or             }
  364. { code or tables extracted from it, as desired without restriction.           }
  365. {                                                                             }
  366. { First, the polynomial itself and its table of feedback terms.  The          }
  367. { polynomial is                                                               }
  368. { X^32+X^26+X^23+X^22+X^16+X^12+X^11+X^10+X^8+X^7+X^5+X^4+X^2+X^1+X^0         }
  369. {                                                                             }
  370. { Note that we take it "backwards" and put the highest-order term in          }
  371. { the lowest-order bit.  The X^32 term is "implied"; the LSB is the           }
  372. { X^31 term, etc.  The X^0 term (usually shown as "+1") results in            }
  373. { the MSB being 1.                                                            }
  374. {                                                                             }
  375. { Note that the usual hardware shift register implementation, which           }
  376. { is what we're using (we're merely optimizing it by doing eight-bit          }
  377. { chunks at a time) shifts bits into the lowest-order term.  In our           }
  378. { implementation, that means shifting towards the right.  Why do we           }
  379. { do it this way?  Because the calculated CRC must be transmitted in          }
  380. { order from highest-order term to lowest-order term.  UARTs transmit         }
  381. { characters in order from LSB to MSB.  By storing the CRC this way,          }
  382. { we hand it to the UART in the order low-byte to high-byte; the UART         }
  383. { sends each low-bit to hight-bit; and the result is transmission bit         }
  384. { by bit from highest- to lowest-order term without requiring any bit         }
  385. { shuffling on our part.  Reception works similarly.                          }
  386. {                                                                             }
  387. { The feedback terms table consists of 256, 32-bit entries.  Notes:           }
  388. {                                                                             }
  389. {     The table can be generated at runtime if desired; code to do so         }
  390. {     is shown later.  It might not be obvious, but the feedback              }
  391. {     terms simply represent the results of eight shift/xor opera-            }
  392. {     tions for all combinations of data and CRC register values.             }
  393. {                                                                             }
  394. {     The values must be right-shifted by eight bits by the "updcrc"          }
  395. {     logic; the shift must be unsigned (bring in zeroes).  On some           }
  396. {     hardware you could probably optimize the shift in assembler by          }
  397. {     using byte-swap instructions.                                           }
  398. {     polynomial $edb88320                                                    }
  399. {                                                                             }
  400.  
  401. Function UpdC32(Octet: Byte; Crc: LongInt) : LongInt;
  402. Var
  403.    L : LongInt;
  404.    W : Array[1..4] of Byte Absolute L;
  405. Begin
  406.  
  407.    UpdC32 := CRC_32_TAB[Byte(Crc XOR LongInt(Octet))] XOR ((Crc SHR 8) AND $00FFFFFF);
  408.  
  409. end {UpdC32};
  410.  
  411. { --------------------------------------------------------------------------- }
  412.  
  413. Procedure Read_Zip_Block;
  414. Begin
  415.    BlockRead(ZipFile, ZipBuf^, BUFSIZE, ZipCount);
  416.    If ZipCount = 0 then
  417.       EndFile := TRUE;
  418.    ZipPtr := 1;
  419. End {Read_Zip_Block};
  420.  
  421. { --------------------------------------------------------------------------- }
  422.  
  423. Procedure Write_Ext_Block;
  424. Begin
  425.    If ExtPtr > 1 then begin
  426.       BlockWrite(ExtFile, ExtBuf^, Pred(ExtPtr));
  427.       If NOT IO_Test then
  428.          Halt;
  429.       ExtPtr := 1;
  430.    end {if};
  431. End {Write_Ext_Block};
  432.  
  433. { --------------------------------------------------------------------------- }
  434.  
  435. Procedure Open_Zip;
  436. Begin
  437.    Assign(ZipFile, ZipName);
  438.    FileMode := 64;  { Read Only / Deny None }
  439.    {$I-} Reset(ZipFile, 1) {$I+};
  440.    If NOT IO_Test then
  441.       Halt;
  442.    EndFile := FALSE;
  443.    Read_Zip_Block;
  444. End {Open_Zip};
  445.  
  446. { --------------------------------------------------------------------------- }
  447.  
  448. Function Open_Ext : Boolean;
  449. Begin
  450.    Assign(ExtFile, OutPath + Hdr_FileName);
  451.    FileMode := 66;  { Read & Write / Deny None }
  452.    {$I-} Rewrite(ExtFile, 1) {$I+};
  453.    If NOT IO_Test then
  454.       Open_Ext := FALSE
  455.    else begin
  456.       ExtPtr := 1;
  457.       Open_Ext := TRUE;
  458.    end {if};
  459. end {Open_Ext};
  460.  
  461. { --------------------------------------------------------------------------- }
  462.  
  463. Function Get_Zip : Integer;
  464. Begin
  465.    If ZipPtr > ZipCount then
  466.       Read_Zip_Block;
  467.  
  468.    If EndFile then
  469.       Get_Zip := -1
  470.    else begin
  471.       Get_Zip := ZipBuf^[ZipPtr];
  472.       Inc(ZipPtr);
  473.    end {if};
  474. end {Get_Zip};
  475.  
  476. { --------------------------------------------------------------------------- }
  477.  
  478. Procedure Put_Ext(C : Byte);
  479. Begin
  480.    Crc32Val := UpdC32(C, Crc32Val);
  481.    ExtBuf^[ExtPtr] := C;
  482.    Inc(ExtPtr);
  483.    Inc(ExtCount);
  484.    If ExtPtr > BUFSIZE then
  485.       Write_Ext_Block;
  486. end {Put_Ext};
  487.  
  488. { --------------------------------------------------------------------------- }
  489.  
  490. Procedure Close_Zip;
  491. Begin
  492.    {$I-} Close(Zipfile) {$I+};
  493.    If IO_Test then ;
  494. end {Close_Zip};
  495.  
  496. { --------------------------------------------------------------------------- }
  497.  
  498. Procedure Close_Ext;
  499. Type
  500.    TimeDateRec = Record
  501.                     Time : Word;
  502.                     Date : Word;
  503.                  end {record};
  504. Var
  505.    TimeDate      : TimeDateRec;
  506.    TimeDateStamp : LongInt Absolute TimeDate;
  507. Begin
  508.    Write_Ext_Block;
  509.    TimeDate.Time := LocalHdr.Last_Mod_Time;
  510.    TimeDate.Date := LocalHdr.Last_Mod_Date;
  511.    SetFTime(ExtFile, TimeDateStamp);
  512.    {$I-} Close(ExtFile) {$I+};
  513.    If IO_Test then ;
  514.    GotoXY(1, WhereY);
  515.    Write(ExtCount);
  516.    GotoXY(1, WhereY);
  517. end {Close_Ext};
  518.  
  519. { --------------------------------------------------------------------------- }
  520.  
  521. Procedure FSkip(Offset : LongInt);
  522. Var
  523.    Rec : LongInt;
  524. Begin
  525.    If (Offset + ZipPtr) <= ZipCount then
  526.       Inc(ZipPtr, Offset)
  527.    else begin
  528.       Rec := FilePos(ZipFile) + (Offset - (ZipCount - ZipPtr) - 1);
  529.       {$I-} Seek(ZipFile, Rec) {$I+};
  530.       If NOT IO_Test then
  531.          Halt;
  532.       Read_Zip_Block;
  533.    end {if};
  534. end {FSkip};
  535.  
  536. { --------------------------------------------------------------------------- }
  537.  
  538. Procedure FRead(Var Buf; RecLen : Word);
  539. Var
  540.    I  :  Word;
  541.    B  :  Array[1..MaxInt] of Byte Absolute Buf;
  542. Begin
  543.    For I := 1 to RecLen do
  544.       B[I] := Get_Zip;
  545. end {FRead};
  546.  
  547. { --------------------------------------------------------------------------- }
  548.  
  549. Function Read_Local_Hdr : Boolean;
  550. Var
  551.    Sig : LongInt;
  552. Begin
  553.    If EndFile then
  554.       Read_Local_Hdr := FALSE
  555.    else begin
  556.       FRead(Sig, SizeOf(Sig));
  557.       If Sig = CENTRAL_FILE_HEADER_SIGNATURE then begin
  558.          Read_Local_Hdr := FALSE;
  559.          EndFile        := TRUE;
  560.       end {then}
  561.       else begin
  562.          If Sig <> LOCAL_FILE_HEADER_SIGNATURE then
  563.             Abort('Missing or invalid local file header in ' + ZipName);
  564.          FRead(LocalHdr, SizeOf(LocalHdr));
  565.          With LocalHdr do begin
  566.             If FileName_Length > 255 then
  567.                Abort('Filename of compressed file exceeds 255 characters!');
  568.             FRead(Hdr_FileName[1], FileName_Length);
  569.             Hdr_FileName[0] := Chr(FileName_Length);
  570.             If Extra_Field_Length > 255 then
  571.                Abort('Extra field of compressed file exceeds 255 characters!');
  572.             FRead(Hdr_ExtraField[1], Extra_Field_Length);
  573.             Hdr_ExtraField[0] := Chr(Extra_Field_Length);
  574.          end {with};
  575.          Read_Local_Hdr := TRUE;
  576.       end {if};
  577.    end {if};
  578. end {Read_Local_Hdr};
  579.  
  580. { --------------------------------------------------------------------------- }
  581.  
  582. Function Get_Compressed : Integer;
  583. Var
  584.    PctDone : Integer;
  585. Begin
  586.    If Bytes_To_Go = 0 then
  587.       Get_Compressed := -1
  588.    else begin
  589.       Get_Compressed := Get_Zip;
  590.       If Bytes_To_Go mod TenPercent = 0 then begin
  591.          PctDone := 100 - Round( 100 * (Bytes_To_Go / LocalHdr.Compressed_Size));
  592.          GotoXY(WhereX - 4, WhereY);
  593.          Write(PctDone:3, '%');
  594.       end {if};
  595.       Dec(Bytes_To_Go);
  596.    end {if};
  597. end {Get_Compressed};
  598.  
  599. { --------------------------------------------------------------------------- }
  600.  
  601. Function LZW_Init : Boolean;
  602. Var
  603.    RC       :  Word;
  604.    I        :  Word;
  605. Label
  606.    Exit;
  607. Begin
  608.    { Initialize LZW Table }
  609.    RC := Malloc(LZW_Table, SizeOf(LZW_Table^));
  610.    If RC <> 0 then begin
  611.       LZW_Init := FALSE;
  612.       Goto Exit;
  613.    end {if};
  614.    For I := 0 to LZW_TABLE_SIZE do begin
  615.       With LZW_Table^[I] do begin
  616.          Prefix     := -1;
  617.          If I < 256 then
  618.             Suffix  := I
  619.          else
  620.             Suffix  := 0;
  621.          ChildCount := 0;
  622.       end {with};
  623.    end {for};
  624.  
  625.    RC := Malloc(FreeList, SizeOf(FreeList^));
  626.    If RC <> 0 then begin
  627.       LZW_Init := FALSE;
  628.       Goto Exit;
  629.    end {if};
  630.    For I := FIRSTFREE to LZW_TABLE_SIZE do
  631.       FreeList^[I] := I;
  632.    NextFree := FIRSTFREE;
  633.  
  634.    { Initialize the LZW Character Stack }
  635.    RC := Malloc(LZW_Stack, SizeOf(LZW_Stack^));
  636.    If RC <> 0 then begin
  637.       LZW_Init := FALSE;
  638.       Goto Exit;
  639.    end {if};
  640.    StackIdx := 0;
  641.    LZW_Init := TRUE;
  642.  
  643. Exit:
  644. end {LZW_Init};
  645.  
  646. { --------------------------------------------------------------------------- }
  647.  
  648. Procedure LZW_Cleanup;
  649. Var
  650.    Code : Word;
  651. Begin
  652.    Code := Dalloc(LZW_Table);
  653.    Code := Dalloc(FreeList);
  654.    Code := Dalloc(LZW_Stack);
  655. end {LZW_Cleanup};
  656.  
  657. { --------------------------------------------------------------------------- }
  658.  
  659. Procedure Clear_LZW_Table;
  660. Var
  661.    I      :  Word;
  662. Begin
  663.    StackIdx := 0;
  664.  
  665.    For I := FIRSTFREE to LZW_TABLE_SIZE do begin      { Find all leaf nodes }
  666.       If LZW_Table^[I].ChildCount = 0 then begin
  667.          LZW_Stack^[StackIdx] := I;                   { and put each on stack }
  668.          Inc(StackIdx);
  669.       end {if};
  670.    end {for};
  671.  
  672.    NextFree := Succ(LZW_TABLE_SIZE);
  673.  
  674.    While StackIdx > 0 do begin                        { clear all leaf nodes }
  675.       Dec(StackIdx);
  676.       I := LZW_Stack^[StackIdx];
  677.       With LZW_Table^[I] do begin
  678.          If LZW_Table^[I].Prefix <> -1 then
  679.             Dec(LZW_Table^[Prefix].ChildCount);
  680.          Prefix     := -1;
  681.          Suffix     :=  0;
  682.          ChildCount :=  0;
  683.       end {with};
  684.       Dec(NextFree);                         { add cleared nodes to freelist }
  685.       FreeList^[NextFree] := I;
  686.    end {while};
  687.  
  688. End {Clear_LZW_Table};
  689.  
  690. { --------------------------------------------------------------------------- }
  691.  
  692. Procedure Add_To_LZW_Table(Prefix : Integer; Suffix : Byte);
  693. Var
  694.    I  :  Word;
  695. Begin
  696.  
  697.    If NextFree <= LZW_TABLE_SIZE then begin
  698.       I := FreeList^[NextFree];
  699.       Inc(NextFree);
  700.       LZW_Table^[I].Prefix     := Prefix;
  701.       LZW_Table^[I].Suffix     := Suffix;
  702.       Inc(LZW_Table^[Prefix].ChildCount);
  703.    end {if};
  704.  
  705. End {Add_To_LZW_Table};
  706.  
  707. { --------------------------------------------------------------------------- }
  708.  
  709. Function Get_Code(CodeSize : Byte) : Integer;
  710. Const
  711.    Mask       :  Array[1..8] of Byte = ($01, $03, $07, $0F, $1F, $3F, $7F, $FF);
  712.    TmpInt     : Integer = 0;
  713. Var
  714.    BitsNeeded : Byte;
  715.    HowMany    : Byte;
  716.    HoldCode   : Integer;
  717. Label
  718.    Exit;
  719. Begin
  720.    If FirstCh then begin               { If first time through ...         }
  721.       TmpInt := Get_Compressed;        { ... then prime the code buffer    }
  722.       If TmpInt = -1 then begin        { If EOF on fill attempt ...        }
  723.          Get_Code := -1;           { ... then return EOF indicator ... }
  724.          Goto Exit;                    { ... and return to caller.         }
  725.       end {if};
  726.       SaveByte := TmpInt;
  727.       BitsLeft := 8;                   { there's now 8 bits in our buffer  }
  728.       FirstCh  := FALSE;
  729.    end {if};
  730.  
  731.    BitsNeeded := CodeSize;
  732.    HoldCode   := 0;
  733.  
  734.    While (BitsNeeded > 0) And (TmpInt <> -1) do begin
  735.  
  736.       If BitsNeeded >= BitsLeft
  737.          then HowMany := BitsLeft         { HowMany <-- Min(BitsLeft, BitsNeeded) }
  738.          else HowMany := BitsNeeded;
  739.  
  740.       HoldCode := HoldCode OR ((SaveByte AND Mask[HowMany]) SHL (CodeSize - BitsNeeded));
  741.       SaveByte := SaveByte SHR HowMany;
  742.       Dec(BitsNeeded, HowMany);
  743.       Dec(BitsLeft, HowMany);
  744.  
  745.       If BitsLeft <= 0 then begin         { If no bits left in buffer ...     }
  746.          TmpInt := Get_Compressed;        { ... then attempt to get 8 more.   }
  747.          If TmpInt = -1 then
  748.             Goto Exit;
  749.          SaveByte := TmpInt;
  750.          BitsLeft := 8;
  751.       end {if};
  752.  
  753.    end {while};
  754.  
  755. Exit:
  756.  
  757.    If (BitsNeeded = 0) then               { If we got what we came for ... }
  758.       Get_Code := HoldCode            { ... then return it             }
  759.    else
  760.       Get_Code := -1;                 { ... Otherwise, return EOF      }
  761.  
  762. end {Get_Code};
  763.  
  764. { --------------------------------------------------------------------------- }
  765.  
  766. Procedure UnShrink;
  767. Var
  768.    Ch       :  Char;
  769.    CodeSize :  Byte;          { Current size (in bits) of codes coming in  }
  770.    CurrCode :  Integer;
  771.    SaveCode :  Integer;
  772.    PrevCode :  Integer;
  773.    BaseChar :  Byte;
  774. Label
  775.    Exit;
  776. Begin
  777.    CodeSize := MINCODESIZE;               { Start with the smallest code size }
  778.  
  779.    PrevCode := Get_Code(CodeSize);        { Get first code from file          }
  780.    If PrevCode = -1 then                  { If EOF already, then ...          }
  781.       Goto Exit;                          { ... just exit without further ado }
  782.    BaseChar := PrevCode;
  783.    Put_Ext(BaseChar);                      { Unpack the first character        }
  784.  
  785.    CurrCode := Get_Code(CodeSize);        { Get next code to prime the while loop }
  786.  
  787.    While CurrCode <> -1 do begin          { Repeat for all compressed bytes   }
  788.  
  789.       If CurrCode = SPECIAL then begin    { If we've got a "special" code ... }
  790.  
  791.          CurrCode := Get_Code(CodeSize);
  792.          Case CurrCode of
  793.             1  :  Begin                   { ... and if followed by a 1 ...    }
  794.                      Inc(CodeSize);       { ... then increase code size       }
  795.                   end {1};
  796.             2  :  Begin                   { ... and if followed by a 2 ...    }
  797.                      Clear_LZW_Table;     { ... clear leaf nodes in the table }
  798.                   end {2};
  799.             else  begin                   { ... if neither 1 or 2, discard    }
  800.                      Writeln;
  801.                      Writeln('Encountered code 256 not followed by 1 or 2!');
  802.                      Writeln;
  803.                      Write('Press a key to continue ...');
  804.                      Ch := ReadKey;
  805.                      DelLine;
  806.                      GotoXY(1, WhereY);
  807.                   end {else};
  808.          end {case};
  809.  
  810.       end {then}
  811.       else begin                          { Not a "special" code              }
  812.  
  813.          SaveCode := CurrCode;            { Save this code someplace safe...  }
  814.  
  815.          If CurrCode > LZW_TABLE_SIZE then
  816.             Abort('Invalid code encountered!');
  817.  
  818.          If (CurrCode >= FIRSTFREE) and (LZW_Table^[CurrCode].Prefix = -1) then begin
  819.             If StackIdx > LZW_STACK_SIZE then begin
  820.                Write_Ext_Block;
  821.                Writeln;
  822.                Writeln('Stack Overflow (', StackIdx, ')!');
  823.                Halt;
  824.             end {if};
  825.             LZW_Stack^[StackIdx] := BaseChar;
  826.             Inc(StackIdx);
  827.             CurrCode := PrevCode;
  828.          end {if};
  829.  
  830.          While CurrCode >= FIRSTFREE do begin
  831.             If StackIdx > LZW_STACK_SIZE then begin
  832.                Write_Ext_Block;
  833.                Writeln;
  834.                Writeln('Stack Overflow (', StackIdx, ')!');
  835.                Halt;
  836.             end {if};
  837.             LZW_Stack^[StackIdx] := LZW_Table^[CurrCode].Suffix;
  838.             Inc(StackIdx);
  839.             CurrCode := LZW_Table^[CurrCode].Prefix;
  840.          end {while};
  841.  
  842.          BaseChar := LZW_Table^[CurrCode].Suffix;         { Get last character ...   }
  843.          Put_Ext(BaseChar);
  844.  
  845.          While (StackIdx > 0) do begin
  846.             Dec(StackIdx);
  847.             Put_Ext(LZW_Stack^[StackIdx]);
  848.          end {while};                     { ... until there are none left     }
  849.  
  850.          Add_to_LZW_Table(PrevCode, BaseChar);  { Add new entry to table      }
  851.  
  852.          PrevCode := SaveCode;
  853.  
  854.       end {if};
  855.  
  856.       CurrCode := Get_Code(CodeSize);     { Get next code from input stream   }
  857.  
  858.    end {while};
  859. Exit:
  860. end {UnShrink};
  861.  
  862. { --------------------------------------------------------------------------- }
  863.  
  864. Function Init_UnReduce : Boolean;
  865. Var
  866.    Code : Word;
  867. Label
  868.    Exit;
  869. Begin
  870.    Code := Malloc(Followers, SizeOf(Followers^));
  871.    If Code <> 0 then begin
  872.       Init_UnReduce := FALSE;
  873.       Goto Exit;
  874.    end {if};
  875.  
  876.    Code := Malloc(Stream, SizeOf(Stream^));
  877.    If Code <> 0 then begin
  878.       Init_UnReduce := FALSE;
  879.       Goto Exit;
  880.    end {if};
  881.  
  882.    Init_UnReduce := TRUE;
  883.  
  884. Exit:
  885. end {Init_UnReduce};
  886.  
  887. { --------------------------------------------------------------------------- }
  888.  
  889. Procedure Cleanup_UnReduce;
  890. Var
  891.    Code : Word;
  892. Begin
  893.    Code := Dalloc(Followers);
  894.    Code := Dalloc(Stream);
  895. end {Cleanup_UnReduce};
  896.  
  897. { --------------------------------------------------------------------------- }
  898.  
  899. Function D(X, Y : Byte) : Word;
  900. Var
  901.    tmp : LongInt;
  902. Begin
  903.    X := X SHR (8 - Pred(LocalHdr.Compress_Method));
  904.    Tmp := X * 256;
  905.    D := Tmp + Y + 1;
  906. end {D};
  907.  
  908. { --------------------------------------------------------------------------- }
  909.  
  910. Function F(X : Word) : Byte;
  911. Const
  912.    TestVal : Array[1..4] of Byte = (127, 63, 31, 15);
  913. Begin
  914.    If X = TestVal[Pred(LocalHdr.Compress_Method)] then
  915.       F := 2
  916.    else
  917.       F := 3;
  918. end {F};
  919.  
  920. { --------------------------------------------------------------------------- }
  921.  
  922. Function L(X : Byte) : Byte;
  923. Const
  924.    Mask : Array[1..4] of Byte = ($7F, $3F, $1F, $0F);
  925. Begin
  926.    L := X AND Mask[Pred(LocalHdr.Compress_Method)];
  927. end {L};
  928.  
  929. { --------------------------------------------------------------------------- }
  930.  
  931. Procedure StreamOut(C : Byte);
  932. Begin
  933.    Put_Ext(C);
  934.    Stream^[StreamIdx] := C;
  935.    StreamIdx := Succ(StreamIdx) MOD 4096;
  936. end {StreamOut};
  937.  
  938. { --------------------------------------------------------------------------- }
  939.  
  940. Procedure ScrnchInit;
  941. Begin
  942.    State := 0;
  943.    For StreamIdx := 0 to 4095 do
  944.       Stream^[StreamIdx] := 0;
  945.    StreamIdx := 0;
  946. end {ScrnchInit};
  947.  
  948. { --------------------------------------------------------------------------- }
  949.  
  950. Procedure UnScrnch(C : Byte);
  951. Const
  952.    DLE   =  $90;
  953. Var
  954.    S           :  Integer;
  955.    Count       :  Word;
  956.    OneByte     :  Byte;
  957.    Tmp1        :  LongInt;
  958. Begin
  959.    Case State of
  960.       0  :  begin
  961.                If C = DLE then
  962.                   State := 1
  963.                else
  964.                   StreamOut(C);
  965.             end {0};
  966.       1  :  begin
  967.                If C = 0 then begin
  968.                   StreamOut(DLE);
  969.                   State := 0;
  970.                end {then}
  971.                else begin
  972.                   V     := C;
  973.                   Len   := L(V);
  974.                   State := F(Len);
  975.                end {if};
  976.             end {1};
  977.       2  :  begin
  978.                Inc(Len, C);
  979.                State := 3;
  980.             end {2};
  981.       3  :  begin
  982.                Tmp1 := D(V, C);
  983.                S    := StreamIdx - Tmp1;
  984.                If S < 0 then
  985.                   S := S + 4096;
  986.                Count := Len + 3;
  987.                While Count > 0 do begin
  988.                   OneByte := Stream^[S];
  989.                   StreamOut(OneByte);
  990.                   S := Succ(S) MOD 4096;
  991.                   Dec(Count);
  992.                end {while};
  993.                State := 0;
  994.             end {3};
  995.    end {case};
  996.  
  997. end {UnScrnch};
  998.  
  999. { --------------------------------------------------------------------------- }
  1000.  
  1001. Function MinBits(Val : Byte) : Byte;
  1002. Begin
  1003.    Dec(Val);
  1004.    Case Val of
  1005.        0..1  : MinBits := 1;
  1006.        2..3  : MinBits := 2;
  1007.        4..7  : MinBits := 3;
  1008.        8..15 : MinBits := 4;
  1009.       16..31 : MinBits := 5;
  1010.       else     MinBits := 6;
  1011.    end {case};
  1012. end {MinBits};
  1013.  
  1014. { --------------------------------------------------------------------------- }
  1015.  
  1016. Procedure UnReduce;
  1017. Var
  1018.    LastChar    :  Byte;
  1019.    N           :  Byte;
  1020.    I, J        :  Word;
  1021.    Code        :  Integer;
  1022.    Ch          :  Char;
  1023. Begin
  1024.    For I := 255 downto 0 do begin          { Load follower sets }
  1025.       N := Get_Code(6);                { Get size of 1st set }
  1026.       Followers^[I].SetSize := N;
  1027.       If N > 0 then
  1028.          For J := 0 to Pred(N) do
  1029.             Followers^[I].FSet[J] := Get_Code(8);
  1030.    end {for};
  1031.  
  1032.    ScrnchInit;
  1033.  
  1034.    LastChar := 0;
  1035.    Repeat
  1036.  
  1037.       If Followers^[LastChar].SetSize = 0 then begin
  1038.          Code := Get_Code(8);
  1039.          UnScrnch(Code);
  1040.          LastChar := Code;
  1041.       end {then}
  1042.       else begin
  1043.          Code := Get_Code(1);
  1044.          If Code <> 0 then begin
  1045.             Code := Get_Code(8);
  1046.             UnScrnch(Code);
  1047.             LastChar := Code;
  1048.          end {then}
  1049.          else begin
  1050.             I := MinBits(Followers^[LastChar].SetSize);
  1051.             Code := Get_Code(I);
  1052.             UnScrnch(Followers^[LastChar].FSet[Code]);
  1053.             LastChar := Followers^[LastChar].FSet[Code];
  1054.          end {if};
  1055.       end {if};
  1056.    Until (ExtCount = LocalHdr.Uncompressed_Size);
  1057.    Code := Dalloc(Followers);
  1058. end {UnReduce};
  1059.  
  1060. { --------------------------------------------------------------------------- }
  1061.  
  1062. Procedure UnZip;
  1063. Var
  1064.    C  :  Integer;
  1065. Begin
  1066.    Crc32Val    := $FFFFFFFF;
  1067.    Bytes_To_Go := LocalHdr.Compressed_Size;
  1068.    FirstCh     := TRUE;
  1069.  
  1070.    ExtCount    := 0;
  1071.  
  1072.    TenPercent := LocalHdr.Compressed_Size DIV 10;
  1073.  
  1074.    Case LocalHdr.Compress_Method of
  1075.       0     :  Begin
  1076.                   While Bytes_to_go > 0 do
  1077.                      Put_Ext(Get_Compressed);
  1078.                end {0 = Stored};
  1079.       1     :  Begin
  1080.                   If LZW_Init then
  1081.                      UnShrink
  1082.                   else begin
  1083.                      Writeln('Not enough memory available to unshrink!');
  1084.                      Writeln('Skipping ', Hdr_FileName, ' ...');
  1085.                      FSkip(LocalHdr.Compressed_Size);
  1086.                      Crc32Val := NOT LocalHdr.Crc32;
  1087.                   end {if};
  1088.                   LZW_Cleanup;
  1089.                end {1 = shrunk};
  1090.       2..5  :  Begin
  1091.                   If Init_UnReduce then
  1092.                      UnReduce
  1093.                   else begin
  1094.                      Writeln('Not enough memory available to unreduce!');
  1095.                      Writeln('Skipping ', Hdr_FileName, ' ...');
  1096.                      FSkip(LocalHdr.Compressed_Size);
  1097.                      Crc32Val := NOT LocalHdr.Crc32;
  1098.                   end {if};
  1099.                   Cleanup_UnReduce;
  1100.                end {2..5};
  1101.       else     Begin
  1102.                   Writeln('Unknown compression method used on ', Hdr_FileName);
  1103.                   Writeln('Skipping ', Hdr_FileName, ' ...');
  1104.                   FSkip(LocalHdr.Compressed_Size);
  1105.                   Crc32Val := NOT LocalHdr.Crc32;
  1106.                end {else};
  1107.    end {case};
  1108.  
  1109.    Crc32Val := NOT Crc32Val;
  1110.    If Crc32Val <> LocalHdr.Crc32 then begin
  1111.       Writeln;
  1112.       Writeln('WARNING: File ', OutPath + Hdr_FileName, ' fails CRC check!');
  1113.       Writeln('   Stored CRC = ', HexLInt(LocalHdr.Crc32),
  1114.               '   Calculated CRC = ', HexLInt(Crc32Val));
  1115.    end {if};
  1116.  
  1117. end {UnZip};
  1118.  
  1119. { --------------------------------------------------------------------------- }
  1120.  
  1121. Procedure Extract_File;
  1122. Var
  1123.    YesNo  : Char;
  1124.    DosDTA : SearchRec;
  1125. Label
  1126.    Exit;
  1127. Begin
  1128.    FindFirst(OutPath + Hdr_FileName, ANYFILE, DosDTA);
  1129.    If DosError = 0 then begin
  1130.       Write('WARNING: ', OutPath + Hdr_FileName, ' already exists.  Overwrite (Y/N)? ');
  1131.       YesNo := ReadKey;
  1132.       Writeln(YesNo);
  1133.       If UpCase(YesNo) <> 'Y' then begin
  1134.          FSkip(LocalHdr.Compressed_Size);
  1135.          Goto Exit;
  1136.       end {if};
  1137.    end {if};
  1138.  
  1139.    If Open_Ext then begin
  1140.       Write('Extracting: ', OutPath + Hdr_FileName, ' ...    ');
  1141.       UnZip;
  1142.       GotoXY(WhereX - 4, WhereY);
  1143.       ClrEol;
  1144.       Writeln(' done');
  1145.       Close_Ext;
  1146.    end {then}
  1147.    else begin
  1148.       Writeln('Could not open output file ', OutPath + Hdr_FileName, '!  Skipping to next file ...');
  1149.       FSkip(LocalHdr.Compressed_Size);
  1150.    end {If};
  1151. Exit:
  1152. end {Extract_File};
  1153.  
  1154. { --------------------------------------------------------------------------- }
  1155.  
  1156. Procedure Extract_Zip;
  1157. Var
  1158.    Match : Boolean;
  1159.    I     : Word;
  1160. Begin
  1161.    Open_Zip;
  1162.    While Read_Local_Hdr do begin
  1163.       Match := FALSE;
  1164.       I := 1;
  1165.       Repeat
  1166.          If SameFile(InFileSpecs[I], Hdr_FileName) then
  1167.             Match := TRUE;
  1168.          Inc(I);
  1169.       Until Match or (I > MaxSpecs);
  1170.       If Match then
  1171.          Extract_File
  1172.       else
  1173.          FSkip(LocalHdr.Compressed_Size);
  1174.    end {while};
  1175.    Close_Zip;
  1176.    GotoXY(1, WhereY);
  1177.    ClrEOL;
  1178. end;
  1179.  
  1180. { --------------------------------------------------------------------------- }
  1181.  
  1182. Begin
  1183.    Assign(Output, '');
  1184.    Rewrite(Output);
  1185.    Writeln;
  1186.    Writeln(COPYRIGHT);
  1187.    Writeln(VERSION);
  1188.    Writeln;
  1189.    Load_Parms;   { get command line parameters }
  1190.    Initialize;   { one-time initialization }
  1191.    Extract_Zip;  { de-arc the file }
  1192. end.
  1193.