|
|
@@ -1,3357 +0,0 @@
|
|
|
-{
|
|
|
- $Id$
|
|
|
-}
|
|
|
-UNIT Unzip;
|
|
|
-{
|
|
|
-Unzips deflated, imploded, shrunk and stored files
|
|
|
- ** COMPATIBLE WITH
|
|
|
- * Turbo Pascal v7.x (DOS)
|
|
|
- * Borland Pascal v7.x (Dos, DPMI, and Windows)
|
|
|
- * Delphi v1.x
|
|
|
- * Delphi v2.x
|
|
|
- * Delphi v3.x
|
|
|
- * Virtual Pascal v2.0 (OS/2, Win32)
|
|
|
- * Free Pascal Compiler (DOS, OS/2, Win32, Linux)
|
|
|
-}
|
|
|
-
|
|
|
-{
|
|
|
- Original version (1.x): Christian Ghisler
|
|
|
- C code by info-zip group, translated to pascal by Christian Ghisler
|
|
|
- based on unz51g.zip;
|
|
|
- Special thanks go to Mark Adler,who wrote the main inflate and
|
|
|
- explode code, and did NOT copyright it!!!
|
|
|
-
|
|
|
- v2.00: March 1998: Dr Abimbola Olowofoyeku (The African Chief)
|
|
|
- Homepage: http://ourworld.compuserve.com/homepages/African_Chief
|
|
|
- * modified to compile for Delphi v2.x and Delphi v3.x
|
|
|
-
|
|
|
- v2.01: April 1998: Dr Abimbola Olowofoyeku (The African Chief)
|
|
|
- * source files merged into a single source (this) file
|
|
|
- * several high level functions added - i.e.,
|
|
|
- FileUnzip()
|
|
|
- FileUnzipEx()
|
|
|
- ViewZip()
|
|
|
- UnzipSize()
|
|
|
- SetUnzipReportProc()
|
|
|
- SetUnzipQuestionProc()
|
|
|
- ChfUnzip_Init()
|
|
|
- * callbacks added
|
|
|
- * modified to support Virtual Pascal v2.0 (Win32)
|
|
|
- * Delphi component added (chfunzip.pas)
|
|
|
- v2.01a: December 1998: Tomas Hajny, [email protected]
|
|
|
- * extended to support other 32-bit compilers/platforms (OS/2, GO32, ...);
|
|
|
- search for (* TH ... *)
|
|
|
- v2.01b: December 1998: Peter Vreman
|
|
|
- * modifications needed for Linux
|
|
|
-}
|
|
|
-
|
|
|
-INTERFACE
|
|
|
-
|
|
|
-{$IFDEF FPC}
|
|
|
- {$DEFINE BIT32}
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-{$IFDEF OS2}
|
|
|
- {$DEFINE BIT32}
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-{$IFDEF WIN32}
|
|
|
- {$DEFINE BIT32}
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-{$IFNDEF FPC}
|
|
|
- {$F+}
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-{$R-} {No range checking}
|
|
|
-
|
|
|
-USES
|
|
|
-{$ifdef windows}
|
|
|
-wintypes,
|
|
|
-winprocs,
|
|
|
-{$ifdef Delphi}
|
|
|
-Messages,
|
|
|
-Sysutils,
|
|
|
-{$else Delphi}
|
|
|
-strings,
|
|
|
-windos,
|
|
|
-{$endif Delphi}
|
|
|
-{$else Windows}
|
|
|
-strings,
|
|
|
-crt,
|
|
|
-dos,
|
|
|
-{$endif Windows}
|
|
|
-ziptypes;
|
|
|
-
|
|
|
-{**********************************************************************}
|
|
|
-{**********************************************************************}
|
|
|
-{****** HIGH LEVEL FUNCTIONS: BY THE AFRICAN CHIEF ********************}
|
|
|
-{**********************************************************************}
|
|
|
-{**********************************************************************}
|
|
|
-FUNCTION FileUnzip
|
|
|
-( SourceZipFile, TargetDirectory, FileSpecs : pChar;
|
|
|
- Report : UnzipReportProc;Question : UnzipQuestionProc ) : integer;
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-
|
|
|
-{
|
|
|
-high level unzip
|
|
|
-usage:
|
|
|
-SourceZipFile: source zip file;
|
|
|
-TargetDirectory: target directory
|
|
|
-FileSpecs: "*.*", etc.
|
|
|
-Report: Report callback or Nil;
|
|
|
-Question: Question callback (for confirmation of whether to replace existing
|
|
|
- files) or Nil;
|
|
|
-
|
|
|
-* REFER to ZIPTYPES.PAS for information on callback functions
|
|
|
-
|
|
|
-e.g.,
|
|
|
- Count := FileUnzip('test.zip', 'c:\temp', '*.*', MyReportProc, Nil);
|
|
|
-
|
|
|
-}
|
|
|
-
|
|
|
-FUNCTION FileUnzipEx ( SourceZipFile, TargetDirectory, FileSpecs : pChar ) : integer;
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-{
|
|
|
-high level unzip with no callback parameters;
|
|
|
-passes ZipReport & ZipQuestion internally, so you
|
|
|
-can use SetZipReportProc and SetZipQuestionProc before calling this;
|
|
|
-
|
|
|
-e.g.,
|
|
|
- Count := FileUnzipEx('test.zip', 'c:\temp', '*.*');
|
|
|
-}
|
|
|
-
|
|
|
-FUNCTION ViewZip ( SourceZipFile, FileSpecs : pChar; Report : UnzipReportProc ) : integer;
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-{
|
|
|
-view contents of zip file
|
|
|
-usage:
|
|
|
-SourceZipFile: source zip file;
|
|
|
-FileSpecs: "*.*", etc.
|
|
|
-Report: callback procedure to process the reported contents of ZIP file;
|
|
|
-
|
|
|
-* REFER to ZIPTYPES.PAS for information on callback functions
|
|
|
-
|
|
|
-e.g.,
|
|
|
- ViewZip('test.zip', '*.*', MyReportProc);
|
|
|
-}
|
|
|
-
|
|
|
-FUNCTION SetUnZipReportProc ( aProc : UnzipReportProc ) : Pointer;
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-{
|
|
|
-sets the internal unzip report procedure to aproc
|
|
|
-Returns: pointer to the original report procedure
|
|
|
-(return value should normally be ignored)
|
|
|
-
|
|
|
-e.g.,
|
|
|
- SetUnZipReportProc(MyReportProc);
|
|
|
-}
|
|
|
-
|
|
|
-FUNCTION SetUnZipQuestionProc ( aProc : UnzipQuestionProc ) : Pointer;
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-{
|
|
|
-sets the internal unzip question procedure to aproc
|
|
|
-Returns: pointer to the original "question" procedure
|
|
|
-(return value should normally be ignored)
|
|
|
-
|
|
|
-e.g.,
|
|
|
-SetUnZipQuestionProc(QueryFileExistProc);
|
|
|
-}
|
|
|
-
|
|
|
-FUNCTION UnzipSize ( SourceZipFile : pChar;VAR Compressed : Longint ) : longint;
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-{ uncompressed and compressed zip size
|
|
|
- usage:
|
|
|
- SourceZipFile = the zip file
|
|
|
- Compressed = the compressed size of the files in the archive
|
|
|
- Returns: the uncompressed size of the ZIP archive
|
|
|
-
|
|
|
-e.g.,
|
|
|
- Var
|
|
|
- Size,CSize:longint;
|
|
|
- begin
|
|
|
- Size := UnzipSize('test.zip', CSize);
|
|
|
- end;
|
|
|
-}
|
|
|
-
|
|
|
-PROCEDURE ChfUnzip_Init;
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-{
|
|
|
-initialise or reinitialise the shared data: !!! use with care !!!
|
|
|
-}
|
|
|
-
|
|
|
-FUNCTION SetNoRecurseDirs ( DontRecurse : Boolean ) : Boolean;
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-{
|
|
|
-determine whether the UNZIP function should recreate
|
|
|
-the subdirectory structure;
|
|
|
- DontRecurse = TRUE : don't recurse
|
|
|
- DontRecurse = FALSE : recurse (default)
|
|
|
-}
|
|
|
-
|
|
|
-{**********************************************************************}
|
|
|
-{**********************************************************************}
|
|
|
-{************ LOW LEVEL FUNCTIONS: BY CHRISTIAN GHISLER ***************}
|
|
|
-{**********************************************************************}
|
|
|
-{**********************************************************************}
|
|
|
-FUNCTION GetSupportedMethods : longint;
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-{Checks which pack methods are supported by the dll}
|
|
|
-{bit 8=1 -> Format 8 supported, etc.}
|
|
|
-
|
|
|
-FUNCTION UnzipFile ( in_name : pchar;out_name : pchar;offset : longint;hFileAction : word;cm_index : integer ) : integer;
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-{usage:
|
|
|
- in_name: name of zip file with full path
|
|
|
- out_name: desired name for out file
|
|
|
- offset: header position of desired file in zipfile
|
|
|
- hFileAction: handle to dialog box showing advance of decompression (optional)
|
|
|
- cm_index: notification code sent in a wm_command message to the dialog
|
|
|
- to update percent-bar
|
|
|
- Return value: one of the above unzip_xxx codes
|
|
|
-
|
|
|
- Example for handling the cm_index message in a progress dialog:
|
|
|
-
|
|
|
- unzipfile(......,cm_showpercent);
|
|
|
-
|
|
|
- ...
|
|
|
-
|
|
|
- procedure TFileActionDialog.wmcommand(var msg:tmessage);
|
|
|
- var ppercent:^word;
|
|
|
- begin
|
|
|
- TDialog.WMCommand(msg);
|
|
|
- if msg.wparam=cm_showpercent then begin
|
|
|
- ppercent:=pointer(lparam);
|
|
|
- if ppercent<>nil then begin
|
|
|
- if (ppercent^>=0) and (ppercent^<=100) then
|
|
|
- SetProgressBar(ppercent^);
|
|
|
- if UserPressedAbort then
|
|
|
- ppercent^:=$ffff
|
|
|
- else
|
|
|
- ppercent^:=0;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-}
|
|
|
-
|
|
|
-FUNCTION GetFirstInZip ( zipfilename : pchar;VAR zprec : tZipRec ) : integer;
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-{
|
|
|
- Get first entry from ZIP file
|
|
|
- e.g.,
|
|
|
- rc:=GetFirstInZip('test.zip', myZipRec);
|
|
|
-}
|
|
|
-
|
|
|
-FUNCTION GetNextInZip ( VAR Zprec : tZiprec ) : integer;
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-{
|
|
|
- Get next entry from ZIP file
|
|
|
-
|
|
|
- e.g.,
|
|
|
- rc:=GetNextInZip(myZipRec);
|
|
|
-}
|
|
|
-
|
|
|
-FUNCTION IsZip ( filename : pchar ) : boolean;
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-{
|
|
|
- VERY simple test for zip file
|
|
|
-
|
|
|
- e.g.,
|
|
|
- ItsaZipFile := IsZip('test.zip');
|
|
|
-}
|
|
|
-
|
|
|
-PROCEDURE CloseZipFile ( VAR Zprec : tZiprec ); {Only free buffer, file only open in Getfirstinzip}
|
|
|
-{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows}
|
|
|
-{$ifdef DPMI} EXPORT; {$endif DPMI}
|
|
|
-{
|
|
|
- free ZIP buffers
|
|
|
-
|
|
|
- e.g.,
|
|
|
- CloseZipFile(myZipRec);
|
|
|
-}
|
|
|
-
|
|
|
-IMPLEMENTATION
|
|
|
-
|
|
|
-VAR
|
|
|
-ZipReport : UnzipReportProc; {Global Status Report Callback}
|
|
|
-ZipQuestion : UnzipQuestionProc; {Global "Question" Callback}
|
|
|
-ZipRec : TReportRec; {Global ZIP record for callbacks}
|
|
|
-NoRecurseDirs : Boolean; {Global Recurse variable}
|
|
|
-
|
|
|
-{*************************************************************************}
|
|
|
-{$ifdef Delphi}
|
|
|
-PROCEDURE SetCurDir ( p : pChar );
|
|
|
-BEGIN
|
|
|
- Chdir ( strpas ( p ) );
|
|
|
-END;
|
|
|
-
|
|
|
-FUNCTION DosError : integer; {Delphi DosError kludge}
|
|
|
-BEGIN
|
|
|
- Result := Ioresult;
|
|
|
-END;
|
|
|
-
|
|
|
-FUNCTION SetFTime ( VAR f : File; CONST l : longint ) : integer;
|
|
|
-BEGIN
|
|
|
- {$ifdef Win32}Result := {$endif}FileSetDate ( TFileRec ( f ) .Handle, l );
|
|
|
-END;
|
|
|
-
|
|
|
-PROCEDURE CreateDir ( p : pchar );
|
|
|
-BEGIN
|
|
|
- mkdir ( strpas ( p ) );
|
|
|
-END;
|
|
|
-
|
|
|
-{/////////////////////////////////////////////////////////}
|
|
|
-{$endif Delphi}
|
|
|
-
|
|
|
-{.$I z_global.pas} {global constants, types and variables}
|
|
|
-{Include file for unzip.pas: global constants, types and variables}
|
|
|
-
|
|
|
-{C code by info-zip group, translated to pascal by Christian Ghisler}
|
|
|
-{based on unz51g.zip}
|
|
|
-
|
|
|
-CONST {Error codes returned by huft_build}
|
|
|
- huft_complete = 0; {Complete tree}
|
|
|
- huft_incomplete = 1; {Incomplete tree <- sufficient in some cases!}
|
|
|
- huft_error = 2; {bad tree constructed}
|
|
|
- huft_outofmem = 3; {not enough memory}
|
|
|
-(* TH - use of the new BIT32 conditional (was WIN32 only previously) *)
|
|
|
- MaxMax = {$ifdef BIT32}256 * 1024 {BIT32 = 256kb buffer}
|
|
|
- {$else}Maxint -1{$endif}; {16-bit = 32kb buffer}
|
|
|
-
|
|
|
-CONST wsize = $8000; {Size of sliding dictionary}
|
|
|
- INBUFSIZ = 1024 * 4; {Size of input buffer}
|
|
|
-
|
|
|
-CONST lbits : integer = 9;
|
|
|
- dbits : integer = 6;
|
|
|
-
|
|
|
-CONST b_max = 16;
|
|
|
- n_max = 288;
|
|
|
- BMAX = 16;
|
|
|
-
|
|
|
-TYPE push = ^ush;
|
|
|
- ush = word;
|
|
|
- pbyte = ^byte;
|
|
|
- pushlist = ^ushlist;
|
|
|
- ushlist = ARRAY [ 0..maxmax ] of ush; {only pseudo-size!!}
|
|
|
- pword = ^word;
|
|
|
- pwordarr = ^twordarr;
|
|
|
- twordarr = ARRAY [ 0..maxmax ] of word;
|
|
|
- iobuf = ARRAY [ 0..inbufsiz -1 ] of byte;
|
|
|
-
|
|
|
-TYPE pphuft = ^phuft;
|
|
|
- phuft = ^huft;
|
|
|
- phuftlist = ^huftlist;
|
|
|
- huft = PACKED RECORD
|
|
|
- e, {# of extra bits}
|
|
|
- b : byte; {# of bits in code}
|
|
|
- v_n : ush;
|
|
|
- v_t : phuftlist; {Linked List}
|
|
|
- END;
|
|
|
- huftlist = ARRAY [ 0..8190 ] of huft;
|
|
|
-
|
|
|
-TYPE li = PACKED RECORD
|
|
|
- lo, hi : word;
|
|
|
- END;
|
|
|
-
|
|
|
-{pkzip header in front of every file in archive}
|
|
|
-TYPE
|
|
|
- plocalheader = ^tlocalheader;
|
|
|
- tlocalheader = PACKED RECORD
|
|
|
- signature : ARRAY [ 0..3 ] of char; {'PK'#1#2}
|
|
|
- extract_ver,
|
|
|
- bit_flag,
|
|
|
- zip_type : word;
|
|
|
- file_timedate : longint;
|
|
|
- crc_32,
|
|
|
- compress_size,
|
|
|
- uncompress_size : longint;
|
|
|
- filename_len,
|
|
|
- extra_field_len : word;
|
|
|
- END;
|
|
|
-
|
|
|
-VAR slide : pchar; {Sliding dictionary for unzipping}
|
|
|
- inbuf : iobuf; {input buffer}
|
|
|
- inpos, readpos : integer; {position in input buffer, position read from file}
|
|
|
-{$ifdef windows}
|
|
|
- dlghandle : word; {optional: handle of a cancel and "%-done"-dialog}
|
|
|
-{$endif}
|
|
|
- dlgnotify : integer; {notification code to tell dialog how far the decompression is}
|
|
|
-
|
|
|
-VAR w : longint; {Current Position in slide}
|
|
|
- b : longint; {Bit Buffer}
|
|
|
- k : byte; {Bits in bit buffer}
|
|
|
- infile, {handle to zipfile}
|
|
|
- outfile : file; {handle to extracted file}
|
|
|
- compsize, {comressed size of file}
|
|
|
- reachedsize, {number of bytes read from zipfile}
|
|
|
- uncompsize : longint; {uncompressed size of file}
|
|
|
- crc32val : longint; {crc calculated from data}
|
|
|
- hufttype : word; {coding type=bit_flag from header}
|
|
|
- totalabort, {User pressed abort button, set in showpercent!}
|
|
|
- zipeof : boolean; {read over end of zip section for this file}
|
|
|
- inuse : boolean; {is unit already in use -> don't call it again!!!}
|
|
|
-{$ifdef windows}
|
|
|
- oldpercent : integer; {last percent value shown}
|
|
|
- lastusedtime : longint; {Time of last usage in timer ticks for timeout!}
|
|
|
-{$endif}
|
|
|
-
|
|
|
-(***************************************************************************)
|
|
|
-{.$I z_tables.pas} {Tables for bit masking, huffman codes and CRC checking}
|
|
|
-
|
|
|
-{include file for unzip.pas: Tables for bit masking, huffman codes and CRC checking}
|
|
|
-
|
|
|
-{C code by info-zip group, translated to Pascal by Christian Ghisler}
|
|
|
-{based on unz51g.zip}
|
|
|
-
|
|
|
-{b and mask_bits[i] gets lower i bits out of i}
|
|
|
-CONST mask_bits : ARRAY [ 0..16 ] of word =
|
|
|
- ( $0000,
|
|
|
- $0001, $0003, $0007, $000f, $001f, $003f, $007f, $00ff,
|
|
|
- $01ff, $03ff, $07ff, $0fff, $1fff, $3fff, $7fff, $ffff );
|
|
|
-
|
|
|
-{ Tables for deflate from PKZIP's appnote.txt. }
|
|
|
-
|
|
|
-CONST border : ARRAY [ 0..18 ] of byte = { Order of the bit length code lengths }
|
|
|
- ( 16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15 );
|
|
|
-CONST cplens : ARRAY [ 0..30 ] of word = { Copy lengths for literal codes 257..285 }
|
|
|
- ( 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31,
|
|
|
- 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0 );
|
|
|
- { note: see note #13 above about the 258 in this list.}
|
|
|
-CONST cplext : ARRAY [ 0..30 ] of word = { Extra bits for literal codes 257..285 }
|
|
|
- ( 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2,
|
|
|
- 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0, 99, 99 ); { 99==invalid }
|
|
|
-CONST cpdist : ARRAY [ 0..29 ] of word = { Copy offsets for distance codes 0..29 }
|
|
|
- ( 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193,
|
|
|
- 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145,
|
|
|
- 8193, 12289, 16385, 24577 );
|
|
|
-CONST cpdext : ARRAY [ 0..29 ] of word = { Extra bits for distance codes }
|
|
|
- ( 0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6,
|
|
|
- 7, 7, 8, 8, 9, 9, 10, 10, 11, 11,
|
|
|
- 12, 12, 13, 13 );
|
|
|
-
|
|
|
-{ Tables for explode }
|
|
|
-
|
|
|
-CONST cplen2 : ARRAY [ 0..63 ] of word = ( 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,
|
|
|
- 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34,
|
|
|
- 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51,
|
|
|
- 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65 );
|
|
|
-CONST cplen3 : ARRAY [ 0..63 ] of word = ( 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18,
|
|
|
- 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35,
|
|
|
- 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52,
|
|
|
- 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66 );
|
|
|
-CONST extra : ARRAY [ 0..63 ] of word = ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
|
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
|
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
|
- 8 );
|
|
|
-CONST cpdist4 : ARRAY [ 0..63 ] of word = ( 1, 65, 129, 193, 257, 321, 385, 449, 513, 577, 641, 705,
|
|
|
- 769, 833, 897, 961, 1025, 1089, 1153, 1217, 1281, 1345, 1409, 1473,
|
|
|
- 1537, 1601, 1665, 1729, 1793, 1857, 1921, 1985, 2049, 2113, 2177,
|
|
|
- 2241, 2305, 2369, 2433, 2497, 2561, 2625, 2689, 2753, 2817, 2881,
|
|
|
- 2945, 3009, 3073, 3137, 3201, 3265, 3329, 3393, 3457, 3521, 3585,
|
|
|
- 3649, 3713, 3777, 3841, 3905, 3969, 4033 );
|
|
|
-CONST cpdist8 : ARRAY [ 0..63 ] of word = ( 1, 129, 257, 385, 513, 641, 769, 897, 1025, 1153, 1281,
|
|
|
- 1409, 1537, 1665, 1793, 1921, 2049, 2177, 2305, 2433, 2561, 2689,
|
|
|
- 2817, 2945, 3073, 3201, 3329, 3457, 3585, 3713, 3841, 3969, 4097,
|
|
|
- 4225, 4353, 4481, 4609, 4737, 4865, 4993, 5121, 5249, 5377, 5505,
|
|
|
- 5633, 5761, 5889, 6017, 6145, 6273, 6401, 6529, 6657, 6785, 6913,
|
|
|
- 7041, 7169, 7297, 7425, 7553, 7681, 7809, 7937, 8065 );
|
|
|
-
|
|
|
-{************************************ CRC-Calculation ************************************}
|
|
|
-
|
|
|
-CONST crc_32_tab : ARRAY [ 0..255 ] of longint =
|
|
|
-(
|
|
|
- $00000000, $77073096, $ee0e612c, $990951ba, $076dc419,
|
|
|
- $706af48f, $e963a535, $9e6495a3, $0edb8832, $79dcb8a4,
|
|
|
- $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07,
|
|
|
- $90bf1d91, $1db71064, $6ab020f2, $f3b97148, $84be41de,
|
|
|
- $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7, $136c9856,
|
|
|
- $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9,
|
|
|
- $fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4,
|
|
|
- $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
|
|
|
- $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3,
|
|
|
- $45df5c75, $dcd60dcf, $abd13d59, $26d930ac, $51de003a,
|
|
|
- $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599,
|
|
|
- $b8bda50f, $2802b89e, $5f058808, $c60cd9b2, $b10be924,
|
|
|
- $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190,
|
|
|
- $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f,
|
|
|
- $9fbfe4a5, $e8b8d433, $7807c9a2, $0f00f934, $9609a88e,
|
|
|
- $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
|
|
|
- $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed,
|
|
|
- $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950,
|
|
|
- $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3,
|
|
|
- $fbd44c65, $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2,
|
|
|
- $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb, $4369e96a,
|
|
|
- $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5,
|
|
|
- $aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa, $be0b1010,
|
|
|
- $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
|
|
|
- $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17,
|
|
|
- $2eb40d81, $b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6,
|
|
|
- $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615,
|
|
|
- $73dc1683, $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8,
|
|
|
- $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1, $f00f9344,
|
|
|
- $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb,
|
|
|
- $196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a,
|
|
|
- $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
|
|
|
- $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1,
|
|
|
- $a6bc5767, $3fb506dd, $48b2364b, $d80d2bda, $af0a1b4c,
|
|
|
- $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef,
|
|
|
- $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236,
|
|
|
- $cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe,
|
|
|
- $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31,
|
|
|
- $2cd99e8b, $5bdeae1d, $9b64c2b0, $ec63f226, $756aa39c,
|
|
|
- $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
|
|
|
- $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b,
|
|
|
- $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242,
|
|
|
- $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1,
|
|
|
- $18b74777, $88085ae6, $ff0f6a70, $66063bca, $11010b5c,
|
|
|
- $8f659eff, $f862ae69, $616bffd3, $166ccf45, $a00ae278,
|
|
|
- $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7,
|
|
|
- $4969474d, $3e6e77db, $aed16a4a, $d9d65adc, $40df0b66,
|
|
|
- $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
|
|
|
- $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605,
|
|
|
- $cdd70693, $54de5729, $23d967bf, $b3667a2e, $c4614ab8,
|
|
|
- $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b,
|
|
|
- $2d02ef8d ); { end crc_32_tab[] }
|
|
|
-(***************************************************************************)
|
|
|
-{.$I z_generl.pas} {General functions used by both inflate and explode}
|
|
|
-{include for unzip.pas: General functions used by both inflate and explode}
|
|
|
-
|
|
|
-{C code by info-zip group, translated to Pascal by Christian Ghisler}
|
|
|
-{based on unz51g.zip}
|
|
|
-
|
|
|
-{*********************************** CRC Checking ********************************}
|
|
|
-
|
|
|
-PROCEDURE UpdateCRC ( VAR s : iobuf;len : word );
|
|
|
-VAR i : word;
|
|
|
-BEGIN
|
|
|
-{$ifndef assembler}
|
|
|
- FOR i := 0 TO Pred ( len ) DO BEGIN
|
|
|
- { update running CRC calculation with contents of a buffer }
|
|
|
- crc32val := crc_32_tab [ ( byte ( crc32val ) XOR s [ i ] ) AND $ff ] XOR ( crc32val SHR 8 );
|
|
|
- END;
|
|
|
-{$else}
|
|
|
- ASM
|
|
|
- les di, s
|
|
|
- mov ax, li.lo ( crc32val )
|
|
|
- mov dx, li.hi ( crc32val )
|
|
|
- mov si, offset crc_32_tab {Segment remains DS!!!}
|
|
|
- mov cx, len
|
|
|
- OR cx, cx
|
|
|
- jz @finished
|
|
|
-@again :
|
|
|
- mov bl, al {byte(crcval)}
|
|
|
- mov al, ah {shift DX:AX by 8 bits to the right}
|
|
|
- mov ah, dl
|
|
|
- mov dl, dh
|
|
|
- XOR dh, dh
|
|
|
-
|
|
|
- XOR bh, bh
|
|
|
- XOR bl, es : [ di ] {xor s^}
|
|
|
- inc di
|
|
|
- SHL bx, 1 {Offset: Index*4}
|
|
|
- SHL bx, 1
|
|
|
- XOR ax, [ si + bx ]
|
|
|
- XOR dx, [ si + bx + 2 ]
|
|
|
- dec cx
|
|
|
- jnz @again
|
|
|
-@finished :
|
|
|
- mov li.lo ( crc32val ), ax
|
|
|
- mov li.hi ( crc32val ), dx
|
|
|
- END;
|
|
|
-{$endif}
|
|
|
-END;
|
|
|
-
|
|
|
-{************************ keep other programs running ***************************}
|
|
|
-
|
|
|
-PROCEDURE messageloop;
|
|
|
-{$ifdef windows}
|
|
|
-VAR msg : tmsg;
|
|
|
-BEGIN
|
|
|
- lastusedtime := gettickcount;
|
|
|
- WHILE PeekMessage ( Msg, 0, 0, 0, PM_Remove ) DO
|
|
|
- IF ( dlghandle = 0 ) OR NOT IsDialogMessage ( dlghandle, msg ) THEN BEGIN
|
|
|
- TranslateMessage ( Msg );
|
|
|
- DispatchMessage ( Msg );
|
|
|
- END;
|
|
|
-END;
|
|
|
-{$else}
|
|
|
-VAR ch : word;
|
|
|
-BEGIN
|
|
|
- IF keypressed THEN BEGIN
|
|
|
- ch := byte ( readkey );
|
|
|
- IF ch = 0 THEN ch := 256 + byte ( readkey ); {Extended code}
|
|
|
- IF ch = dlgnotify THEN totalabort := TRUE;
|
|
|
- END
|
|
|
-END;
|
|
|
-{$endif}
|
|
|
-
|
|
|
-{************************* tell dialog to show % ******************************}
|
|
|
-{$ifdef windows}
|
|
|
-PROCEDURE showpercent; {use this with the low level functions only !!!}
|
|
|
-VAR percent : word;
|
|
|
-BEGIN
|
|
|
- IF compsize <> 0 THEN BEGIN
|
|
|
- percent := reachedsize * 100 DIV compsize;
|
|
|
- IF percent > 100 THEN percent := 100;
|
|
|
- IF ( percent <> oldpercent ) THEN BEGIN
|
|
|
- oldpercent := percent;
|
|
|
- IF dlghandle <> 0 THEN BEGIN {Use dialog box for aborting}
|
|
|
- {Sendmessage returns directly -> ppercent contains result}
|
|
|
- sendmessage ( dlghandle, wm_command, dlgnotify, longint ( @percent ) );
|
|
|
- totalabort := ( percent = $FFFF ); {Abort pressed!}
|
|
|
- END ELSE
|
|
|
- IF dlgnotify <> 0 THEN
|
|
|
- totalabort := getasynckeystate ( dlgnotify ) < 0; {break Key pressed!}
|
|
|
- END;
|
|
|
- END;
|
|
|
-END;
|
|
|
-{$endif}
|
|
|
-
|
|
|
-{************************** fill inbuf from infile *********************}
|
|
|
-
|
|
|
-PROCEDURE readbuf;
|
|
|
-BEGIN
|
|
|
- IF reachedsize > compsize + 2 THEN BEGIN {+2: last code is smaller than requested!}
|
|
|
- readpos := sizeof ( inbuf ); {Simulates reading -> no blocking}
|
|
|
- zipeof := TRUE
|
|
|
- END ELSE BEGIN
|
|
|
- messageloop; {Other programs, or in DOS: keypressed?}
|
|
|
- {$ifdef windows}
|
|
|
- showpercent; {Before, because it shows the data processed, not read!}
|
|
|
- {$endif}
|
|
|
- {$I-}
|
|
|
- blockread ( infile, inbuf, sizeof ( inbuf ), readpos );
|
|
|
- {$I+}
|
|
|
- IF ( ioresult <> 0 ) OR ( readpos = 0 ) THEN BEGIN {readpos=0: kein Fehler gemeldet!!!}
|
|
|
- readpos := sizeof ( inbuf ); {Simulates reading -> CRC error}
|
|
|
- zipeof := TRUE;
|
|
|
- END;
|
|
|
- inc ( reachedsize, readpos );
|
|
|
- dec ( readpos ); {Reason: index of inbuf starts at 0}
|
|
|
- END;
|
|
|
- inpos := 0;
|
|
|
-END;
|
|
|
-
|
|
|
-{**** read byte, only used by explode ****}
|
|
|
-
|
|
|
-PROCEDURE READBYTE ( VAR bt : byte );
|
|
|
-BEGIN
|
|
|
- IF inpos > readpos THEN readbuf;
|
|
|
- bt := inbuf [ inpos ];
|
|
|
- inc ( inpos );
|
|
|
-END;
|
|
|
-
|
|
|
-{*********** read at least n bits into the global variable b *************}
|
|
|
-
|
|
|
-PROCEDURE NEEDBITS ( n : byte );
|
|
|
-VAR nb : longint;
|
|
|
-BEGIN
|
|
|
-{$ifndef assembler}
|
|
|
- WHILE k < n DO BEGIN
|
|
|
- IF inpos > readpos THEN readbuf;
|
|
|
- nb := inbuf [ inpos ];
|
|
|
- inc ( inpos );
|
|
|
- b := b OR nb SHL k;
|
|
|
- inc ( k, 8 );
|
|
|
- END;
|
|
|
-{$else}
|
|
|
- ASM
|
|
|
- mov si, offset inbuf
|
|
|
- mov ch, n
|
|
|
- mov cl, k
|
|
|
- mov bx, inpos {bx=inpos}
|
|
|
-@again :
|
|
|
- cmp cl, ch
|
|
|
- JAE @finished {k>=n -> finished}
|
|
|
- cmp bx, readpos
|
|
|
- jg @readbuf
|
|
|
-@fullbuf :
|
|
|
- mov al, [ si + bx ] {dx:ax=nb}
|
|
|
- XOR ah, ah
|
|
|
- XOR dx, dx
|
|
|
- cmp cl, 8 {cl>=8 -> shift into DX or directly by 1 byte}
|
|
|
- JAE @bigger8
|
|
|
- SHL ax, cl {Normal shifting!}
|
|
|
- jmp @continue
|
|
|
-@bigger8 :
|
|
|
- mov di, cx {save cx}
|
|
|
- mov ah, al {shift by 8}
|
|
|
- XOR al, al
|
|
|
- sub cl, 8 {8 bits shifted}
|
|
|
-@rotate :
|
|
|
- OR cl, cl
|
|
|
- jz @continue1 {all shifted -> finished}
|
|
|
- SHL ah, 1 {al ist empty!}
|
|
|
- rcl dx, 1
|
|
|
- dec cl
|
|
|
- jmp @rotate
|
|
|
-@continue1 :
|
|
|
- mov cx, di
|
|
|
-@continue :
|
|
|
- OR li.hi ( b ), dx {b=b or nb shl k}
|
|
|
- OR li.lo ( b ), ax
|
|
|
- inc bx {inpos}
|
|
|
- add cl, 8 {inc k by 8 Bits}
|
|
|
- jmp @again
|
|
|
-
|
|
|
-@readbuf :
|
|
|
- push si
|
|
|
- push cx
|
|
|
- call readbuf {readbuf not critical, called only every 2000 bytes}
|
|
|
- pop cx
|
|
|
- pop si
|
|
|
- mov bx, inpos {New inpos}
|
|
|
- jmp @fullbuf
|
|
|
-
|
|
|
-@finished :
|
|
|
- mov k, cl
|
|
|
- mov inpos, bx
|
|
|
- END;
|
|
|
-{$endif}
|
|
|
-END;
|
|
|
-
|
|
|
-{***************** dump n bits no longer needed from global variable b *************}
|
|
|
-
|
|
|
-PROCEDURE DUMPBITS ( n : byte );
|
|
|
-BEGIN
|
|
|
-{$ifndef assembler}
|
|
|
- b := b SHR n;
|
|
|
- k := k -n;
|
|
|
-{$else}
|
|
|
- ASM
|
|
|
- mov cl, n
|
|
|
- mov ax, li.lo ( b )
|
|
|
- mov dx, li.hi ( b )
|
|
|
-
|
|
|
- mov ch, cl
|
|
|
- OR ch, ch
|
|
|
- jz @finished
|
|
|
-@rotate :
|
|
|
- SHR dx, 1 {Lower Bit in Carry}
|
|
|
- rcr ax, 1
|
|
|
- dec ch
|
|
|
- jnz @rotate
|
|
|
-@finished :
|
|
|
- mov li.lo ( b ), ax
|
|
|
- mov li.hi ( b ), dx
|
|
|
- sub k, cl
|
|
|
- END;
|
|
|
-{$endif}
|
|
|
-END;
|
|
|
-
|
|
|
-{********************* Flush w bytes directly from slide to file ******************}
|
|
|
-FUNCTION flush ( w : word ) : boolean;
|
|
|
-VAR n : nword; {True wenn OK}
|
|
|
-b : boolean;
|
|
|
-BEGIN
|
|
|
- {$I-}
|
|
|
- blockwrite ( outfile, slide [ 0 ], w, n );
|
|
|
- {$I+}
|
|
|
- b := ( n = w ) AND ( ioresult = 0 ); {True-> alles ok}
|
|
|
- UpdateCRC ( iobuf ( pointer ( @slide [ 0 ] ) ^ ), w );
|
|
|
- {--}
|
|
|
-{$IFDEF FPC}
|
|
|
- IF ( b = TRUE ) AND Assigned(ZipReport) {callback report for high level functions}
|
|
|
-{$ELSE}
|
|
|
- IF ( b = TRUE ) AND ( @ZipReport <> NIL ) {callback report for high level functions}
|
|
|
-{$ENDIF}
|
|
|
- THEN BEGIN
|
|
|
- WITH ZipRec DO BEGIN
|
|
|
- Status := file_unzipping;
|
|
|
- ZipReport ( n, @ZipRec ); {report the actual bytes written}
|
|
|
- END;
|
|
|
- END; {report}
|
|
|
- flush := b;
|
|
|
-END;
|
|
|
-
|
|
|
-{******************************* Break string into tokens ****************************}
|
|
|
-
|
|
|
-VAR
|
|
|
- _Token : PChar;
|
|
|
-
|
|
|
-FUNCTION StrTok ( Source : PChar; Token : CHAR ) : PChar;
|
|
|
- VAR P : PChar;
|
|
|
-BEGIN
|
|
|
- IF Source <> NIL THEN _Token := Source;
|
|
|
- IF _Token = NIL THEN BEGIN
|
|
|
- strTok := NIL;
|
|
|
- exit
|
|
|
- END;
|
|
|
- P := StrScan ( _Token, Token );
|
|
|
- StrTok := _Token;
|
|
|
- IF P <> NIL THEN BEGIN
|
|
|
- P^ := #0;
|
|
|
- Inc ( P );
|
|
|
- END;
|
|
|
- _Token := P;
|
|
|
-END;
|
|
|
-
|
|
|
-(***************************************************************************)
|
|
|
-{.$I z_huft.pas} {Huffman tree generating and destroying}
|
|
|
-{include for unzip.pas: Huffman tree generating and destroying}
|
|
|
-
|
|
|
-{C code by info-zip group, translated to Pascal by Christian Ghisler}
|
|
|
-{based on unz51g.zip}
|
|
|
-
|
|
|
-{*************** free huffman tables starting with table where t points to ************}
|
|
|
-
|
|
|
-PROCEDURE huft_free ( t : phuftlist );
|
|
|
-
|
|
|
-VAR p, q : phuftlist;
|
|
|
- z : integer;
|
|
|
-
|
|
|
-BEGIN
|
|
|
- p := pointer ( t );
|
|
|
- WHILE p <> NIL DO BEGIN
|
|
|
- dec ( longint ( p ), sizeof ( huft ) );
|
|
|
- q := p^ [ 0 ].v_t;
|
|
|
- z := p^ [ 0 ].v_n; {Size in Bytes, required by TP ***}
|
|
|
- freemem ( p, ( z + 1 ) * sizeof ( huft ) );
|
|
|
- p := q
|
|
|
- END;
|
|
|
-END;
|
|
|
-
|
|
|
-{*********** build huffman table from code lengths given by array b^ *******************}
|
|
|
-
|
|
|
-FUNCTION huft_build ( b : pword;n : word;s : word;d, e : pushlist;t : pphuft;VAR m : integer ) : integer;
|
|
|
-VAR a : word; {counter for codes of length k}
|
|
|
- c : ARRAY [ 0..b_max + 1 ] of word; {bit length count table}
|
|
|
- f : word; {i repeats in table every f entries}
|
|
|
- g, {max. code length}
|
|
|
- h : integer; {table level}
|
|
|
- i, {counter, current code}
|
|
|
- j : word; {counter}
|
|
|
- k : integer; {number of bits in current code}
|
|
|
- p : pword; {pointer into c, b and v}
|
|
|
- q : phuftlist; {points to current table}
|
|
|
- r : huft; {table entry for structure assignment}
|
|
|
- u : ARRAY [ 0..b_max ] of phuftlist;{table stack}
|
|
|
- v : ARRAY [ 0..n_max ] of word; {values in order of bit length}
|
|
|
- w : integer; {bits before this table}
|
|
|
- x : ARRAY [ 0..b_max + 1 ] of word; {bit offsets, then code stack}
|
|
|
- l : ARRAY [ -1..b_max + 1 ] of word; {l[h] bits in table of level h}
|
|
|
- xp : ^word; {pointer into x}
|
|
|
- y : integer; {number of dummy codes added}
|
|
|
- z : word; {number of entries in current table}
|
|
|
- tryagain : boolean; {bool for loop}
|
|
|
- pt : phuft; {for test against bad input}
|
|
|
- el : word; {length of eob code=code 256}
|
|
|
-
|
|
|
-BEGIN
|
|
|
- IF n > 256 THEN el := pword ( longint ( b ) + 256 * sizeof ( word ) ) ^
|
|
|
- ELSE el := BMAX;
|
|
|
- {generate counts for each bit length}
|
|
|
- fillchar ( c, sizeof ( c ), #0 );
|
|
|
- p := b; i := n; {p points to array of word}
|
|
|
- REPEAT
|
|
|
- IF p^ > b_max THEN BEGIN
|
|
|
- t^ := NIL;
|
|
|
- m := 0;
|
|
|
- huft_build := huft_error;
|
|
|
- exit
|
|
|
- END;
|
|
|
- inc ( c [ p^ ] );
|
|
|
- inc ( longint ( p ), sizeof ( word ) ); {point to next item}
|
|
|
- dec ( i );
|
|
|
- UNTIL i = 0;
|
|
|
- IF c [ 0 ] = n THEN BEGIN
|
|
|
- t^ := NIL;
|
|
|
- m := 0;
|
|
|
- huft_build := huft_complete;
|
|
|
- exit
|
|
|
- END;
|
|
|
-
|
|
|
- {find minimum and maximum length, bound m by those}
|
|
|
- j := 1;
|
|
|
- WHILE ( j <= b_max ) AND ( c [ j ] = 0 ) DO inc ( j );
|
|
|
- k := j;
|
|
|
- IF m < j THEN m := j;
|
|
|
- i := b_max;
|
|
|
- WHILE ( i > 0 ) AND ( c [ i ] = 0 ) DO dec ( i );
|
|
|
- g := i;
|
|
|
- IF m > i THEN m := i;
|
|
|
-
|
|
|
- {adjust last length count to fill out codes, if needed}
|
|
|
- y := 1 SHL j;
|
|
|
- WHILE j < i DO BEGIN
|
|
|
- y := y -c [ j ];
|
|
|
- IF y < 0 THEN BEGIN
|
|
|
- huft_build := huft_error;
|
|
|
- exit
|
|
|
- END;
|
|
|
- y := y SHL 1;
|
|
|
- inc ( j );
|
|
|
- END;
|
|
|
- dec ( y, c [ i ] );
|
|
|
- IF y < 0 THEN BEGIN
|
|
|
- huft_build := huft_error;
|
|
|
- exit
|
|
|
- END;
|
|
|
- inc ( c [ i ], y );
|
|
|
-
|
|
|
- {generate starting offsets into the value table for each length}
|
|
|
- x [ 1 ] := 0;
|
|
|
- j := 0;
|
|
|
- p := @c; inc ( longint ( p ), sizeof ( word ) );
|
|
|
- xp := @x;inc ( longint ( xp ), 2 * sizeof ( word ) );
|
|
|
- dec ( i );
|
|
|
- WHILE i <> 0 DO BEGIN
|
|
|
- inc ( j, p^ );
|
|
|
- xp^ := j;
|
|
|
- inc ( longint ( p ), 2 );
|
|
|
- inc ( longint ( xp ), 2 );
|
|
|
- dec ( i );
|
|
|
- END;
|
|
|
-
|
|
|
- {make table of values in order of bit length}
|
|
|
- p := b; i := 0;
|
|
|
- REPEAT
|
|
|
- j := p^;
|
|
|
- inc ( longint ( p ), sizeof ( word ) );
|
|
|
- IF j <> 0 THEN BEGIN
|
|
|
- v [ x [ j ] ] := i;
|
|
|
- inc ( x [ j ] );
|
|
|
- END;
|
|
|
- inc ( i );
|
|
|
- UNTIL i >= n;
|
|
|
-
|
|
|
- {generate huffman codes and for each, make the table entries}
|
|
|
- x [ 0 ] := 0; i := 0;
|
|
|
- p := @v;
|
|
|
- h := -1;
|
|
|
- l [ -1 ] := 0;
|
|
|
- w := 0;
|
|
|
- u [ 0 ] := NIL;
|
|
|
- q := NIL;
|
|
|
- z := 0;
|
|
|
-
|
|
|
- {go through the bit lengths (k already is bits in shortest code)}
|
|
|
- FOR k := k TO g DO BEGIN
|
|
|
- FOR a := c [ k ] DOWNTO 1 DO BEGIN
|
|
|
- {here i is the huffman code of length k bits for value p^}
|
|
|
- WHILE k > w + l [ h ] DO BEGIN
|
|
|
- inc ( w, l [ h ] ); {Length of tables to this position}
|
|
|
- inc ( h );
|
|
|
- z := g -w;
|
|
|
- IF z > m THEN z := m;
|
|
|
- j := k -w;
|
|
|
- f := 1 SHL j;
|
|
|
- IF f > a + 1 THEN BEGIN
|
|
|
- dec ( f, a + 1 );
|
|
|
- xp := @c [ k ];
|
|
|
- inc ( j );
|
|
|
- tryagain := TRUE;
|
|
|
- WHILE ( j < z ) AND tryagain DO BEGIN
|
|
|
- f := f SHL 1;
|
|
|
- inc ( longint ( xp ), sizeof ( word ) );
|
|
|
- IF f <= xp^ THEN tryagain := FALSE
|
|
|
- ELSE BEGIN
|
|
|
- dec ( f, xp^ );
|
|
|
- inc ( j );
|
|
|
- END;
|
|
|
- END;
|
|
|
- END;
|
|
|
- IF ( w + j > el ) AND ( w < el ) THEN
|
|
|
- j := el -w; {Make eob code end at table}
|
|
|
- IF w = 0 THEN BEGIN
|
|
|
- j := m; {*** Fix: main table always m bits!}
|
|
|
- END;
|
|
|
- z := 1 SHL j;
|
|
|
- l [ h ] := j;
|
|
|
-
|
|
|
- {allocate and link new table}
|
|
|
- getmem ( q, ( z + 1 ) * sizeof ( huft ) );
|
|
|
- IF q = NIL THEN BEGIN
|
|
|
- IF h <> 0 THEN huft_free ( pointer ( u [ 0 ] ) );
|
|
|
- huft_build := huft_outofmem;
|
|
|
- exit
|
|
|
- END;
|
|
|
- fillchar ( q^, ( z + 1 ) * sizeof ( huft ), #0 );
|
|
|
- q^ [ 0 ].v_n := z; {Size of table, needed in freemem ***}
|
|
|
- t^ := @q^ [ 1 ]; {first item starts at 1}
|
|
|
- t := @q^ [ 0 ].v_t;
|
|
|
- t^ := NIL;
|
|
|
- q := @q^ [ 1 ]; {pointer(longint(q)+sizeof(huft));} {???}
|
|
|
- u [ h ] := q;
|
|
|
- {connect to last table, if there is one}
|
|
|
- IF h <> 0 THEN BEGIN
|
|
|
- x [ h ] := i;
|
|
|
- r.b := l [ h -1 ];
|
|
|
- r.e := 16 + j;
|
|
|
- r.v_t := q;
|
|
|
- j := ( i AND ( ( 1 SHL w ) -1 ) ) SHR ( w -l [ h -1 ] );
|
|
|
-
|
|
|
- {test against bad input!}
|
|
|
- pt := phuft ( longint ( u [ h -1 ] ) -sizeof ( huft ) );
|
|
|
- IF j > pt^.v_n THEN BEGIN
|
|
|
- huft_free ( pointer ( u [ 0 ] ) );
|
|
|
- huft_build := huft_error;
|
|
|
- exit
|
|
|
- END;
|
|
|
-
|
|
|
- pt := @u [ h -1 ]^ [ j ];
|
|
|
- pt^ := r;
|
|
|
- END;
|
|
|
- END;
|
|
|
-
|
|
|
- {set up table entry in r}
|
|
|
- r.b := word ( k -w );
|
|
|
- r.v_t := NIL; {Unused} {***********}
|
|
|
- IF longint ( p ) >= longint ( @v [ n ] ) THEN r.e := 99
|
|
|
- ELSE IF p^ < s THEN BEGIN
|
|
|
- IF p^ < 256 THEN r.e := 16 ELSE r.e := 15;
|
|
|
- r.v_n := p^;
|
|
|
- inc ( longint ( p ), sizeof ( word ) );
|
|
|
- END ELSE BEGIN
|
|
|
- IF ( d = NIL ) OR ( e = NIL ) THEN BEGIN
|
|
|
- huft_free ( pointer ( u [ 0 ] ) );
|
|
|
- huft_build := huft_error;
|
|
|
- exit
|
|
|
- END;
|
|
|
- r.e := word ( e^ [ p^ -s ] );
|
|
|
- r.v_n := d^ [ p^ -s ];
|
|
|
- inc ( longint ( p ), sizeof ( word ) );
|
|
|
- END;
|
|
|
-
|
|
|
- {fill code like entries with r}
|
|
|
- f := 1 SHL ( k -w );
|
|
|
- j := i SHR w;
|
|
|
- WHILE j < z DO BEGIN
|
|
|
- q^ [ j ] := r;
|
|
|
- inc ( j, f );
|
|
|
- END;
|
|
|
-
|
|
|
- {backwards increment the k-bit code i}
|
|
|
- j := 1 SHL ( k -1 );
|
|
|
- WHILE ( i AND j ) <> 0 DO BEGIN
|
|
|
- {i:=i^j;}
|
|
|
- i := i XOR j;
|
|
|
- j := j SHR 1;
|
|
|
- END;
|
|
|
- i := i XOR j;
|
|
|
-
|
|
|
- {backup over finished tables}
|
|
|
- WHILE ( ( i AND ( ( 1 SHL w ) -1 ) ) <> x [ h ] ) DO BEGIN
|
|
|
- dec ( h );
|
|
|
- dec ( w, l [ h ] ); {Size of previous table!}
|
|
|
- END;
|
|
|
- END;
|
|
|
- END;
|
|
|
- IF ( y <> 0 ) AND ( g <> 1 ) THEN huft_build := huft_incomplete
|
|
|
- ELSE huft_build := huft_complete;
|
|
|
-END;
|
|
|
-
|
|
|
-(***************************************************************************)
|
|
|
-{.$I z_inflat.pas} {Inflate deflated file}
|
|
|
-{include for unzip.pas: Inflate deflated file}
|
|
|
-
|
|
|
-{C code by info-zip group, translated to Pascal by Christian Ghisler}
|
|
|
-{based on unz51g.zip}
|
|
|
-
|
|
|
-FUNCTION inflate_codes ( tl, td : phuftlist;bl, bd : integer ) : integer;
|
|
|
-VAR
|
|
|
- n, d, e1, {length and index for copy}
|
|
|
- ml, md : longint; {masks for bl and bd bits}
|
|
|
- t : phuft; {pointer to table entry}
|
|
|
- e : byte; {table entry flag/number of extra bits}
|
|
|
-
|
|
|
-BEGIN
|
|
|
- { inflate the coded data }
|
|
|
- ml := mask_bits [ bl ]; {precompute masks for speed}
|
|
|
- md := mask_bits [ bd ];
|
|
|
- WHILE NOT ( totalabort OR zipeof ) DO BEGIN
|
|
|
- NEEDBITS ( bl );
|
|
|
- t := @tl^ [ b AND ml ];
|
|
|
- e := t^.e;
|
|
|
- IF e > 16 THEN REPEAT {then it's a literal}
|
|
|
- IF e = 99 THEN BEGIN
|
|
|
- inflate_codes := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- dec ( e, 16 );
|
|
|
- NEEDBITS ( e );
|
|
|
- t := @t^.v_t^ [ b AND mask_bits [ e ] ];
|
|
|
- e := t^.e;
|
|
|
- UNTIL e <= 16;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- IF e = 16 THEN BEGIN
|
|
|
- slide [ w ] := char ( t^.v_n );
|
|
|
- inc ( w );
|
|
|
- IF w = WSIZE THEN BEGIN
|
|
|
- IF NOT flush ( w ) THEN BEGIN
|
|
|
- inflate_codes := unzip_WriteErr;
|
|
|
- exit;
|
|
|
- END;
|
|
|
- w := 0
|
|
|
- END;
|
|
|
- END ELSE BEGIN {it's an EOB or a length}
|
|
|
- IF e = 15 THEN BEGIN {Ende} {exit if end of block}
|
|
|
- inflate_codes := unzip_Ok;
|
|
|
- exit;
|
|
|
- END;
|
|
|
- NEEDBITS ( e ); {get length of block to copy}
|
|
|
- n := t^.v_n + ( b AND mask_bits [ e ] );
|
|
|
- DUMPBITS ( e );
|
|
|
-
|
|
|
- NEEDBITS ( bd ); {decode distance of block to copy}
|
|
|
- t := @td^ [ b AND md ];
|
|
|
- e := t^.e;
|
|
|
- IF e > 16 THEN REPEAT
|
|
|
- IF e = 99 THEN BEGIN
|
|
|
- inflate_codes := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- dec ( e, 16 );
|
|
|
- NEEDBITS ( e );
|
|
|
- t := @t^.v_t^ [ b AND mask_bits [ e ] ];
|
|
|
- e := t^.e;
|
|
|
- UNTIL e <= 16;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- NEEDBITS ( e );
|
|
|
- d := w -t^.v_n -b AND mask_bits [ e ];
|
|
|
- DUMPBITS ( e );
|
|
|
- {do the copy}
|
|
|
- REPEAT
|
|
|
- d := d AND ( WSIZE -1 );
|
|
|
- IF d > w THEN e1 := WSIZE -d
|
|
|
- ELSE e1 := WSIZE -w;
|
|
|
- IF e1 > n THEN e1 := n;
|
|
|
- dec ( n, e1 );
|
|
|
- IF ( longint(w) -d >= e1 ) THEN BEGIN
|
|
|
- move ( slide [ d ], slide [ w ], e1 );
|
|
|
- inc ( w, e1 );
|
|
|
- inc ( d, e1 );
|
|
|
- END ELSE REPEAT
|
|
|
- slide [ w ] := slide [ d ];
|
|
|
- inc ( w );
|
|
|
- inc ( d );
|
|
|
- dec ( e1 );
|
|
|
- UNTIL ( e1 = 0 );
|
|
|
- IF w = WSIZE THEN BEGIN
|
|
|
- IF NOT flush ( w ) THEN BEGIN
|
|
|
- inflate_codes := unzip_WriteErr;
|
|
|
- exit;
|
|
|
- END;
|
|
|
- w := 0;
|
|
|
- END;
|
|
|
- UNTIL n = 0;
|
|
|
- END;
|
|
|
- END;
|
|
|
- IF totalabort THEN
|
|
|
- inflate_codes := unzip_userabort
|
|
|
- ELSE
|
|
|
- inflate_codes := unzip_readErr;
|
|
|
-END;
|
|
|
-
|
|
|
-{**************************** "decompress" stored block **************************}
|
|
|
-
|
|
|
-FUNCTION inflate_stored : integer;
|
|
|
-VAR n : word; {number of bytes in block}
|
|
|
-
|
|
|
-BEGIN
|
|
|
- {go to byte boundary}
|
|
|
- n := k AND 7;
|
|
|
- dumpbits ( n );
|
|
|
- {get the length and its complement}
|
|
|
- NEEDBITS ( 16 );
|
|
|
- n := b AND $ffff;
|
|
|
- DUMPBITS ( 16 );
|
|
|
- NEEDBITS ( 16 );
|
|
|
- IF ( n <> ( NOT b ) AND $ffff ) THEN BEGIN
|
|
|
- inflate_stored := unzip_zipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- DUMPBITS ( 16 );
|
|
|
- WHILE ( n > 0 ) AND NOT ( totalabort OR zipeof ) DO BEGIN {read and output the compressed data}
|
|
|
- dec ( n );
|
|
|
- NEEDBITS ( 8 );
|
|
|
- slide [ w ] := char ( b );
|
|
|
- inc ( w );
|
|
|
- IF w = WSIZE THEN BEGIN
|
|
|
- IF NOT flush ( w ) THEN BEGIN
|
|
|
- inflate_stored := unzip_WriteErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- w := 0;
|
|
|
- END;
|
|
|
- DUMPBITS ( 8 );
|
|
|
- END;
|
|
|
- IF totalabort THEN inflate_stored := unzip_UserAbort
|
|
|
- ELSE IF zipeof THEN inflate_stored := unzip_readErr
|
|
|
- ELSE inflate_stored := unzip_Ok;
|
|
|
-END;
|
|
|
-
|
|
|
-{**************************** decompress fixed block **************************}
|
|
|
-
|
|
|
-FUNCTION inflate_fixed : integer;
|
|
|
-VAR i : integer; {temporary variable}
|
|
|
- tl, {literal/length code table}
|
|
|
- td : phuftlist; {distance code table}
|
|
|
- bl, bd : integer; {lookup bits for tl/bd}
|
|
|
- l : ARRAY [ 0..287 ] of word; {length list for huft_build}
|
|
|
-
|
|
|
-BEGIN
|
|
|
- {set up literal table}
|
|
|
- FOR i := 0 TO 143 DO l [ i ] := 8;
|
|
|
- FOR i := 144 TO 255 DO l [ i ] := 9;
|
|
|
- FOR i := 256 TO 279 DO l [ i ] := 7;
|
|
|
- FOR i := 280 TO 287 DO l [ i ] := 8; {make a complete, but wrong code set}
|
|
|
- bl := 7;
|
|
|
- i := huft_build ( pword ( @l ), 288, 257, pushlist ( @cplens ), pushlist ( @cplext ), @tl, bl );
|
|
|
- IF i <> huft_complete THEN BEGIN
|
|
|
- inflate_fixed := i;
|
|
|
- exit
|
|
|
- END;
|
|
|
- FOR i := 0 TO 29 DO l [ i ] := 5; {make an incomplete code set}
|
|
|
- bd := 5;
|
|
|
- i := huft_build ( pword ( @l ), 30, 0, pushlist ( @cpdist ), pushlist ( @cpdext ), @td, bd );
|
|
|
- IF i > huft_incomplete THEN BEGIN
|
|
|
- huft_free ( tl );
|
|
|
- inflate_fixed := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- inflate_fixed := inflate_codes ( tl, td, bl, bd );
|
|
|
- huft_free ( tl );
|
|
|
- huft_free ( td );
|
|
|
-END;
|
|
|
-
|
|
|
-{**************************** decompress dynamic block **************************}
|
|
|
-
|
|
|
-FUNCTION inflate_dynamic : integer;
|
|
|
-VAR i : integer; {temporary variables}
|
|
|
- j,
|
|
|
- l, {last length}
|
|
|
- m, {mask for bit length table}
|
|
|
- n : word; {number of lengths to get}
|
|
|
- tl, {literal/length code table}
|
|
|
- td : phuftlist; {distance code table}
|
|
|
- bl, bd : integer; {lookup bits for tl/bd}
|
|
|
- nb, nl, nd : word; {number of bit length/literal length/distance codes}
|
|
|
- ll : ARRAY [ 0..288 + 32 -1 ] of word; {literal/length and distance code lengths}
|
|
|
-
|
|
|
-BEGIN
|
|
|
- {read in table lengths}
|
|
|
- NEEDBITS ( 5 );
|
|
|
- nl := 257 + word ( b ) AND $1f;
|
|
|
- DUMPBITS ( 5 );
|
|
|
- NEEDBITS ( 5 );
|
|
|
- nd := 1 + word ( b ) AND $1f;
|
|
|
- DUMPBITS ( 5 );
|
|
|
- NEEDBITS ( 4 );
|
|
|
- nb := 4 + word ( b ) AND $f;
|
|
|
- DUMPBITS ( 4 );
|
|
|
- IF ( nl > 288 ) OR ( nd > 32 ) THEN BEGIN
|
|
|
- inflate_dynamic := 1;
|
|
|
- exit
|
|
|
- END;
|
|
|
- fillchar ( ll, sizeof ( ll ), #0 );
|
|
|
-
|
|
|
- {read in bit-length-code lengths}
|
|
|
- FOR j := 0 TO nb -1 DO BEGIN
|
|
|
- NEEDBITS ( 3 );
|
|
|
- ll [ border [ j ] ] := b AND 7;
|
|
|
- DUMPBITS ( 3 );
|
|
|
- END;
|
|
|
- FOR j := nb TO 18 DO ll [ border [ j ] ] := 0;
|
|
|
-
|
|
|
- {build decoding table for trees--single level, 7 bit lookup}
|
|
|
- bl := 7;
|
|
|
- i := huft_build ( pword ( @ll ), 19, 19, NIL, NIL, @tl, bl );
|
|
|
- IF i <> huft_complete THEN BEGIN
|
|
|
- IF i = huft_incomplete THEN huft_free ( tl ); {other errors: already freed}
|
|
|
- inflate_dynamic := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
-
|
|
|
- {read in literal and distance code lengths}
|
|
|
- n := nl + nd;
|
|
|
- m := mask_bits [ bl ];
|
|
|
- i := 0; l := 0;
|
|
|
- WHILE word ( i ) < n DO BEGIN
|
|
|
- NEEDBITS ( bl );
|
|
|
- td := @tl^ [ b AND m ];
|
|
|
- j := phuft ( td ) ^.b;
|
|
|
- DUMPBITS ( j );
|
|
|
- j := phuft ( td ) ^.v_n;
|
|
|
- IF j < 16 THEN BEGIN {length of code in bits (0..15)}
|
|
|
- l := j; {ave last length in l}
|
|
|
- ll [ i ] := l;
|
|
|
- inc ( i )
|
|
|
- END ELSE IF j = 16 THEN BEGIN {repeat last length 3 to 6 times}
|
|
|
- NEEDBITS ( 2 );
|
|
|
- j := 3 + b AND 3;
|
|
|
- DUMPBITS ( 2 );
|
|
|
- IF i + j > n THEN BEGIN
|
|
|
- inflate_dynamic := 1;
|
|
|
- exit
|
|
|
- END;
|
|
|
- WHILE j > 0 DO BEGIN
|
|
|
- ll [ i ] := l;
|
|
|
- dec ( j );
|
|
|
- inc ( i );
|
|
|
- END;
|
|
|
- END ELSE IF j = 17 THEN BEGIN {3 to 10 zero length codes}
|
|
|
- NEEDBITS ( 3 );
|
|
|
- j := 3 + b AND 7;
|
|
|
- DUMPBITS ( 3 );
|
|
|
- IF i + j > n THEN BEGIN
|
|
|
- inflate_dynamic := 1;
|
|
|
- exit
|
|
|
- END;
|
|
|
- WHILE j > 0 DO BEGIN
|
|
|
- ll [ i ] := 0;
|
|
|
- inc ( i );
|
|
|
- dec ( j );
|
|
|
- END;
|
|
|
- l := 0;
|
|
|
- END ELSE BEGIN {j == 18: 11 to 138 zero length codes}
|
|
|
- NEEDBITS ( 7 );
|
|
|
- j := 11 + b AND $7f;
|
|
|
- DUMPBITS ( 7 );
|
|
|
- IF i + j > n THEN BEGIN
|
|
|
- inflate_dynamic := unzip_zipfileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- WHILE j > 0 DO BEGIN
|
|
|
- ll [ i ] := 0;
|
|
|
- dec ( j );
|
|
|
- inc ( i );
|
|
|
- END;
|
|
|
- l := 0;
|
|
|
- END;
|
|
|
- END;
|
|
|
- huft_free ( tl ); {free decoding table for trees}
|
|
|
-
|
|
|
- {build the decoding tables for literal/length and distance codes}
|
|
|
- bl := lbits;
|
|
|
- i := huft_build ( pword ( @ll ), nl, 257, pushlist ( @cplens ), pushlist ( @cplext ), @tl, bl );
|
|
|
- IF i <> huft_complete THEN BEGIN
|
|
|
- IF i = huft_incomplete THEN huft_free ( tl );
|
|
|
- inflate_dynamic := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- bd := dbits;
|
|
|
- i := huft_build ( pword ( @ll [ nl ] ), nd, 0, pushlist ( @cpdist ), pushlist ( @cpdext ), @td, bd );
|
|
|
- IF i > huft_incomplete THEN BEGIN {pkzip bug workaround}
|
|
|
- IF i = huft_incomplete THEN huft_free ( td );
|
|
|
- huft_free ( tl );
|
|
|
- inflate_dynamic := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- {decompress until an end-of-block code}
|
|
|
- inflate_dynamic := inflate_codes ( tl, td, bl, bd );
|
|
|
- huft_free ( tl );
|
|
|
- huft_free ( td );
|
|
|
-END;
|
|
|
-
|
|
|
-{**************************** decompress a block ******************************}
|
|
|
-
|
|
|
-FUNCTION inflate_block ( VAR e : integer ) : integer;
|
|
|
-VAR t : word; {block type}
|
|
|
-
|
|
|
-BEGIN
|
|
|
- NEEDBITS ( 1 );
|
|
|
- e := b AND 1;
|
|
|
- DUMPBITS ( 1 );
|
|
|
-
|
|
|
- NEEDBITS ( 2 );
|
|
|
- t := b AND 3;
|
|
|
- DUMPBITS ( 2 );
|
|
|
-
|
|
|
- CASE t of
|
|
|
- 2 : inflate_block := inflate_dynamic;
|
|
|
- 0 : inflate_block := inflate_stored;
|
|
|
- 1 : inflate_block := inflate_fixed;
|
|
|
- ELSE
|
|
|
- inflate_block := unzip_ZipFileErr; {bad block type}
|
|
|
- END;
|
|
|
-END;
|
|
|
-
|
|
|
-{**************************** decompress an inflated entry **************************}
|
|
|
-
|
|
|
-FUNCTION inflate : integer;
|
|
|
-VAR e, {last block flag}
|
|
|
- r : integer; {result code}
|
|
|
-
|
|
|
-BEGIN
|
|
|
- inpos := 0; {Input buffer position}
|
|
|
- readpos := -1; {Nothing read}
|
|
|
-
|
|
|
- {initialize window, bit buffer}
|
|
|
- w := 0;
|
|
|
- k := 0;
|
|
|
- b := 0;
|
|
|
-
|
|
|
- {decompress until the last block}
|
|
|
- REPEAT
|
|
|
- r := inflate_block ( e );
|
|
|
- IF r <> 0 THEN BEGIN
|
|
|
- inflate := r;
|
|
|
- exit
|
|
|
- END;
|
|
|
- UNTIL e <> 0;
|
|
|
- {flush out slide}
|
|
|
- IF NOT flush ( w ) THEN inflate := unzip_WriteErr
|
|
|
- ELSE inflate := unzip_Ok;
|
|
|
-END;
|
|
|
-(***************************************************************************)
|
|
|
-{.$I z_copyst.pas} {Copy stored file}
|
|
|
-{include for unzip.pas: Copy stored file}
|
|
|
-
|
|
|
-{C code by info-zip group, translated to Pascal by Christian Ghisler}
|
|
|
-{based on unz51g.zip}
|
|
|
-
|
|
|
-{************************* copy stored file ************************************}
|
|
|
-FUNCTION copystored : integer;
|
|
|
-VAR readin : longint;
|
|
|
- outcnt : nword;
|
|
|
-BEGIN
|
|
|
- WHILE ( reachedsize < compsize ) AND NOT totalabort DO BEGIN
|
|
|
- readin := compsize -reachedsize;
|
|
|
- IF readin > wsize THEN readin := wsize;
|
|
|
- {$I-}
|
|
|
- blockread ( infile, slide [ 0 ], readin, outcnt ); {Use slide as buffer}
|
|
|
- {$I+}
|
|
|
- IF ( outcnt <> readin ) OR ( ioresult <> 0 ) THEN BEGIN
|
|
|
- copystored := unzip_ReadErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- IF NOT flush ( outcnt ) THEN BEGIN {Flushoutput takes care of CRC too}
|
|
|
- copystored := unzip_WriteErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- inc ( reachedsize, outcnt );
|
|
|
- messageloop; {Other programs, or in DOS: keypressed?}
|
|
|
- {$ifdef windows}
|
|
|
- showpercent;
|
|
|
- {$endif}
|
|
|
- END;
|
|
|
- IF NOT totalabort THEN
|
|
|
- copystored := unzip_Ok
|
|
|
- ELSE
|
|
|
- copystored := unzip_Userabort;
|
|
|
-END;
|
|
|
-(***************************************************************************)
|
|
|
-{.$I z_explod.pas} {Explode imploded file}
|
|
|
-{include for unzip.pas: Explode imploded file}
|
|
|
-
|
|
|
-{C code by info-zip group, translated to Pascal by Christian Ghisler}
|
|
|
-{based on unz51g.zip}
|
|
|
-
|
|
|
-{************************************* explode ********************************}
|
|
|
-
|
|
|
-{*********************************** read in tree *****************************}
|
|
|
-FUNCTION get_tree ( l : pword;n : word ) : integer;
|
|
|
-VAR i, k, j, b : word;
|
|
|
- bytebuf : byte;
|
|
|
-
|
|
|
-BEGIN
|
|
|
- READBYTE ( bytebuf );
|
|
|
- i := bytebuf;
|
|
|
- inc ( i );
|
|
|
- k := 0;
|
|
|
- REPEAT
|
|
|
- READBYTE ( bytebuf );
|
|
|
- j := bytebuf;
|
|
|
- b := ( j AND $F ) + 1;
|
|
|
- j := ( ( j AND $F0 ) SHR 4 ) + 1;
|
|
|
- IF ( k + j ) > n THEN BEGIN
|
|
|
- get_tree := 4;
|
|
|
- exit
|
|
|
- END;
|
|
|
- REPEAT
|
|
|
- l^ := b;
|
|
|
- inc ( longint ( l ), sizeof ( word ) );
|
|
|
- inc ( k );
|
|
|
- dec ( j );
|
|
|
- UNTIL j = 0;
|
|
|
- dec ( i );
|
|
|
- UNTIL i = 0;
|
|
|
- IF k <> n THEN get_tree := 4 ELSE get_tree := 0;
|
|
|
-END;
|
|
|
-
|
|
|
-{******************exploding, method: 8k slide, 3 trees ***********************}
|
|
|
-
|
|
|
-FUNCTION explode_lit8 ( tb, tl, td : phuftlist;bb, bl, bd : integer ) : integer;
|
|
|
-VAR s : longint;
|
|
|
- e : word;
|
|
|
- n, d : word;
|
|
|
- w : word;
|
|
|
- t : phuft;
|
|
|
- mb, ml, md : word;
|
|
|
- u : word;
|
|
|
-
|
|
|
-BEGIN
|
|
|
- b := 0; k := 0; w := 0;
|
|
|
- u := 1;
|
|
|
- mb := mask_bits [ bb ];
|
|
|
- ml := mask_bits [ bl ];
|
|
|
- md := mask_bits [ bd ];
|
|
|
- s := uncompsize;
|
|
|
- WHILE ( s > 0 ) AND NOT ( totalabort OR zipeof ) DO BEGIN
|
|
|
- NEEDBITS ( 1 );
|
|
|
- IF ( b AND 1 ) <> 0 THEN BEGIN {Litteral}
|
|
|
- DUMPBITS ( 1 );
|
|
|
- dec ( s );
|
|
|
- NEEDBITS ( bb );
|
|
|
- t := @tb^ [ ( NOT b ) AND mb ];
|
|
|
- e := t^.e;
|
|
|
- IF e > 16 THEN REPEAT
|
|
|
- IF e = 99 THEN BEGIN
|
|
|
- explode_lit8 := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- dec ( e, 16 );
|
|
|
- NEEDBITS ( e );
|
|
|
- t := @t^.v_t^ [ ( NOT b ) AND mask_bits [ e ] ];
|
|
|
- e := t^.e;
|
|
|
- UNTIL e <= 16;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- slide [ w ] := char ( t^.v_n );
|
|
|
- inc ( w );
|
|
|
- IF w = WSIZE THEN BEGIN
|
|
|
- IF NOT flush ( w ) THEN BEGIN
|
|
|
- explode_lit8 := unzip_WriteErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- w := 0; u := 0;
|
|
|
- END;
|
|
|
- END ELSE BEGIN
|
|
|
- DUMPBITS ( 1 );
|
|
|
- NEEDBITS ( 7 );
|
|
|
- d := b AND $7F;
|
|
|
- DUMPBITS ( 7 );
|
|
|
- NEEDBITS ( bd );
|
|
|
- t := @td^ [ ( NOT b ) AND md ];
|
|
|
- e := t^.e;
|
|
|
- IF e > 16 THEN REPEAT
|
|
|
- IF e = 99 THEN BEGIN
|
|
|
- explode_lit8 := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- dec ( e, 16 );
|
|
|
- NEEDBITS ( e );
|
|
|
- t := @t^.v_t^ [ ( NOT b ) AND mask_bits [ e ] ];
|
|
|
- e := t^.e;
|
|
|
- UNTIL e <= 16;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
-
|
|
|
- d := w -d -t^.v_n;
|
|
|
- NEEDBITS ( bl );
|
|
|
- t := @tl^ [ ( NOT b ) AND ml ];
|
|
|
- e := t^.e;
|
|
|
- IF e > 16 THEN REPEAT
|
|
|
- IF e = 99 THEN BEGIN
|
|
|
- explode_lit8 := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- dec ( e, 16 );
|
|
|
- NEEDBITS ( e );
|
|
|
- t := @t^.v_t^ [ ( NOT b ) AND mask_bits [ e ] ];
|
|
|
- e := t^.e;
|
|
|
- UNTIL e <= 16;
|
|
|
-
|
|
|
- DUMPBITS ( t^.b );
|
|
|
-
|
|
|
- n := t^.v_n;
|
|
|
- IF e <> 0 THEN BEGIN
|
|
|
- NEEDBITS ( 8 );
|
|
|
- inc ( n, byte ( b ) AND $ff );
|
|
|
- DUMPBITS ( 8 );
|
|
|
- END;
|
|
|
- dec ( s, n );
|
|
|
- REPEAT
|
|
|
- d := d AND pred ( WSIZE );
|
|
|
- IF d > w THEN e := WSIZE -d ELSE e := WSIZE -w;
|
|
|
- IF e > n THEN e := n;
|
|
|
- dec ( n, e );
|
|
|
- IF ( u <> 0 ) AND ( w <= d ) THEN BEGIN
|
|
|
- fillchar ( slide [ w ], e, #0 );
|
|
|
- inc ( w, e );
|
|
|
- inc ( d, e );
|
|
|
- END ELSE IF ( w -d >= e ) THEN BEGIN
|
|
|
- move ( slide [ d ], slide [ w ], e );
|
|
|
- inc ( w, e );
|
|
|
- inc ( d, e );
|
|
|
- END ELSE REPEAT
|
|
|
- slide [ w ] := slide [ d ];
|
|
|
- inc ( w );
|
|
|
- inc ( d );
|
|
|
- dec ( e );
|
|
|
- UNTIL e = 0;
|
|
|
- IF w = WSIZE THEN BEGIN
|
|
|
- IF NOT flush ( w ) THEN BEGIN
|
|
|
- explode_lit8 := unzip_WriteErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- w := 0; u := 0;
|
|
|
- END;
|
|
|
- UNTIL n = 0;
|
|
|
- END;
|
|
|
- END;
|
|
|
- IF totalabort THEN explode_lit8 := unzip_userabort
|
|
|
- ELSE
|
|
|
- IF NOT flush ( w ) THEN explode_lit8 := unzip_WriteErr
|
|
|
- ELSE
|
|
|
- IF zipeof THEN explode_lit8 := unzip_readErr
|
|
|
- ELSE
|
|
|
- explode_lit8 := unzip_Ok;
|
|
|
-END;
|
|
|
-
|
|
|
-{******************exploding, method: 4k slide, 3 trees ***********************}
|
|
|
-
|
|
|
-FUNCTION explode_lit4 ( tb, tl, td : phuftlist;bb, bl, bd : integer ) : integer;
|
|
|
-VAR s : longint;
|
|
|
- e : word;
|
|
|
- n, d : word;
|
|
|
- w : word;
|
|
|
- t : phuft;
|
|
|
- mb, ml, md : word;
|
|
|
- u : word;
|
|
|
-
|
|
|
-BEGIN
|
|
|
- b := 0; k := 0; w := 0;
|
|
|
- u := 1;
|
|
|
- mb := mask_bits [ bb ];
|
|
|
- ml := mask_bits [ bl ];
|
|
|
- md := mask_bits [ bd ];
|
|
|
- s := uncompsize;
|
|
|
- WHILE ( s > 0 ) AND NOT ( totalabort OR zipeof ) DO BEGIN
|
|
|
- NEEDBITS ( 1 );
|
|
|
- IF ( b AND 1 ) <> 0 THEN BEGIN {Litteral}
|
|
|
- DUMPBITS ( 1 );
|
|
|
- dec ( s );
|
|
|
- NEEDBITS ( bb );
|
|
|
- t := @tb^ [ ( NOT b ) AND mb ];
|
|
|
- e := t^.e;
|
|
|
- IF e > 16 THEN REPEAT
|
|
|
- IF e = 99 THEN BEGIN
|
|
|
- explode_lit4 := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- dec ( e, 16 );
|
|
|
- NEEDBITS ( e );
|
|
|
- t := @t^.v_t^ [ ( NOT b ) AND mask_bits [ e ] ];
|
|
|
- e := t^.e;
|
|
|
- UNTIL e <= 16;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- slide [ w ] := char ( t^.v_n );
|
|
|
- inc ( w );
|
|
|
- IF w = WSIZE THEN BEGIN
|
|
|
- IF NOT flush ( w ) THEN BEGIN
|
|
|
- explode_lit4 := unzip_WriteErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- w := 0; u := 0;
|
|
|
- END;
|
|
|
- END ELSE BEGIN
|
|
|
- DUMPBITS ( 1 );
|
|
|
- NEEDBITS ( 6 );
|
|
|
- d := b AND $3F;
|
|
|
- DUMPBITS ( 6 );
|
|
|
- NEEDBITS ( bd );
|
|
|
- t := @td^ [ ( NOT b ) AND md ];
|
|
|
- e := t^.e;
|
|
|
- IF e > 16 THEN REPEAT
|
|
|
- IF e = 99 THEN BEGIN
|
|
|
- explode_lit4 := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- dec ( e, 16 );
|
|
|
- NEEDBITS ( e );
|
|
|
- t := @t^.v_t^ [ ( NOT b ) AND mask_bits [ e ] ];
|
|
|
- e := t^.e;
|
|
|
- UNTIL e <= 16;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- d := w -d -t^.v_n;
|
|
|
- NEEDBITS ( bl );
|
|
|
- t := @tl^ [ ( NOT b ) AND ml ];
|
|
|
- e := t^.e;
|
|
|
- IF e > 16 THEN REPEAT
|
|
|
- IF e = 99 THEN BEGIN
|
|
|
- explode_lit4 := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- dec ( e, 16 );
|
|
|
- NEEDBITS ( e );
|
|
|
- t := @t^.v_t^ [ ( NOT b ) AND mask_bits [ e ] ];
|
|
|
- e := t^.e;
|
|
|
- UNTIL e <= 16;
|
|
|
-
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- n := t^.v_n;
|
|
|
- IF e <> 0 THEN BEGIN
|
|
|
- NEEDBITS ( 8 );
|
|
|
- inc ( n, b AND $ff );
|
|
|
- DUMPBITS ( 8 );
|
|
|
- END;
|
|
|
- dec ( s, n );
|
|
|
- REPEAT
|
|
|
- d := d AND pred ( WSIZE );
|
|
|
- IF d > w THEN e := WSIZE -d ELSE e := WSIZE -w;
|
|
|
- IF e > n THEN e := n;
|
|
|
- dec ( n, e );
|
|
|
- IF ( u <> 0 ) AND ( w <= d ) THEN BEGIN
|
|
|
- fillchar ( slide [ w ], e, #0 );
|
|
|
- inc ( w, e );
|
|
|
- inc ( d, e );
|
|
|
- END ELSE IF ( w -d >= e ) THEN BEGIN
|
|
|
- move ( slide [ d ], slide [ w ], e );
|
|
|
- inc ( w, e );
|
|
|
- inc ( d, e );
|
|
|
- END ELSE REPEAT
|
|
|
- slide [ w ] := slide [ d ];
|
|
|
- inc ( w );
|
|
|
- inc ( d );
|
|
|
- dec ( e );
|
|
|
- UNTIL e = 0;
|
|
|
- IF w = WSIZE THEN BEGIN
|
|
|
- IF NOT flush ( w ) THEN BEGIN
|
|
|
- explode_lit4 := unzip_WriteErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- w := 0; u := 0;
|
|
|
- END;
|
|
|
- UNTIL n = 0;
|
|
|
- END;
|
|
|
- END;
|
|
|
- IF totalabort THEN explode_lit4 := unzip_userabort
|
|
|
- ELSE
|
|
|
- IF NOT flush ( w ) THEN explode_lit4 := unzip_WriteErr
|
|
|
- ELSE
|
|
|
- IF zipeof THEN explode_lit4 := unzip_readErr
|
|
|
- ELSE explode_lit4 := unzip_Ok;
|
|
|
-END;
|
|
|
-
|
|
|
-{******************exploding, method: 8k slide, 2 trees ***********************}
|
|
|
-
|
|
|
-FUNCTION explode_nolit8 ( tl, td : phuftlist;bl, bd : integer ) : integer;
|
|
|
-VAR s : longint;
|
|
|
- e : word;
|
|
|
- n, d : word;
|
|
|
- w : word;
|
|
|
- t : phuft;
|
|
|
- ml, md : word;
|
|
|
- u : word;
|
|
|
-
|
|
|
-BEGIN
|
|
|
- b := 0; k := 0; w := 0;
|
|
|
- u := 1;
|
|
|
- ml := mask_bits [ bl ];
|
|
|
- md := mask_bits [ bd ];
|
|
|
- s := uncompsize;
|
|
|
- WHILE ( s > 0 ) AND NOT ( totalabort OR zipeof ) DO BEGIN
|
|
|
- NEEDBITS ( 1 );
|
|
|
- IF ( b AND 1 ) <> 0 THEN BEGIN {Litteral}
|
|
|
- DUMPBITS ( 1 );
|
|
|
- dec ( s );
|
|
|
- NEEDBITS ( 8 );
|
|
|
- slide [ w ] := char ( b );
|
|
|
- inc ( w );
|
|
|
- IF w = WSIZE THEN BEGIN
|
|
|
- IF NOT flush ( w ) THEN BEGIN
|
|
|
- explode_nolit8 := unzip_WriteErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- w := 0; u := 0;
|
|
|
- END;
|
|
|
- DUMPBITS ( 8 );
|
|
|
- END ELSE BEGIN
|
|
|
- DUMPBITS ( 1 );
|
|
|
- NEEDBITS ( 7 );
|
|
|
- d := b AND $7F;
|
|
|
- DUMPBITS ( 7 );
|
|
|
- NEEDBITS ( bd );
|
|
|
- t := @td^ [ ( NOT b ) AND md ];
|
|
|
- e := t^.e;
|
|
|
- IF e > 16 THEN REPEAT
|
|
|
- IF e = 99 THEN BEGIN
|
|
|
- explode_nolit8 := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- dec ( e, 16 );
|
|
|
- NEEDBITS ( e );
|
|
|
- t := @t^.v_t^ [ ( NOT b ) AND mask_bits [ e ] ];
|
|
|
- e := t^.e;
|
|
|
- UNTIL e <= 16;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
-
|
|
|
- d := w -d -t^.v_n;
|
|
|
- NEEDBITS ( bl );
|
|
|
- t := @tl^ [ ( NOT b ) AND ml ];
|
|
|
- e := t^.e;
|
|
|
- IF e > 16 THEN REPEAT
|
|
|
- IF e = 99 THEN BEGIN
|
|
|
- explode_nolit8 := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- dec ( e, 16 );
|
|
|
- NEEDBITS ( e );
|
|
|
- t := @t^.v_t^ [ ( NOT b ) AND mask_bits [ e ] ];
|
|
|
- e := t^.e;
|
|
|
- UNTIL e <= 16;
|
|
|
-
|
|
|
- DUMPBITS ( t^.b );
|
|
|
-
|
|
|
- n := t^.v_n;
|
|
|
- IF e <> 0 THEN BEGIN
|
|
|
- NEEDBITS ( 8 );
|
|
|
- inc ( n, b AND $ff );
|
|
|
- DUMPBITS ( 8 );
|
|
|
- END;
|
|
|
- dec ( s, n );
|
|
|
- REPEAT
|
|
|
- d := d AND pred ( WSIZE );
|
|
|
- IF d > w THEN e := WSIZE -d ELSE e := WSIZE -w;
|
|
|
- IF e > n THEN e := n;
|
|
|
- dec ( n, e );
|
|
|
- IF ( u <> 0 ) AND ( w <= d ) THEN BEGIN
|
|
|
- fillchar ( slide [ w ], e, #0 );
|
|
|
- inc ( w, e );
|
|
|
- inc ( d, e );
|
|
|
- END ELSE IF ( w -d >= e ) THEN BEGIN
|
|
|
- move ( slide [ d ], slide [ w ], e );
|
|
|
- inc ( w, e );
|
|
|
- inc ( d, e );
|
|
|
- END ELSE REPEAT
|
|
|
- slide [ w ] := slide [ d ];
|
|
|
- inc ( w );
|
|
|
- inc ( d );
|
|
|
- dec ( e );
|
|
|
- UNTIL e = 0;
|
|
|
- IF w = WSIZE THEN BEGIN
|
|
|
- IF NOT flush ( w ) THEN BEGIN
|
|
|
- explode_nolit8 := unzip_WriteErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- w := 0; u := 0;
|
|
|
- END;
|
|
|
- UNTIL n = 0;
|
|
|
- END;
|
|
|
- END;
|
|
|
- IF totalabort THEN explode_nolit8 := unzip_userabort
|
|
|
- ELSE
|
|
|
- IF NOT flush ( w ) THEN explode_nolit8 := unzip_WriteErr
|
|
|
- ELSE
|
|
|
- IF zipeof THEN explode_nolit8 := unzip_readErr
|
|
|
- ELSE explode_nolit8 := unzip_Ok;
|
|
|
-END;
|
|
|
-
|
|
|
-{******************exploding, method: 4k slide, 2 trees ***********************}
|
|
|
-
|
|
|
-FUNCTION explode_nolit4 ( tl, td : phuftlist;bl, bd : integer ) : integer;
|
|
|
-VAR s : longint;
|
|
|
- e : word;
|
|
|
- n, d : word;
|
|
|
- w : word;
|
|
|
- t : phuft;
|
|
|
- ml, md : word;
|
|
|
- u : word;
|
|
|
-
|
|
|
-BEGIN
|
|
|
- b := 0; k := 0; w := 0;
|
|
|
- u := 1;
|
|
|
- ml := mask_bits [ bl ];
|
|
|
- md := mask_bits [ bd ];
|
|
|
- s := uncompsize;
|
|
|
- WHILE ( s > 0 ) AND NOT ( totalabort OR zipeof ) DO BEGIN
|
|
|
- NEEDBITS ( 1 );
|
|
|
- IF ( b AND 1 ) <> 0 THEN BEGIN {Litteral}
|
|
|
- DUMPBITS ( 1 );
|
|
|
- dec ( s );
|
|
|
- NEEDBITS ( 8 );
|
|
|
- slide [ w ] := char ( b );
|
|
|
- inc ( w );
|
|
|
- IF w = WSIZE THEN BEGIN
|
|
|
- IF NOT flush ( w ) THEN BEGIN
|
|
|
- explode_nolit4 := unzip_WriteErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- w := 0; u := 0;
|
|
|
- END;
|
|
|
- DUMPBITS ( 8 );
|
|
|
- END ELSE BEGIN
|
|
|
- DUMPBITS ( 1 );
|
|
|
- NEEDBITS ( 6 );
|
|
|
- d := b AND $3F;
|
|
|
- DUMPBITS ( 6 );
|
|
|
- NEEDBITS ( bd );
|
|
|
- t := @td^ [ ( NOT b ) AND md ];
|
|
|
- e := t^.e;
|
|
|
- IF e > 16 THEN REPEAT
|
|
|
- IF e = 99 THEN BEGIN
|
|
|
- explode_nolit4 := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- dec ( e, 16 );
|
|
|
- NEEDBITS ( e );
|
|
|
- t := @t^.v_t^ [ ( NOT b ) AND mask_bits [ e ] ];
|
|
|
- e := t^.e;
|
|
|
- UNTIL e <= 16;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- d := w -d -t^.v_n;
|
|
|
- NEEDBITS ( bl );
|
|
|
- t := @tl^ [ ( NOT b ) AND ml ];
|
|
|
- e := t^.e;
|
|
|
- IF e > 16 THEN REPEAT
|
|
|
- IF e = 99 THEN BEGIN
|
|
|
- explode_nolit4 := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- dec ( e, 16 );
|
|
|
- NEEDBITS ( e );
|
|
|
- t := @t^.v_t^ [ ( NOT b ) AND mask_bits [ e ] ];
|
|
|
- e := t^.e;
|
|
|
- UNTIL e <= 16;
|
|
|
-
|
|
|
- DUMPBITS ( t^.b );
|
|
|
- n := t^.v_n;
|
|
|
- IF e <> 0 THEN BEGIN
|
|
|
- NEEDBITS ( 8 );
|
|
|
- inc ( n, b AND $ff );
|
|
|
- DUMPBITS ( 8 );
|
|
|
- END;
|
|
|
- dec ( s, n );
|
|
|
- REPEAT
|
|
|
- d := d AND pred ( WSIZE );
|
|
|
- IF d > w THEN e := WSIZE -d ELSE e := WSIZE -w;
|
|
|
- IF e > n THEN e := n;
|
|
|
- dec ( n, e );
|
|
|
- IF ( u <> 0 ) AND ( w <= d ) THEN BEGIN
|
|
|
- fillchar ( slide [ w ], e, #0 );
|
|
|
- inc ( w, e );
|
|
|
- inc ( d, e );
|
|
|
- END ELSE IF ( w -d >= e ) THEN BEGIN
|
|
|
- move ( slide [ d ], slide [ w ], e );
|
|
|
- inc ( w, e );
|
|
|
- inc ( d, e );
|
|
|
- END ELSE REPEAT
|
|
|
- slide [ w ] := slide [ d ];
|
|
|
- inc ( w );
|
|
|
- inc ( d );
|
|
|
- dec ( e );
|
|
|
- UNTIL e = 0;
|
|
|
- IF w = WSIZE THEN BEGIN
|
|
|
- IF NOT flush ( w ) THEN BEGIN
|
|
|
- explode_nolit4 := unzip_WriteErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- w := 0; u := 0;
|
|
|
- END;
|
|
|
- UNTIL n = 0;
|
|
|
- END;
|
|
|
- END;
|
|
|
- IF totalabort THEN explode_nolit4 := unzip_userabort
|
|
|
- ELSE
|
|
|
- IF NOT flush ( w ) THEN explode_nolit4 := unzip_WriteErr
|
|
|
- ELSE
|
|
|
- IF zipeof THEN explode_nolit4 := unzip_readErr
|
|
|
- ELSE explode_nolit4 := unzip_Ok;
|
|
|
-END;
|
|
|
-
|
|
|
-{****************************** explode *********************************}
|
|
|
-
|
|
|
-FUNCTION explode : integer;
|
|
|
-VAR r : integer;
|
|
|
- tb, tl, td : phuftlist;
|
|
|
- bb, bl, bd : integer;
|
|
|
- l : ARRAY [ 0..255 ] of word;
|
|
|
-
|
|
|
-BEGIN
|
|
|
- inpos := 0;
|
|
|
- readpos := -1; {Nothing read in}
|
|
|
- bl := 7;
|
|
|
- IF compsize > 200000 THEN bd := 8 ELSE bd := 7;
|
|
|
- IF hufttype AND 4 <> 0 THEN BEGIN
|
|
|
- bb := 9;
|
|
|
- r := get_tree ( @l [ 0 ], 256 );
|
|
|
- IF r <> 0 THEN BEGIN
|
|
|
- explode := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- r := huft_build ( @l, 256, 256, NIL, NIL, @tb, bb );
|
|
|
- IF r <> 0 THEN BEGIN
|
|
|
- IF r = huft_incomplete THEN huft_free ( tb );
|
|
|
- explode := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- r := get_tree ( @l [ 0 ], 64 );
|
|
|
- IF r <> 0 THEN BEGIN
|
|
|
- huft_free ( tb );
|
|
|
- explode := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- r := huft_build ( @l, 64, 0, pushlist ( @cplen3 ), pushlist ( @extra ), @tl, bl );
|
|
|
- IF r <> 0 THEN BEGIN
|
|
|
- IF r = huft_incomplete THEN huft_free ( tl );
|
|
|
- huft_free ( tb );
|
|
|
- explode := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- r := get_tree ( @l [ 0 ], 64 );
|
|
|
- IF r <> 0 THEN BEGIN
|
|
|
- huft_free ( tb );
|
|
|
- huft_free ( tl );
|
|
|
- explode := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- IF hufttype AND 2 <> 0 THEN BEGIN {8k}
|
|
|
- r := huft_build ( @l, 64, 0, pushlist ( @cpdist8 ), pushlist ( @extra ), @td, bd );
|
|
|
- IF r <> 0 THEN BEGIN
|
|
|
- IF r = huft_incomplete THEN huft_free ( td );
|
|
|
- huft_free ( tb );
|
|
|
- huft_free ( tl );
|
|
|
- explode := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- r := explode_lit8 ( tb, tl, td, bb, bl, bd );
|
|
|
- END ELSE BEGIN
|
|
|
- r := huft_build ( @l, 64, 0, pushlist ( @cpdist4 ), pushlist ( @extra ), @td, bd );
|
|
|
- IF r <> 0 THEN BEGIN
|
|
|
- IF r = huft_incomplete THEN huft_free ( td );
|
|
|
- huft_free ( tb );
|
|
|
- huft_free ( tl );
|
|
|
- explode := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- r := explode_lit4 ( tb, tl, td, bb, bl, bd );
|
|
|
- END;
|
|
|
- huft_free ( td );
|
|
|
- huft_free ( tl );
|
|
|
- huft_free ( tb );
|
|
|
- END ELSE BEGIN {No literal tree}
|
|
|
- r := get_tree ( @l [ 0 ], 64 );
|
|
|
- IF r <> 0 THEN BEGIN
|
|
|
- explode := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- r := huft_build ( @l, 64, 0, pushlist ( @cplen2 ), pushlist ( @extra ), @tl, bl );
|
|
|
- IF r <> 0 THEN BEGIN
|
|
|
- IF r = huft_incomplete THEN huft_free ( tl );
|
|
|
- explode := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
-
|
|
|
- r := get_tree ( @l [ 0 ], 64 );
|
|
|
- IF r <> 0 THEN BEGIN
|
|
|
- huft_free ( tl );
|
|
|
- explode := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- IF hufttype AND 2 <> 0 THEN BEGIN {8k}
|
|
|
- r := huft_build ( @l, 64, 0, pushlist ( @cpdist8 ), pushlist ( @extra ), @td, bd );
|
|
|
- IF r <> 0 THEN BEGIN
|
|
|
- IF r = huft_incomplete THEN huft_free ( td );
|
|
|
- huft_free ( tl );
|
|
|
- explode := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- r := explode_nolit8 ( tl, td, bl, bd );
|
|
|
- END ELSE BEGIN
|
|
|
- r := huft_build ( @l, 64, 0, pushlist ( @cpdist4 ), pushlist ( @extra ), @td, bd );
|
|
|
- IF r <> 0 THEN BEGIN
|
|
|
- IF r = huft_incomplete THEN huft_free ( td );
|
|
|
- huft_free ( tl );
|
|
|
- explode := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- r := explode_nolit4 ( tl, td, bl, bd );
|
|
|
- END;
|
|
|
- huft_free ( td );
|
|
|
- huft_free ( tl );
|
|
|
- END;
|
|
|
- explode := r;
|
|
|
-END;
|
|
|
-(***************************************************************************)
|
|
|
-{.$I z_shrunk.pas} {Unshrink function}
|
|
|
-{*************************** unshrink **********************************}
|
|
|
-{Written and NOT copyrighted by Christian Ghisler.
|
|
|
- I have rewritten unshrink because the original
|
|
|
- function was copyrighted by Mr. Smith of Info-zip
|
|
|
- This funtion here is now completely FREE!!!!
|
|
|
- The only right I claim on this code is that
|
|
|
- noone else claims a copyright on it!}
|
|
|
-
|
|
|
-
|
|
|
-CONST max_code = 8192;
|
|
|
- max_stack = 8192;
|
|
|
- initial_code_size = 9;
|
|
|
- final_code_size = 13;
|
|
|
- write_max = wsize -3 * ( max_code -256 ) -max_stack -2; {Rest of slide=write buffer}
|
|
|
- {=766 bytes}
|
|
|
-
|
|
|
-TYPE prev = ARRAY [ 257..max_code ] of integer;
|
|
|
- pprev = ^prev;
|
|
|
- cds = ARRAY [ 257..max_code ] of char;
|
|
|
- pcds = ^cds;
|
|
|
- stacktype = ARRAY [ 0..max_stack ] of char;
|
|
|
- pstacktype = ^stacktype;
|
|
|
- writebuftype = ARRAY [ 0..write_max ] of char; {write buffer}
|
|
|
- pwritebuftype = ^writebuftype;
|
|
|
-
|
|
|
-VAR previous_code : pprev; {previous code trie}
|
|
|
- actual_code : pcds; {actual code trie}
|
|
|
- stack : pstacktype; {Stack for output}
|
|
|
- writebuf : pwritebuftype; {Write buffer}
|
|
|
- next_free, {Next free code in trie}
|
|
|
- write_ptr : integer; {Pointer to output buffer}
|
|
|
-
|
|
|
-FUNCTION unshrink_flush : boolean;
|
|
|
-VAR
|
|
|
-n : nword;
|
|
|
-b : boolean;
|
|
|
-BEGIN
|
|
|
- {$I-}
|
|
|
- blockwrite ( outfile, writebuf^ [ 0 ], write_ptr, n );
|
|
|
- {$I+}
|
|
|
- b := ( n = write_ptr ) AND ( ioresult = 0 ); {True-> alles ok}
|
|
|
- UpdateCRC ( iobuf ( pointer ( @writebuf^ [ 0 ] ) ^ ), write_ptr );
|
|
|
- {--}
|
|
|
-{$IFDEF FPC}
|
|
|
- IF ( b = TRUE ) AND Assigned(ZipReport) {callback report for high level functions}
|
|
|
-{$ELSE}
|
|
|
- IF ( b = TRUE ) AND ( @ZipReport <> NIL ) {callback report for high level functions}
|
|
|
-{$ENDIF}
|
|
|
- THEN BEGIN
|
|
|
- WITH ZipRec DO BEGIN
|
|
|
- Status := file_unzipping;
|
|
|
- ZipReport ( n, @ZipRec ); {report the actual bytes written}
|
|
|
- END;
|
|
|
- END; {report}
|
|
|
- unshrink_flush := b;
|
|
|
-END;
|
|
|
-
|
|
|
-FUNCTION write_char ( c : char ) : boolean;
|
|
|
-BEGIN
|
|
|
- writebuf^ [ write_ptr ] := c;
|
|
|
- inc ( write_ptr );
|
|
|
- IF write_ptr > write_max THEN BEGIN
|
|
|
- write_char := unshrink_flush;
|
|
|
- write_ptr := 0;
|
|
|
- END ELSE write_char := TRUE;
|
|
|
-END;
|
|
|
-
|
|
|
-PROCEDURE ClearLeafNodes;
|
|
|
-VAR pc, {previous code}
|
|
|
- i, {index}
|
|
|
- act_max_code : integer; {max code to be searched for leaf nodes}
|
|
|
- previous : pprev; {previous code trie}
|
|
|
-
|
|
|
-BEGIN
|
|
|
- previous := previous_code;
|
|
|
- act_max_code := next_free -1;
|
|
|
- FOR i := 257 TO act_max_code DO
|
|
|
- previous^ [ i ] := previous^ [ i ] OR $8000;
|
|
|
- FOR i := 257 TO act_max_code DO BEGIN
|
|
|
- pc := previous^ [ i ] AND NOT $8000;
|
|
|
- IF pc > 256 THEN
|
|
|
- previous^ [ pc ] := previous^ [ pc ] AND ( NOT $8000 );
|
|
|
- END;
|
|
|
- {Build new free list}
|
|
|
- pc := -1;
|
|
|
- next_free := -1;
|
|
|
- FOR i := 257 TO act_max_code DO
|
|
|
- IF previous^ [ i ] AND $C000 <> 0 THEN BEGIN {Either free before or marked now}
|
|
|
- IF pc <> -1 THEN previous^ [ pc ] := -i {Link last item to this item}
|
|
|
- ELSE next_free := i;
|
|
|
- pc := i;
|
|
|
- END;
|
|
|
- IF pc <> -1 THEN
|
|
|
- previous^ [ pc ] := -act_max_code -1;
|
|
|
-END;
|
|
|
-
|
|
|
-
|
|
|
-FUNCTION unshrink : integer;
|
|
|
-
|
|
|
-VAR incode : integer; {code read in}
|
|
|
- lastincode : integer; {last code read in}
|
|
|
- lastoutcode : char; {last code emitted}
|
|
|
- code_size : byte; {Actual code size}
|
|
|
- stack_ptr, {Stackpointer}
|
|
|
- new_code, {Save new code read}
|
|
|
- code_mask, {mask for coding}
|
|
|
- i : integer; {Index}
|
|
|
- bits_to_read : longint;
|
|
|
-
|
|
|
-BEGIN
|
|
|
- IF compsize = maxlongint THEN BEGIN {Compressed Size was not in header!}
|
|
|
- unshrink := unzip_NotSupported;
|
|
|
- exit
|
|
|
- END;
|
|
|
- inpos := 0; {Input buffer position}
|
|
|
- readpos := -1; {Nothing read}
|
|
|
-
|
|
|
- {initialize window, bit buffer}
|
|
|
- w := 0;
|
|
|
- k := 0;
|
|
|
- b := 0;
|
|
|
-
|
|
|
- {Initialize pointers for various buffers}
|
|
|
- previous_code := @slide [ 0 ];
|
|
|
- actual_code := @slide [ sizeof ( prev ) ];
|
|
|
- stack := @slide [ sizeof ( prev ) + sizeof ( cds ) ];
|
|
|
- writebuf := @slide [ sizeof ( prev ) + sizeof ( cds ) + sizeof ( stacktype ) ];
|
|
|
- fillchar ( slide^, wsize, #0 );
|
|
|
-
|
|
|
- {initialize free codes list}
|
|
|
- FOR i := 257 TO max_code DO
|
|
|
- previous_code^ [ i ] := - ( i + 1 );
|
|
|
- next_free := 257;
|
|
|
- stack_ptr := max_stack;
|
|
|
- write_ptr := 0;
|
|
|
- code_size := initial_code_size;
|
|
|
- code_mask := mask_bits [ code_size ];
|
|
|
-
|
|
|
- NEEDBITS ( code_size );
|
|
|
- incode := b AND code_mask;
|
|
|
- DUMPBITS ( code_size );
|
|
|
-
|
|
|
- lastincode := incode;
|
|
|
- lastoutcode := char ( incode );
|
|
|
- IF NOT write_char ( lastoutcode ) THEN BEGIN
|
|
|
- unshrink := unzip_writeErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
-
|
|
|
- bits_to_read := 8 * compsize -code_size; {Bits to be read}
|
|
|
-
|
|
|
- WHILE NOT totalabort AND ( bits_to_read >= code_size ) DO BEGIN
|
|
|
- NEEDBITS ( code_size );
|
|
|
- incode := b AND code_mask;
|
|
|
- DUMPBITS ( code_size );
|
|
|
- dec ( bits_to_read, code_size );
|
|
|
- IF incode = 256 THEN BEGIN {Special code}
|
|
|
- NEEDBITS ( code_size );
|
|
|
- incode := b AND code_mask;
|
|
|
- DUMPBITS ( code_size );
|
|
|
- dec ( bits_to_read, code_size );
|
|
|
- CASE incode of
|
|
|
- 1 : BEGIN
|
|
|
- inc ( code_size );
|
|
|
- IF code_size > final_code_size THEN BEGIN
|
|
|
- unshrink := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- code_mask := mask_bits [ code_size ];
|
|
|
- END;
|
|
|
- 2 : BEGIN
|
|
|
- ClearLeafNodes;
|
|
|
- END;
|
|
|
- ELSE
|
|
|
- unshrink := unzip_ZipFileErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- END ELSE BEGIN
|
|
|
- new_code := incode;
|
|
|
- IF incode < 256 THEN BEGIN {Simple char}
|
|
|
- lastoutcode := char ( incode );
|
|
|
- IF NOT write_char ( lastoutcode ) THEN BEGIN
|
|
|
- unshrink := unzip_writeErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- END ELSE BEGIN
|
|
|
- IF previous_code^ [ incode ] < 0 THEN BEGIN
|
|
|
- stack^ [ stack_ptr ] := lastoutcode;
|
|
|
- dec ( stack_ptr );
|
|
|
- incode := lastincode;
|
|
|
- END;
|
|
|
- WHILE incode > 256 DO BEGIN
|
|
|
- stack^ [ stack_ptr ] := actual_code^ [ incode ];
|
|
|
- dec ( stack_ptr );
|
|
|
- incode := previous_code^ [ incode ];
|
|
|
- END;
|
|
|
- lastoutcode := char ( incode );
|
|
|
- IF NOT write_char ( lastoutcode ) THEN BEGIN
|
|
|
- unshrink := unzip_writeErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- FOR i := stack_ptr + 1 TO max_stack DO
|
|
|
- IF NOT write_char ( stack^ [ i ] ) THEN BEGIN
|
|
|
- unshrink := unzip_writeErr;
|
|
|
- exit
|
|
|
- END;
|
|
|
- stack_ptr := max_stack;
|
|
|
- END;
|
|
|
- incode := next_free;
|
|
|
- IF incode <= max_code THEN BEGIN
|
|
|
- next_free := -previous_code^ [ incode ]; {Next node in free list}
|
|
|
- previous_code^ [ incode ] := lastincode;
|
|
|
- actual_code^ [ incode ] := lastoutcode;
|
|
|
- END;
|
|
|
- lastincode := new_code;
|
|
|
- END;
|
|
|
- END;
|
|
|
- IF totalabort THEN
|
|
|
- unshrink := unzip_UserAbort
|
|
|
- ELSE IF unshrink_flush THEN
|
|
|
- unshrink := unzip_ok
|
|
|
- ELSE
|
|
|
- unshrink := unzip_WriteErr;
|
|
|
-END;
|
|
|
-(***************************************************************************)
|
|
|
-{***************************************************************************}
|
|
|
-FUNCTION GetSupportedMethods : longint;
|
|
|
-BEGIN
|
|
|
- GetSupportedMethods := 1 + ( 1 SHL 1 ) + ( 1 SHL 6 ) + ( 1 SHL 8 );
|
|
|
- {stored, shrunk, imploded and deflated}
|
|
|
-END;
|
|
|
-
|
|
|
-{******************** main low level function: unzipfile ********************}
|
|
|
-{written and not copyrighted by Christian Ghisler}
|
|
|
-FUNCTION unzipfile ( in_name : pchar;out_name : pchar;offset : longint;
|
|
|
- hFileAction : word;cm_index : integer ) : integer;
|
|
|
-VAR err : integer;
|
|
|
- header : plocalheader;
|
|
|
- buf : ARRAY [ 0..80 ] of char;
|
|
|
-{$ifndef linux}
|
|
|
- buf0 : ARRAY [ 0..3 ] of char;
|
|
|
-{$endif}
|
|
|
- timedate : longint;
|
|
|
- originalcrc : longint; {crc from zip-header}
|
|
|
- ziptype, aResult : integer;
|
|
|
- p, p1 : pchar;
|
|
|
- isadir : boolean;
|
|
|
- oldcurdir : string [ 80 ];
|
|
|
-
|
|
|
-BEGIN
|
|
|
- {$ifdef windows}
|
|
|
- IF inuse THEN BEGIN
|
|
|
- {take care of crashed applications!}
|
|
|
- IF ( lastusedtime <> 0 ) AND
|
|
|
- ( abs ( gettickcount -lastusedtime ) > 30000 ) THEN BEGIN {1/2 minute timeout!!!}
|
|
|
- {do not close files or free slide, they were already freed when application crashed!}
|
|
|
- inuse := FALSE;
|
|
|
- {memory for huffman trees is lost}
|
|
|
- END ELSE BEGIN
|
|
|
- unzipfile := unzip_inuse;
|
|
|
- exit
|
|
|
- END;
|
|
|
- END;{inuse}
|
|
|
-
|
|
|
- inuse := TRUE;
|
|
|
- {$endif}
|
|
|
- getmem ( slide, wsize );
|
|
|
- fillchar ( slide [ 0 ], wsize, #0 );
|
|
|
- assign ( infile, in_name );
|
|
|
- filemode := 0;
|
|
|
- {$I-}
|
|
|
- reset ( infile, 1 );
|
|
|
- {$I+}
|
|
|
- IF ioresult <> 0 THEN BEGIN
|
|
|
- freemem ( slide, wsize );
|
|
|
- unzipfile := unzip_ReadErr;
|
|
|
- inuse := FALSE;
|
|
|
- exit
|
|
|
- END;
|
|
|
- {$I-}
|
|
|
- seek ( infile, offset ); {seek to header position}
|
|
|
- {$I+}
|
|
|
- IF ioresult <> 0 THEN BEGIN
|
|
|
- freemem ( slide, wsize );
|
|
|
- close ( infile );
|
|
|
- unzipfile := unzip_ZipFileErr;
|
|
|
- inuse := FALSE;
|
|
|
- exit
|
|
|
- END;
|
|
|
- header := @inbuf;
|
|
|
- {$I-}
|
|
|
- blockread ( infile, header^, sizeof ( header^ ) ); {read in local header}
|
|
|
- {$I+}
|
|
|
- IF ioresult <> 0 THEN BEGIN
|
|
|
- freemem ( slide, wsize );
|
|
|
- close ( infile );
|
|
|
- unzipfile := unzip_ZipFileErr;
|
|
|
- inuse := FALSE;
|
|
|
- exit
|
|
|
- END;
|
|
|
-
|
|
|
- IF strlcomp ( header^.signature, 'PK'#3#4, 4 ) <> 0 THEN BEGIN
|
|
|
- freemem ( slide, wsize );
|
|
|
- close ( infile );
|
|
|
- unzipfile := unzip_ZipFileErr;
|
|
|
- inuse := FALSE;
|
|
|
- exit
|
|
|
- END;
|
|
|
-
|
|
|
- {calculate offset of data}
|
|
|
- offset := offset + header^.filename_len + header^.extra_field_len + sizeof ( tlocalheader );
|
|
|
- timedate := header^.file_timedate;
|
|
|
- IF ( hufttype AND 8 ) = 0 THEN BEGIN {Size and crc at the beginning}
|
|
|
- compsize := header^.compress_size;
|
|
|
- uncompsize := header^.uncompress_size;
|
|
|
- originalcrc := header^.crc_32;
|
|
|
- END ELSE BEGIN
|
|
|
- compsize := maxlongint; {Don't get a sudden zipeof!}
|
|
|
- uncompsize := maxlongint;
|
|
|
- originalcrc := 0
|
|
|
- END;
|
|
|
- ziptype := header^.zip_type; {0=stored, 6=imploded, 8=deflated}
|
|
|
- IF ( 1 SHL ziptype ) AND GetSupportedMethods = 0 THEN BEGIN {Not Supported!!!}
|
|
|
- freemem ( slide, wsize );
|
|
|
- close ( infile );
|
|
|
- unzipfile := unzip_NotSupported;
|
|
|
- inuse := FALSE;
|
|
|
- exit;
|
|
|
- END;
|
|
|
- hufttype := header^.bit_flag;
|
|
|
- IF ( hufttype AND 1 ) <> 0 THEN BEGIN {encrypted}
|
|
|
- freemem ( slide, wsize );
|
|
|
- close ( infile );
|
|
|
- unzipfile := unzip_Encrypted;
|
|
|
- inuse := FALSE;
|
|
|
- exit;
|
|
|
- END;
|
|
|
-
|
|
|
- reachedsize := 0;
|
|
|
- seek ( infile, offset );
|
|
|
-
|
|
|
- assign ( outfile, out_name );
|
|
|
- {$I-}
|
|
|
- rewrite ( outfile, 1 );
|
|
|
- {$I+}
|
|
|
- err := ioresult;
|
|
|
- {create directories not yet in path}
|
|
|
- isadir := ( out_name [ strlen ( out_name ) -1 ] in ['/','\'] );
|
|
|
- IF ( err = 3 ) OR isadir THEN BEGIN {path not found}
|
|
|
- {$I-}
|
|
|
- getdir ( 0, oldcurdir );
|
|
|
- {$I+}
|
|
|
- err := ioresult;
|
|
|
- strcopy ( buf, out_name );
|
|
|
- p1 := strrscan ( buf, DirSep );
|
|
|
- IF p1 <> NIL THEN inc ( p1 ); {pointer to filename}
|
|
|
- p := strtok ( buf, DirSep );
|
|
|
-{$ifndef linux}
|
|
|
- IF ( p <> NIL ) AND ( p [ 1 ] = ':' ) THEN BEGIN
|
|
|
- strcopy ( buf0, 'c:\' ); {set drive}
|
|
|
- buf0 [ 0 ] := p [ 0 ];
|
|
|
- {$ifdef windows}
|
|
|
- setcurdir ( buf0 );
|
|
|
- {$else}
|
|
|
- {$I-}
|
|
|
- chdir ( buf0 );
|
|
|
- {$I+}
|
|
|
- err := ioresult;
|
|
|
- {$endif}
|
|
|
- p := strtok ( NIL, '\' );
|
|
|
- END;
|
|
|
-{$endif}
|
|
|
- WHILE ( p <> NIL ) AND ( p <> p1 ) DO BEGIN
|
|
|
- {$ifdef windows}
|
|
|
- {$ifdef Delphi}
|
|
|
- {$I-}
|
|
|
- chdir ( strpas ( p ) );
|
|
|
- {$I+}
|
|
|
- err := ioresult;
|
|
|
- {$else Delphi}
|
|
|
- setcurdir ( p );
|
|
|
- err := doserror;
|
|
|
- {$endif Delphi}
|
|
|
- {$else Windows}
|
|
|
- {$I-}
|
|
|
- chdir ( strpas ( p ) );
|
|
|
- {$I+}
|
|
|
- err := ioresult;
|
|
|
- {$endif}
|
|
|
- IF err <> 0 THEN BEGIN
|
|
|
- {$ifdef windows}
|
|
|
- createdir ( p );
|
|
|
- err := doserror;
|
|
|
- {$else}
|
|
|
- {$I-}
|
|
|
- mkdir ( strpas ( p ) );
|
|
|
- {$I+}
|
|
|
- err := ioresult;
|
|
|
- {$endif}
|
|
|
- IF err = 0 THEN
|
|
|
- {$I-}
|
|
|
- chdir ( strpas ( p ) );
|
|
|
- {$I+}
|
|
|
- err := ioresult;
|
|
|
- END;
|
|
|
- IF err = 0 THEN
|
|
|
- p := strtok ( NIL, DirSep )
|
|
|
- ELSE
|
|
|
- p := NIL;
|
|
|
- END;
|
|
|
- {$I-}
|
|
|
- chdir ( oldcurdir );
|
|
|
- {$I+}
|
|
|
- err := ioresult;
|
|
|
- IF isadir THEN BEGIN
|
|
|
- freemem ( slide, wsize );
|
|
|
- unzipfile := unzip_Ok; {A directory -> ok}
|
|
|
- close ( infile );
|
|
|
- inuse := FALSE;
|
|
|
- exit;
|
|
|
- END;
|
|
|
- {$I-}
|
|
|
- rewrite ( outfile, 1 );
|
|
|
- {$I+}
|
|
|
- err := ioresult;
|
|
|
- END;
|
|
|
-
|
|
|
- IF err <> 0 THEN BEGIN
|
|
|
- freemem ( slide, wsize );
|
|
|
- unzipfile := unzip_WriteErr;
|
|
|
- close ( infile );
|
|
|
- inuse := FALSE;
|
|
|
- exit
|
|
|
- END;
|
|
|
-
|
|
|
- totalabort := FALSE;
|
|
|
- zipeof := FALSE;
|
|
|
-
|
|
|
- {$ifdef windows}
|
|
|
- dlghandle := hFileAction;
|
|
|
- dlgnotify := cm_index;
|
|
|
- messageloop;
|
|
|
- oldpercent := 0;
|
|
|
- {$endif}
|
|
|
-
|
|
|
- crc32val := $FFFFFFFF;
|
|
|
-
|
|
|
- {Unzip correct type}
|
|
|
- CASE ziptype of
|
|
|
- 0 : aResult := copystored;
|
|
|
- 1 : aResult := unshrink;
|
|
|
- 6 : aResult := explode;
|
|
|
- 8 : aResult := inflate;
|
|
|
- ELSE
|
|
|
- aResult := unzip_NotSupported;
|
|
|
- END;
|
|
|
- unzipfile := aResult;
|
|
|
-
|
|
|
- IF ( aResult = unzip_ok ) AND ( ( hufttype AND 8 ) <> 0 ) THEN BEGIN {CRC at the end}
|
|
|
- dumpbits ( k AND 7 );
|
|
|
- needbits ( 16 );
|
|
|
- originalcrc := b AND $FFFF;
|
|
|
- dumpbits ( 16 );
|
|
|
- needbits ( 16 );
|
|
|
- originalcrc := ( b AND $FFFF ) SHL 16;
|
|
|
- dumpbits ( 16 );
|
|
|
- END;
|
|
|
-
|
|
|
- close ( infile );
|
|
|
- close ( outfile );
|
|
|
- crc32val := NOT ( crc32val ); {one's complement}
|
|
|
- IF aResult <> 0 THEN BEGIN
|
|
|
- erase ( outfile );
|
|
|
- END ELSE IF ( originalcrc <> crc32val ) THEN BEGIN
|
|
|
- unzipfile := unzip_CRCErr;
|
|
|
- erase ( outfile );
|
|
|
- END ELSE BEGIN
|
|
|
- {$ifdef windows}
|
|
|
- oldpercent := 100; {100 percent}
|
|
|
- IF dlghandle <> 0 THEN
|
|
|
- sendmessage ( dlghandle, wm_command, dlgnotify, longint ( @oldpercent ) );
|
|
|
- {$endif}
|
|
|
- filemode := 0;
|
|
|
- reset ( outfile );
|
|
|
- setftime ( outfile, timedate ); {set zipped time and date of oufile}
|
|
|
- close ( outfile );
|
|
|
- END;
|
|
|
- freemem ( slide, wsize );
|
|
|
- inuse := FALSE;
|
|
|
-END;
|
|
|
-{***************************************************************************}
|
|
|
-{***************************************************************************}
|
|
|
-{***************************************************************************}
|
|
|
-{ other functions; zipread.pas }
|
|
|
-CONST mainheader : pchar = 'PK'#5#6;
|
|
|
- maxbufsize = 64000; {Can be as low as 500 Bytes; however, }
|
|
|
- {this would lead to extensive disk reading!}
|
|
|
- {If one entry (including Extra field) is bigger}
|
|
|
- {than maxbufsize, you cannot read it :-( }
|
|
|
-
|
|
|
-TYPE
|
|
|
- pheader = ^theader;
|
|
|
- pmainheader = ^tmainheader;
|
|
|
- tmainheader = PACKED RECORD
|
|
|
- signature : ARRAY [ 0..3 ] of char; {'PK'#5#6}
|
|
|
- thisdisk,
|
|
|
- centralstartdisk,
|
|
|
- entries_this_disk,
|
|
|
- entries_central_dir : word;
|
|
|
- headsize,
|
|
|
- headstart : longint;
|
|
|
- comment_len : longint;
|
|
|
- unknown : word;
|
|
|
- END;
|
|
|
- theader = PACKED RECORD
|
|
|
- signature : ARRAY [ 0..3 ] of char; {'PK'#1#2}
|
|
|
- OSversion, {Operating system version}
|
|
|
- OSmadeby : byte; {MSDOS (FAT): 0}
|
|
|
- extract_ver,
|
|
|
- bit_flag,
|
|
|
- zip_type : word;
|
|
|
- file_timedate : longint;
|
|
|
- crc_32,
|
|
|
- compress_size,
|
|
|
- uncompress_size : longint;
|
|
|
- filename_len,
|
|
|
- extra_field_len,
|
|
|
- file_comment_len,
|
|
|
- disk_number_start,
|
|
|
- internal_attr : word;
|
|
|
- external_attr : ARRAY [ 0..3 ] of byte;
|
|
|
- offset_local_header : longint;
|
|
|
- END;
|
|
|
-
|
|
|
-{*********** Fill out tZipRec structure with next entry *************}
|
|
|
-
|
|
|
-FUNCTION filloutRec ( VAR zprec : tZipRec ) : integer;
|
|
|
-VAR p : pchar;
|
|
|
- incr : longint;
|
|
|
- header : pheader;
|
|
|
- offs : word;
|
|
|
- old : char;
|
|
|
- f : file;
|
|
|
- extra, err : nword;
|
|
|
-
|
|
|
-BEGIN
|
|
|
- WITH zprec DO BEGIN
|
|
|
- header := pheader ( @buf^ [ localstart ] );
|
|
|
- IF ( bufsize = maxbufsize ) THEN BEGIN {Caution: header bigger than 64k!}
|
|
|
- extra := sizeof ( file );
|
|
|
- IF ( ( localstart + sizeof ( theader ) ) > bufsize ) OR
|
|
|
- ( localstart + header^.filename_len + header^.extra_field_len +
|
|
|
- header^.file_comment_len + sizeof ( theader ) > bufsize )
|
|
|
- THEN BEGIN {Read over end of header}
|
|
|
- move ( buf^ [ bufsize + 1 ], f, extra ); {Restore file}
|
|
|
- move ( buf^ [ localstart ], buf^ [ 0 ], bufsize -localstart ); {Move end to beginning in buffer}
|
|
|
- {$I-}
|
|
|
- blockread ( f, buf^ [ bufsize -localstart ], localstart, err ); {Read in full central dir, up to maxbufsize Bytes}
|
|
|
- {$I+}
|
|
|
- IF ( ioresult <> 0 ) OR ( err + localstart < sizeof ( theader ) ) THEN BEGIN
|
|
|
- filloutrec := unzip_nomoreitems;
|
|
|
- exit
|
|
|
- END;
|
|
|
- move ( f, buf^ [ bufsize + 1 ], extra ); {Save changed file info!}
|
|
|
- localstart := 0;
|
|
|
- header := pheader ( @buf^ [ localstart ] );
|
|
|
- END;
|
|
|
- END;
|
|
|
- IF ( localstart + 4 <= bufsize ) AND {Here is the ONLY correct finish!}
|
|
|
- ( strlcomp ( header^.signature, mainheader, 4 ) = 0 ) THEN BEGIN {Main header}
|
|
|
- filloutrec := unzip_nomoreitems;
|
|
|
- exit
|
|
|
- END;
|
|
|
- IF ( localstart + sizeof ( header ) > bufsize ) OR
|
|
|
- ( localstart + header^.filename_len + header^.extra_field_len +
|
|
|
- header^.file_comment_len + sizeof ( theader ) > bufsize ) OR
|
|
|
- ( strlcomp ( header^.signature, 'PK'#1#2, 4 ) <> 0 ) THEN BEGIN
|
|
|
- filloutrec := unzip_nomoreitems;
|
|
|
- exit
|
|
|
- END;
|
|
|
- size := header^.uncompress_size;
|
|
|
- compressSize := header^.compress_size;
|
|
|
- IF header^.osmadeby = 0 THEN
|
|
|
- attr := header^.external_attr [ 0 ]
|
|
|
- ELSE
|
|
|
- attr := 0;
|
|
|
- time := header^.file_timedate;
|
|
|
- headeroffset := header^.offset_local_header; {Other header size}
|
|
|
- Packmethod := header^.zip_type;
|
|
|
- offs := localstart + header^.filename_len + sizeof ( header^ );
|
|
|
- old := buf^ [ offs ];
|
|
|
- buf^ [ offs ] := #0; {Repair signature of next block!}
|
|
|
- strlcopy ( filename, pchar ( @buf^ [ localstart + sizeof ( header^ ) ] ), sizeof ( filename ) -1 );
|
|
|
- buf^ [ offs ] := old;
|
|
|
-{$ifndef linux}
|
|
|
- REPEAT {Convert slash to backslash!}
|
|
|
- p := strscan ( filename, '/' );
|
|
|
- IF p <> NIL THEN p [ 0 ] := '\';
|
|
|
- UNTIL p = NIL;
|
|
|
-{$else}
|
|
|
- REPEAT {Convert backslash to slash!}
|
|
|
- p := strscan ( filename, '\' );
|
|
|
- IF p <> NIL THEN p [ 0 ] := '/';
|
|
|
- UNTIL p = NIL;
|
|
|
-{$endif}
|
|
|
- incr := header^.filename_len + header^.extra_field_len +
|
|
|
- header^.file_comment_len + sizeof ( header^ );
|
|
|
- IF incr <= 0 THEN BEGIN
|
|
|
- filloutrec := unzip_InternalError;
|
|
|
- exit
|
|
|
- END;
|
|
|
- localstart := localstart + incr;
|
|
|
- filloutrec := unzip_ok;
|
|
|
- END;
|
|
|
-END;
|
|
|
-
|
|
|
-{**************** Get first entry from ZIP file ********************}
|
|
|
-FUNCTION GetFirstInZip ( zipfilename : pchar;VAR zprec : tZipRec ) : integer;
|
|
|
-VAR bufstart, headerstart, start : longint;
|
|
|
- err, i : integer;
|
|
|
- mainh : pmainheader;
|
|
|
- f : file;
|
|
|
- extra : word; {Extra bytes for saving File!}
|
|
|
-
|
|
|
-BEGIN
|
|
|
- WITH zprec DO BEGIN
|
|
|
- assign ( f, zipfilename );
|
|
|
- filemode := 0; {Others may read or write};
|
|
|
- {$I-}
|
|
|
- reset ( f, 1 );
|
|
|
- {$I+}
|
|
|
- IF ioresult <> 0 THEN BEGIN
|
|
|
- GetFirstInZip := unzip_FileError;
|
|
|
- exit
|
|
|
- END;
|
|
|
- size := filesize ( f );
|
|
|
- IF size = 0 THEN BEGIN
|
|
|
- GetFirstInZip := unzip_FileError;
|
|
|
- {$I-}
|
|
|
- close ( f );
|
|
|
- {$I+}
|
|
|
- exit
|
|
|
- END;
|
|
|
- bufsize := 4096; {in 4k-blocks}
|
|
|
- IF size > bufsize THEN BEGIN
|
|
|
- bufstart := size -bufsize;
|
|
|
- END ELSE BEGIN
|
|
|
- bufstart := 0;
|
|
|
- bufsize := size;
|
|
|
- END;
|
|
|
- getmem ( buf, bufsize + 1 ); {#0 at the end of filemname}
|
|
|
-
|
|
|
- {Search from back of file to central directory start}
|
|
|
- start := -1; {Nothing found}
|
|
|
- REPEAT
|
|
|
- {$I-}
|
|
|
- seek ( f, bufstart );
|
|
|
- {$I+}
|
|
|
- IF ioresult <> 0 THEN BEGIN
|
|
|
- GetFirstInZip := unzip_FileError;
|
|
|
- freeMem ( buf, bufsize + 1 );
|
|
|
- buf := NIL;
|
|
|
- {$I-}
|
|
|
- close ( f );
|
|
|
- {$I+}
|
|
|
- exit
|
|
|
- END;
|
|
|
- {$I-}
|
|
|
- blockread ( f, buf^, bufsize, err );
|
|
|
- {$I+}
|
|
|
- IF ( ioresult <> 0 ) OR ( err <> bufsize ) THEN BEGIN
|
|
|
- GetFirstInZip := unzip_FileError;
|
|
|
- freeMem ( buf, bufsize + 1 );
|
|
|
- buf := NIL;
|
|
|
- {$I-}
|
|
|
- close ( f );
|
|
|
- {$I+}
|
|
|
- exit
|
|
|
- END;
|
|
|
-
|
|
|
- IF bufstart = 0 THEN start := maxlongint;{Break}
|
|
|
-
|
|
|
- FOR i := bufsize -22 DOWNTO 0 DO BEGIN {Search buffer backwards}
|
|
|
- IF ( buf^ [ i ] = 'P' ) AND ( buf^ [ i + 1 ] = 'K' ) AND ( buf^ [ i + 2 ] = #5 ) AND ( buf^ [ i + 3 ] = #6 )
|
|
|
- THEN BEGIN {Header found!!!}
|
|
|
- start := bufstart + i;
|
|
|
- break;
|
|
|
- END;
|
|
|
- END;
|
|
|
-
|
|
|
- IF start = -1 THEN BEGIN {Nothing found yet}
|
|
|
- dec ( bufstart, bufsize -22 ); {Full header in buffer!}
|
|
|
- IF bufstart < 0 THEN bufstart := 0;
|
|
|
- END;
|
|
|
- UNTIL start >= 0;
|
|
|
- IF ( start = maxlongint ) THEN BEGIN {Nothing found}
|
|
|
- GetFirstInZip := unzip_FileError;
|
|
|
- freeMem ( buf, bufsize + 1 );
|
|
|
- buf := NIL;
|
|
|
- {$I-}
|
|
|
- close ( f );
|
|
|
- {$I+}
|
|
|
- exit
|
|
|
- END;
|
|
|
- mainh := pmainheader ( @buf^ [ start -bufstart ] );
|
|
|
- headerstart := mainh^.headstart;
|
|
|
- localstart := 0;
|
|
|
- freeMem ( buf, bufsize + 1 );
|
|
|
- IF ( localstart + sizeof ( theader ) > start ) THEN BEGIN
|
|
|
- buf := NIL;
|
|
|
- GetFirstInZip := unzip_InternalError;
|
|
|
- {$I-}
|
|
|
- close ( f );
|
|
|
- {$I+}
|
|
|
- exit
|
|
|
- END;
|
|
|
- bufstart := headerstart;
|
|
|
- start := start -headerstart + 4; {size for central dir,Including main header signature}
|
|
|
- IF start >= maxbufsize THEN BEGIN
|
|
|
- bufsize := maxbufsize; {Max buffer size, limit of around 1000 items!}
|
|
|
- extra := sizeof ( file ) {Save file information for later reading!}
|
|
|
- END ELSE BEGIN
|
|
|
- bufsize := start;
|
|
|
- extra := 0
|
|
|
- END;
|
|
|
- getmem ( buf, bufsize + 1 + extra );
|
|
|
- {$I-}
|
|
|
- seek ( f, bufstart );
|
|
|
- {$I+}
|
|
|
- IF ioresult <> 0 THEN BEGIN
|
|
|
- GetFirstInZip := unzip_FileError;
|
|
|
- freeMem ( buf, bufsize + 1 + extra );
|
|
|
- buf := NIL;
|
|
|
- {$I-}
|
|
|
- close ( f );
|
|
|
- {$I+}
|
|
|
- exit
|
|
|
- END;
|
|
|
- {$I-}
|
|
|
- blockread ( f, buf^, bufsize, err ); {Read in full central dir, up to maxbufsize Bytes}
|
|
|
- {$I+}
|
|
|
- IF ioresult <> 0 THEN BEGIN
|
|
|
- GetFirstInZip := unzip_FileError;
|
|
|
- freeMem ( buf, bufsize + 1 + extra );
|
|
|
- buf := NIL;
|
|
|
- {$I-}
|
|
|
- close ( f );
|
|
|
- {$I+}
|
|
|
- exit
|
|
|
- END;
|
|
|
- IF extra = 0 THEN
|
|
|
- {$I-} close ( f ) {$I+}
|
|
|
- ELSE move ( f, buf^ [ bufsize + 1 ], extra ); {Save file info!}
|
|
|
- err := filloutRec ( zprec );
|
|
|
- IF err <> unzip_ok THEN BEGIN
|
|
|
- CloseZipFile ( zprec );
|
|
|
- GetFirstInZip := err;
|
|
|
- exit
|
|
|
- END;
|
|
|
- GetFirstInZip := err;
|
|
|
- END;
|
|
|
-END;
|
|
|
-
|
|
|
-{**************** Get next entry from ZIP file ********************}
|
|
|
-FUNCTION GetNextInZip ( VAR Zprec : tZiprec ) : integer;
|
|
|
-VAR err : integer;
|
|
|
-BEGIN
|
|
|
- WITH zprec DO BEGIN
|
|
|
- IF ( buf <> NIL ) THEN BEGIN {Main Header at the end}
|
|
|
- err := filloutRec ( zprec );
|
|
|
- IF err <> unzip_ok THEN BEGIN
|
|
|
- CloseZipFile ( ZPRec );
|
|
|
- END;
|
|
|
- GetNextInZip := err;
|
|
|
- END ELSE GetNextInZip := unzip_NoMoreItems;
|
|
|
- END
|
|
|
-END;
|
|
|
-
|
|
|
-{**************** VERY simple test for zip file ********************}
|
|
|
-FUNCTION isZip ( filename : pchar ) : boolean;
|
|
|
-VAR
|
|
|
- myname : tdirtype;
|
|
|
- l, err : integer;
|
|
|
- f : file;
|
|
|
- buf : ARRAY [ 0..4 ] of char;
|
|
|
- oldcurdir : string{$ifndef BIT32} [ 80 ]{$endif};
|
|
|
-
|
|
|
-BEGIN
|
|
|
- filemode := 0;
|
|
|
- {$I-}
|
|
|
- getdir ( 0, oldcurdir );
|
|
|
- {$I+}
|
|
|
- err := ioresult;
|
|
|
- isZip := FALSE;
|
|
|
- IF ( strscan ( filename, '.' ) <> NIL )
|
|
|
- AND ( strpos ( filename, '.exe' ) = NIL ) THEN BEGIN
|
|
|
- strcopy ( myname, filename );
|
|
|
- l := strlen ( myname );
|
|
|
- IF myname [ l -1 ] = DirSep THEN myname [ l -1 ] := #0;
|
|
|
- {$I-}
|
|
|
- chdir ( Strpas ( myname ) );
|
|
|
- {$I+}
|
|
|
- IF ioresult <> 0 THEN BEGIN
|
|
|
- assign ( f, Strpas ( myname ) );
|
|
|
- filemode := 0; {Others may read or write};
|
|
|
- {$I-}
|
|
|
- reset ( f, 1 );
|
|
|
- {$I+}
|
|
|
- IF ioresult = 0 THEN BEGIN
|
|
|
- {$I-}
|
|
|
- blockread ( f, buf, 4, err );
|
|
|
- {$I+}
|
|
|
- IF ( ioresult = 0 ) THEN BEGIN
|
|
|
- IF ( err = 4 ) AND ( buf [ 0 ] = 'P' ) AND ( buf [ 1 ] = 'K' )
|
|
|
- AND ( buf [ 2 ] = #3 ) AND ( buf [ 3 ] = #4 ) THEN isZip := TRUE
|
|
|
- END;
|
|
|
- {$I-}
|
|
|
- close ( f );
|
|
|
- {$I+}
|
|
|
- err := ioresult; {only clears ioresult variable}
|
|
|
- END;
|
|
|
- END;
|
|
|
- END;
|
|
|
- {$I-}
|
|
|
- chdir ( oldcurdir );
|
|
|
- {$I+}
|
|
|
- err := ioresult;
|
|
|
-END;
|
|
|
-
|
|
|
-{**************** free ZIP buffers ********************}
|
|
|
-PROCEDURE CloseZipFile ( VAR Zprec : tZiprec ); {Only free buffer, file only open in Getfirstinzip}
|
|
|
-VAR
|
|
|
- f : file;
|
|
|
- extra : word;
|
|
|
-BEGIN
|
|
|
- WITH zprec DO BEGIN
|
|
|
- IF buf <> NIL THEN BEGIN
|
|
|
- IF ( bufsize = maxbufsize ) THEN BEGIN {Caution: header bigger than 64k!}
|
|
|
- extra := sizeof ( file );
|
|
|
- move ( buf^ [ bufsize + 1 ], f, extra ); {Restore file}
|
|
|
- {$I-}
|
|
|
- close ( f );
|
|
|
- {$I+}
|
|
|
- IF ioresult <> 0 THEN ;
|
|
|
- END ELSE extra := 0;
|
|
|
- freemem ( buf, bufsize + 1 + extra );
|
|
|
- buf := NIL
|
|
|
- END;
|
|
|
- END
|
|
|
-END;
|
|
|
-{***************************************************************************}
|
|
|
-{***************************************************************************}
|
|
|
-{********** routines by the African Chief **********************************}
|
|
|
-{***************************************************************************}
|
|
|
-{***************************************************************************}
|
|
|
-{$ifndef Delphi}
|
|
|
-FUNCTION FileExists ( CONST fname : string ) : boolean; {simple fileexist function}
|
|
|
-VAR
|
|
|
-f : file;
|
|
|
-i : byte;
|
|
|
-BEGIN
|
|
|
- i := filemode;
|
|
|
- filemode := 0;
|
|
|
- assign ( f, fname );
|
|
|
- {$i-}
|
|
|
- Reset ( f, 1 );
|
|
|
- filemode := i;
|
|
|
- FileExists := ioresult = 0;
|
|
|
- Close ( f ); IF ioresult <> 0 THEN;
|
|
|
- {$i+}
|
|
|
-END;
|
|
|
-{$endif Delphi}
|
|
|
-
|
|
|
-PROCEDURE DummyReport ( Retcode : longint;Rec : pReportRec );
|
|
|
-{$ifdef Windows}{$ifdef win32}STDCALL;{$else}EXPORT;{$endif}{$endif}
|
|
|
-{dummy report procedure}
|
|
|
-BEGIN
|
|
|
-END;
|
|
|
-
|
|
|
-FUNCTION DummyQuestion( Rec : pReportRec ) : Boolean;
|
|
|
-{$ifdef Windows}{$ifdef win32}STDCALL;{$else}EXPORT;{$endif}{$endif}
|
|
|
-{dummy question procedure}
|
|
|
-begin
|
|
|
- DummyQuestion:=true;
|
|
|
-end;
|
|
|
-
|
|
|
-FUNCTION Matches ( s : String;CONST main : string ) : Boolean;
|
|
|
-{rudimentary matching function;
|
|
|
- accepts only '', '*.*', 'XXX.*' or '*.XXX'
|
|
|
-}
|
|
|
-FUNCTION extensiononly ( CONST s : string ) : string;{return just the extension}
|
|
|
-VAR i : integer;
|
|
|
-BEGIN
|
|
|
- extensiononly := '';
|
|
|
- i := pos ( '.', s );
|
|
|
- IF i = 0 THEN exit;
|
|
|
- extensiononly := copy ( s, succ ( i ), length ( s ) );
|
|
|
-END;
|
|
|
-
|
|
|
-FUNCTION nameonly ( CONST s : string ) : string;{return just the name}
|
|
|
-VAR i : integer;
|
|
|
-BEGIN
|
|
|
- nameonly := s;
|
|
|
- i := pos ( '.', s );
|
|
|
- IF i = 0 THEN exit;
|
|
|
- nameonly := copy ( s, 1, pred ( i ) );
|
|
|
-END;
|
|
|
-{!!!!!}
|
|
|
-VAR
|
|
|
-b : boolean;
|
|
|
-i : integer;
|
|
|
-BEGIN
|
|
|
- Matches := TRUE;
|
|
|
- IF ( s = '' ) OR ( s = AllFiles ) THEN exit; {'' or '*.*' = all files match}
|
|
|
- s := upper ( s );
|
|
|
- b := copy ( s, 1, 2 ) = '*.'; {e.g., *.PAS}
|
|
|
- IF b THEN BEGIN
|
|
|
- delete ( s, 1, 2 );
|
|
|
- Matches := s = extensiononly ( upper ( main ) );
|
|
|
- END ELSE BEGIN
|
|
|
- i := length ( s );
|
|
|
- b := s [ i ] = '*'; {e.g. TEST.*}
|
|
|
- IF b THEN BEGIN
|
|
|
- IF s [ pred ( i ) ] = '.' THEN delete ( s, pred ( i ), 2 );
|
|
|
- i := length ( s );
|
|
|
- IF s [ i ] in [ '*', '?' ] THEN dec ( i );{e.g. TEST*.*}
|
|
|
- Matches := Copy ( s, 1, i ) = Copy ( nameonly ( upper ( main ) ), 1, i );
|
|
|
- END ELSE Matches := s = upper ( main );
|
|
|
- END;
|
|
|
-END; { Matches }
|
|
|
-{****************************************************}
|
|
|
-FUNCTION FileUnzip ( SourceZipFile, TargetDirectory, FileSpecs : pChar;
|
|
|
- Report : UnzipReportProc;Question : UnzipQuestionProc ) : integer;
|
|
|
-VAR
|
|
|
- rc : integer;
|
|
|
- r : tziprec;
|
|
|
- buf,
|
|
|
- thename,
|
|
|
- target : ARRAY [ 0..tFSize ] of char;
|
|
|
- Count : integer;
|
|
|
- rSize, cSize : longint;
|
|
|
- s : string [ 255 ];
|
|
|
-
|
|
|
-BEGIN
|
|
|
-{$IFDEF FPC}
|
|
|
- IF not assigned(Report) THEN
|
|
|
- Report := @DummyReport;
|
|
|
- IF not assigned(Question) THEN
|
|
|
- Question := @DummyQuestion;
|
|
|
-{$ELSE}
|
|
|
- IF @Report = nil THEN
|
|
|
- Report := DummyReport;
|
|
|
- IF @Question = nil THEN
|
|
|
- Question := DummyQuestion;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
- Count := 0;
|
|
|
- rSize := 0;
|
|
|
- cSize := 0;
|
|
|
- FileUnzip := unzip_MissingParameter;
|
|
|
- IF ( StrPas ( SourceZipFile ) = '' ) OR ( StrPas ( TargetDirectory ) = '' ) THEN Exit;
|
|
|
-
|
|
|
- Strcopy ( thename, SourceZipFile );
|
|
|
- Strcopy ( target, TargetDirectory );
|
|
|
- IF ( target [ 0 ] <> #0 ) AND ( target [ strlen ( target ) -1 ] <> DirSep )
|
|
|
- THEN strcat ( target, DirSep );
|
|
|
- FileUnzip := unzip_NotZipFile;
|
|
|
- IF NOT iszip ( thename ) THEN exit;
|
|
|
-
|
|
|
- FillChar ( ZipRec, Sizeof ( ZipRec ), #0 );
|
|
|
-
|
|
|
- WITH ZipRec DO BEGIN
|
|
|
- IsaDir := FALSE;
|
|
|
- strcopy ( FileName, thename );
|
|
|
- Size := UnZipSize ( SourceZipFile, CompressSize );
|
|
|
- IF Size = 0 THEN ratio := 0 ELSE
|
|
|
- Ratio := 100 -Round ( ( CompressSize / Size ) * 100 );
|
|
|
- Status := unzip_starting;
|
|
|
- Report ( Status, @ZipRec );
|
|
|
- END; {start of ZIP file}
|
|
|
-
|
|
|
- ZipReport := Report;
|
|
|
-
|
|
|
- rc := getfirstinzip ( thename, r );
|
|
|
- WHILE ( rc = unzip_ok )
|
|
|
- DO BEGIN
|
|
|
- IF ( Matches ( StrPas ( FileSpecs ), Strpas ( R.FileName ) ) )
|
|
|
- THEN BEGIN
|
|
|
- Inc ( rSize, r.Size );
|
|
|
- Inc ( cSize, r.CompressSize );
|
|
|
-
|
|
|
- strcopy ( buf, target );
|
|
|
- IF NoRecurseDirs { no recursion }
|
|
|
- THEN BEGIN
|
|
|
- s := StripPath ( Strpas ( r.filename ) ) + #0;
|
|
|
- Strcat ( buf, @s [ 1 ] );
|
|
|
- END ELSE strcat ( buf, r.filename );
|
|
|
-
|
|
|
-
|
|
|
- WITH ZipRec DO BEGIN { report start of file }
|
|
|
- s := StrPas ( Buf );
|
|
|
- IsaDir := s [ length ( s ) ] = DirSep;
|
|
|
- Time := r.Time;
|
|
|
- Size := r.Size;
|
|
|
- CompressSize := r.CompressSize;
|
|
|
- strcopy ( FileName, buf );
|
|
|
- PackMethod := r.PackMethod;
|
|
|
- Attr := r.Attr;
|
|
|
- IF Size = 0 THEN ratio := 0 ELSE
|
|
|
- Ratio := 100 -Round ( ( CompressSize /Size ) * 100 );
|
|
|
- Status := file_starting;
|
|
|
- IF ( IsaDir ) AND ( NoRecurseDirs )
|
|
|
- THEN {} ELSE
|
|
|
- ZipReport ( Status, @ZipRec );
|
|
|
- END; { start of file }
|
|
|
-
|
|
|
- IF ( FileExists ( StrPas ( buf ) ) )
|
|
|
- AND ( Question ( @ZipRec ) = FALSE )
|
|
|
- THEN BEGIN
|
|
|
- rc := unzip_ok; { we are okay }
|
|
|
- WITH ZipRec DO BEGIN
|
|
|
- Status := file_unzipping;
|
|
|
- PackMethod := 9; { skipped }
|
|
|
- ZipReport ( Size, @ZipRec ); { report uncompressed size }
|
|
|
- END;
|
|
|
- END ELSE BEGIN
|
|
|
- rc := unzipfile ( thename, buf, r.headeroffset, 0,
|
|
|
- {$ifdef windows}vk_escape{$else}27{$endif} ); {Escape interrupts}
|
|
|
- END;
|
|
|
-
|
|
|
- IF rc = unzip_ok
|
|
|
- THEN BEGIN
|
|
|
- Inc ( Count );
|
|
|
- WITH ZipRec DO BEGIN { report end of file }
|
|
|
- Status := file_completed;
|
|
|
- IF ( IsaDir ) AND ( NoRecurseDirs )
|
|
|
- THEN {} ELSE
|
|
|
- ZipReport ( Status, @ZipRec );
|
|
|
- END; { end of file }
|
|
|
- END ELSE BEGIN
|
|
|
- ZipRec.Status := file_failure; {error}
|
|
|
- CASE rc of
|
|
|
- unzip_CRCErr,
|
|
|
- unzip_WriteErr,
|
|
|
- unzip_Encrypted,
|
|
|
- unzip_NotSupported : ZipReport ( rc, @ZipRec );
|
|
|
-
|
|
|
- unzip_ReadErr, unzip_Userabort,
|
|
|
- unzip_FileError, unzip_InternalError,
|
|
|
- unzip_InUse, unzip_ZipFileErr :
|
|
|
- BEGIN
|
|
|
- ZipRec.Status := unzip_SeriousError;
|
|
|
- FileUnzip := unzip_SeriousError; {Serious error, force abort}
|
|
|
- ZipReport ( unzip_SeriousError, @ZipRec );
|
|
|
- closezipfile ( r );
|
|
|
- ZipReport := NIL;
|
|
|
- ZipQuestion := NIL;
|
|
|
- exit;
|
|
|
- END;
|
|
|
- END; {case rc}
|
|
|
- Continue;
|
|
|
- {rc:=getnextinzip(r);}
|
|
|
- END; {else}
|
|
|
- END; { if Matches }
|
|
|
- rc := getnextinzip ( r );
|
|
|
- END; {while }
|
|
|
-
|
|
|
- closezipfile ( r ); {Free memory used for central directory info}
|
|
|
-
|
|
|
- WITH ZipRec DO BEGIN { report end of ZIP file }
|
|
|
- Time := -1;
|
|
|
- Attr := -1;
|
|
|
- PackMethod := 0;
|
|
|
- Size := rSize;
|
|
|
- CompressSize := cSize;
|
|
|
- strcopy ( FileName, thename );
|
|
|
- IF Size = 0 THEN ratio := 0 ELSE
|
|
|
- Ratio := 100 -Round ( ( CompressSize /Size ) * 100 );
|
|
|
- Status := unzip_completed;
|
|
|
- ZipReport ( Status, @ZipRec );
|
|
|
- END; { end of ZIP file }
|
|
|
-
|
|
|
- ZipReport := NIL;
|
|
|
- ZipQuestion := NIL;
|
|
|
- FileUnzip := Count;
|
|
|
-END; { FileUnzip }
|
|
|
-{***************************************************************************}
|
|
|
-FUNCTION FileUnzipEx ( SourceZipFile, TargetDirectory, FileSpecs : pChar ) : integer;
|
|
|
-BEGIN
|
|
|
- FileUnzipEx :=
|
|
|
- FileUnzip ( SourceZipFile, TargetDirectory, FileSpecs, ZipReport, ZipQuestion );
|
|
|
-END; { FileUnzipEx }
|
|
|
-{***************************************************************************}
|
|
|
-FUNCTION Viewzip ( SourceZipFile, FileSpecs : pChar; Report : UnzipReportProc ) : integer;
|
|
|
-VAR
|
|
|
- rc : integer;
|
|
|
- r : tziprec;
|
|
|
- thename : ARRAY [ 0..tFSize ] of char;
|
|
|
- Count : integer;
|
|
|
- rSize, cSize : longint;
|
|
|
-
|
|
|
-BEGIN
|
|
|
- Count := 0;
|
|
|
- rSize := 0;
|
|
|
- cSize := 0;
|
|
|
- Viewzip := unzip_MissingParameter;
|
|
|
-{$IFDEF FPC}
|
|
|
- IF ( StrPas ( SourceZipFile ) = '' ) or
|
|
|
- not assigned(Report) THEN
|
|
|
- exit;
|
|
|
-{$ELSE}
|
|
|
- IF ( StrPas ( SourceZipFile ) = '' ) OR ( @Report = NIL ) THEN Exit;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
- Strcopy ( thename, SourceZipFile );
|
|
|
- ViewZip := unzip_NotZipFile;
|
|
|
- IF NOT iszip ( thename ) THEN exit;
|
|
|
- FillChar ( ZipRec, Sizeof ( ZipRec ), #0 );
|
|
|
-
|
|
|
- rc := getfirstinzip ( thename, r );
|
|
|
- WHILE ( rc = unzip_ok )
|
|
|
- DO BEGIN
|
|
|
- IF ( Matches ( StrPas ( FileSpecs ), Strpas ( R.FileName ) ) ) THEN BEGIN
|
|
|
- Inc ( rSize, r.Size );
|
|
|
- Inc ( cSize, r.CompressSize );
|
|
|
- WITH ZipRec DO BEGIN
|
|
|
- Time := r.Time;
|
|
|
- Size := r.Size;
|
|
|
- CompressSize := r.CompressSize;
|
|
|
- strcopy ( FileName, r.Filename );
|
|
|
- PackMethod := r.PackMethod;
|
|
|
- Attr := r.Attr;
|
|
|
- IF Size = 0 THEN ratio := 0 ELSE
|
|
|
- Ratio := 100 -Round ( ( CompressSize /Size ) * 100 );
|
|
|
- END;
|
|
|
- Inc ( Count );
|
|
|
- Report ( rc, @ZipRec );
|
|
|
- END; {matches}
|
|
|
- rc := getnextinzip ( r );
|
|
|
- END; {while }
|
|
|
- closezipfile ( r );
|
|
|
-
|
|
|
- WITH ZipRec DO BEGIN
|
|
|
- Time := -1;
|
|
|
- Attr := -1;
|
|
|
- PackMethod := 0;
|
|
|
- Size := rSize;
|
|
|
- CompressSize := cSize;
|
|
|
- strcopy ( FileName, thename );
|
|
|
- IF Size = 0 THEN ratio := 0 ELSE
|
|
|
- Ratio := 100 -Round ( ( CompressSize /Size ) * 100 );
|
|
|
- END;
|
|
|
- Report ( Count, @ZipRec );
|
|
|
- ViewZip := Count;
|
|
|
-END; { ViewZip }
|
|
|
-{***************************************************************************}
|
|
|
-FUNCTION UnZipSize ( SourceZipFile : pChar;VAR Compressed : Longint ) : longint;
|
|
|
-VAR
|
|
|
- rc : integer;
|
|
|
- r : tziprec;
|
|
|
- thename : ARRAY [ 0..tFSize ] of char;
|
|
|
- Count : longint;
|
|
|
- f : file;
|
|
|
-
|
|
|
-BEGIN
|
|
|
- Compressed := 0;
|
|
|
- UnZipSize := 0;
|
|
|
- IF ( StrPas ( SourceZipFile ) = '' ) THEN Exit;
|
|
|
- System.Assign ( f, StrPas ( SourceZipFile ) );
|
|
|
- count := filemode;
|
|
|
- filemode := 0;
|
|
|
- {$i-}
|
|
|
- Reset ( f, 1 );
|
|
|
- filemode := count;
|
|
|
- IF ioresult <> 0 THEN exit;
|
|
|
- Count := filesize ( f );
|
|
|
- close ( f );
|
|
|
- UnZipSize := count;
|
|
|
- Compressed := count;
|
|
|
- Strcopy ( thename, SourceZipFile );
|
|
|
- IF NOT iszip ( thename ) THEN exit;
|
|
|
- Count := 0;
|
|
|
- Compressed := 0;
|
|
|
- rc := getfirstinzip ( thename, r );
|
|
|
- WHILE ( rc = unzip_ok )
|
|
|
- DO BEGIN
|
|
|
- Inc ( Count, r.Size );
|
|
|
- Inc ( Compressed, r.CompressSize );
|
|
|
- rc := getnextinzip ( r );
|
|
|
- END; {while }
|
|
|
- closezipfile ( r );
|
|
|
- UnZipSize := Count;
|
|
|
-END; { UnZipSize }
|
|
|
-{***************************************************************************}
|
|
|
-FUNCTION SetUnZipReportProc ( aProc : UnzipReportProc ) : Pointer;
|
|
|
-BEGIN
|
|
|
-{$IFDEF FPC}
|
|
|
- SetUnZipReportProc := ZipReport; {save and return original}
|
|
|
-{$ELSE}
|
|
|
- SetUnZipReportProc := @ZipReport; {save and return original}
|
|
|
-{$ENDIF}
|
|
|
- ZipReport := aProc;
|
|
|
-END; { SetUnZipReportProc }
|
|
|
-{***************************************************************************}
|
|
|
-FUNCTION SetUnZipQuestionProc ( aProc : UnzipQuestionProc ) : Pointer;
|
|
|
-BEGIN
|
|
|
-{$IFDEF FPC}
|
|
|
- SetUnZipQuestionProc := ZipQuestion; {save and return original}
|
|
|
-{$ELSE}
|
|
|
- SetUnZipQuestionProc := @ZipQuestion; {save and return original}
|
|
|
-{$ENDIF}
|
|
|
- ZipQuestion := aProc;
|
|
|
-END; { SetUnZipQuestionProc }
|
|
|
-{***************************************************************************}
|
|
|
-FUNCTION SetNoRecurseDirs ( DontRecurse : Boolean ) : Boolean;
|
|
|
-BEGIN
|
|
|
- SetNoRecurseDirs := NoRecurseDirs;
|
|
|
- NoRecurseDirs := DontRecurse;
|
|
|
-END; { SetNoRecurseDirs }
|
|
|
-{***************************************************************************}
|
|
|
-{***************************************************************************}
|
|
|
-PROCEDURE ChfUnzip_Init;
|
|
|
-BEGIN
|
|
|
- slide := NIL; {unused}
|
|
|
- {$ifdef windows}
|
|
|
- inuse := FALSE; {Not yet in use!}
|
|
|
- lastusedtime := 0; {Not yet used}
|
|
|
- {$endif}
|
|
|
- if inuse then; { to remove warning }
|
|
|
- SetUnZipReportProc ( NIL );
|
|
|
- SetUnZipQuestionProc ( NIL );
|
|
|
- SetNoRecurseDirs ( FALSE );
|
|
|
-END;
|
|
|
-{***************************************************************************}
|
|
|
-{***************************************************************************}
|
|
|
-{***************************************************************************}
|
|
|
-BEGIN
|
|
|
- ChfUnzip_Init;
|
|
|
-END.
|
|
|
-{
|
|
|
- $Log$
|
|
|
- Revision 1.1 2000-07-13 06:30:22 michael
|
|
|
- + Initial import
|
|
|
-
|
|
|
- Revision 1.5 2000/02/24 17:47:47 peter
|
|
|
- * last fixes for 0.99.14a release
|
|
|
-
|
|
|
- Revision 1.4 2000/01/26 21:49:33 peter
|
|
|
- * install.pas compilable by FPC again
|
|
|
- * removed some notes from unzip.pas
|
|
|
- * support installer creation under linux (install has name conflict)
|
|
|
-
|
|
|
- Revision 1.3 1999/06/10 15:00:16 peter
|
|
|
- * fixed to compile for not os2
|
|
|
- * update install.dat
|
|
|
-
|
|
|
- Revision 1.2 1999/06/10 07:28:28 hajny
|
|
|
- * compilable with TP again
|
|
|
-
|
|
|
- Revision 1.1 1999/02/19 16:45:26 peter
|
|
|
- * moved to fpinst/ directory
|
|
|
- + makefile
|
|
|
-
|
|
|
-}
|
|
|
-
|
peter