From 94c6c7ed697f6cf3a2fc2cb66b8e3c1faf0c2225 Mon Sep 17 00:00:00 2001 From: peter Date: Tue, 29 Jan 2002 17:59:15 +0000 Subject: [PATCH] * moved installer --- install/fpinst/inststr.pas | 109 - install/fpinst/unzip.pas | 3357 -------------------- install/fpinst/unzipdll.pas | 256 -- install/fpinst/ziptypes.pas | 215 -- {install/fpinst => installer}/Makefile | 48 +- {install/fpinst => installer}/Makefile.fpc | 12 +- {install/fpinst => installer}/install.dat | 11 +- {install/fpinst => installer}/install.def | 0 {install/fpinst => installer}/install.pas | 507 +-- {install/fpinst => installer}/scroll.pas | 13 +- 10 files changed, 324 insertions(+), 4204 deletions(-) delete mode 100644 install/fpinst/inststr.pas delete mode 100644 install/fpinst/unzip.pas delete mode 100644 install/fpinst/unzipdll.pas delete mode 100644 install/fpinst/ziptypes.pas rename {install/fpinst => installer}/Makefile (96%) rename {install/fpinst => installer}/Makefile.fpc (70%) rename {install/fpinst => installer}/install.dat (95%) rename {install/fpinst => installer}/install.def (100%) rename {install/fpinst => installer}/install.pas (80%) rename {install/fpinst => installer}/scroll.pas (96%) diff --git a/install/fpinst/inststr.pas b/install/fpinst/inststr.pas deleted file mode 100644 index dd09c30df8..0000000000 --- a/install/fpinst/inststr.pas +++ /dev/null @@ -1,109 +0,0 @@ -{ - $Id$ - This file is part Free Pascal - Copyright (c) 2000 by Florian Klaempfl - member of the Free Pascal development team - - This file contains the strings for the FPC install program - - See the file COPYING.FPC, included in this distribution, - for details about the copyright. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - - **********************************************************************} -{$ifdef FPC} -{$MODE OBJFPC} -{$endif FPC} -unit inststr; - - interface - -{$ifndef FPC} - const -{$else FPC} - resourcestring -{$endif FPC} - dialog_language_title = 'Please choose your language'; - dialog_language_english = 'English'; - dialog_language_dutch = 'Dutch'; - dialog_language_french = 'French'; - dialog_language_russian = 'Russian'; - dialog_language_hungarian = 'Hungarian'; - dialog_language_spanish = 'Spanish'; - dialog_language_german = 'German'; - dialog_language_russian_win = 'Russian (Windows)'; - - dialog_enddialog_title = 'Installation Successfull'; - - dialog_unzipdialog_title = 'Extracting Packages'; - - dialog_install_continue = '~C~ontinue'; - dialog_install_quit = '~Q~uit'; - dialog_install_basepath = '~B~ase path'; - dialog_install_config = 'Con~f~ig'; - dialog_install_createppccfg = 'create fpc.cfg'; - dialog_install_general = '~G~eneral'; - - msg_nocomponents = 'No components selected.'#13#13'Abort installation?'; - msg_overwrite_cfg = 'Config %s already exists, continue writing default config?'; - msg_problems_writing_cfg = #3'A config not written.'#13#3'%s'#13#3'couldn''t be created'; - msg_problems_create_dir = 'A file with the name chosen as the installation '+ - 'directory exists already. Cannot create this directory!'; - msg_no_components_selected = 'No components selected.'#13#13'Create a configfile ?'; - msg_select_dir = 'Please, choose the directory for installation first.'; - msg_no_components_found = 'No components found to install, aborting.'; - msg_install_dir_exists = 'The installation directory exists already. '+ - 'Do you want to continue ?'; - msg_install_cant_be_created = 'The installation directory %s couldn''t be created'; - msg_file_not_found = 'File %s not found!'; - msg_no_lfn = 'The operating system doesn''t support LFN (long file names),'+ - ' so some packages won''t be installed'; - msg_corrupt_zip = 'File %s is probably corrupted!'; - msg_space_warning = 'There %s enough space on the target '+ - 'drive for all the selected components. Do you '+ - 'want to change the installation path?'; - msg_file_missing = 'File %s missing for the selected installation. '+ - 'Installation hasn''t been completed.'; - msg_extraction_error = 'Error (%s) while extracting. Disk full?'#13+ - #13#3'Try again?'; - - menu_install = 'Free Pascal Installer'; - - str_requires_lfn = ' (requires LFN support)'; - str_checking_lfn = 'Checking lfn usage for '; - str_invalid = ' [INVALID]'; - str_file = 'File: '; - str_extend_path = 'Extend your PATH variable with '; - str_ok = '~O~k'; - str_is_not = 'is not'; - str_might_not_be = 'might not be'; - str_to_compile = 'To compile files enter '; - str_start_ide = 'To start the IDE (Integrated Development Environment) type ''fp'' at a command line prompt'; - str_libpath = 'and your LIBPATH with '; - str_extend_libpath = 'Extend your LIBPATH with '; - str_dll = 'dll'; - str_file2 = ' [file]'; - str_continue = '~C~ontinue'; - str_quit = '~Q~uit'; - - implementation - -end. -{ - $Log$ - Revision 1.5 2001-11-24 14:33:51 carl - * ppc386.cfg -> fpc.cfg - - Revision 1.4 2000/10/11 15:57:47 peter - * merged ide additions - - Revision 1.3 2000/09/22 12:15:49 florian - + support of Russian (Windows) - - Revision 1.2 2000/09/22 11:07:51 florian - + all language dependend strings are now resource strings - + the -Fr switch is now set in the ppc386.cfg -} \ No newline at end of file diff --git a/install/fpinst/unzip.pas b/install/fpinst/unzip.pas deleted file mode 100644 index ad728e4cd7..0000000000 --- a/install/fpinst/unzip.pas +++ /dev/null @@ -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, XHajT03@mbox.vol.cz - * 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 - -} - diff --git a/install/fpinst/unzipdll.pas b/install/fpinst/unzipdll.pas deleted file mode 100644 index 0640fc7cf9..0000000000 --- a/install/fpinst/unzipdll.pas +++ /dev/null @@ -1,256 +0,0 @@ -{ - $Id$ -} -unit UnzipDLL; - -{$IFDEF VIRTUALPASCAL} - {$Cdecl+,AlignRec-,OrgName+} -{$ELSE} - {$IFDEF FPC} - {$PACKRECORDS 1} - {$ENDIF} -{$ENDIF} - -interface - -const - UnzipErr: longint = 0; - -type - TArgV = array [0..1024] of PChar; - PArgV = ^TArgV; - TCharArray = array [1..1024*1024] of char; - PCharArray = ^TCharArray; - TFileUnzipEx = function (SourceZipFile, TargetDirectory, - FileSpecs: PChar): integer; - -function DllFileUnzipEx (SourceZipFile, TargetDirectory, - FileSpecs: PChar): integer; - -const - FileUnzipEx: TFileUnzipEx = @DllFileUnzipEx; - -(* Returns non-zero result on success. *) - -implementation - -uses -{$IFDEF OS2} - {$IFDEF FPC} - DosCalls, - {$ELSE FPC} - {$IFDEF VirtualPascal} - OS2Base, - {$ELSE VirtualPascal} - BseDos, - {$ENDIF VirtualPascal} - {$ENDIF FPC} -{$ELSE} - {$IFDEF WIN32} - Windows, - {$ENDIF WIN32} -{$ENDIF OS2} - Unzip, Dos; - -type - UzpMainFunc = function (ArgC: longint; var ArgV: TArgV): longint; cdecl; - -const -{$IFDEF OS2} - AllFiles: string [1] = '*'; -{$ELSE} - {$IFDEF WIN32} - AllFiles: string [3] = '*.*'; - {$ENDIF} -{$ENDIF} -{$IFDEF OS2} - LibPath = 'LIBPATH'; -{$ELSE} - LibPath = 'PATH'; -{$ENDIF} - UzpMainOrd = 4; - DLLName: string [8] = 'UNZIP32'#0; - UzpMain: UzpMainFunc = nil; - QuiteOpt: array [1..4] of char = '-qq'#0; - OverOpt: array [1..3] of char = '-o'#0; - CaseInsOpt: array [1..3] of char = '-C'#0; - ExDirOpt: array [1..3] of char = '-d'#0; - OptCount = 4; - -var - DLLHandle: longint; - OldExit: pointer; - C: char; - -function DLLInit: boolean; -var -{$IFDEF OS2} - ErrPath: array [0..259] of char; -{$ENDIF} - DLLPath: PathStr; - Dir: DirStr; - Name: NameStr; - Ext: ExtStr; -begin - DLLInit := false; - FSplit (FExpand (ParamStr (0)), Dir, Name, Ext); - DLLPath := Dir + DLLName; - Insert ('.DLL', DLLPath, byte (DLLPath [0])); -{$IFDEF OS2} - if (DosLoadModule (@ErrPath, SizeOf (ErrPath), @DLLPath [1], DLLHandle) <> 0) - and (DosLoadModule (@ErrPath, SizeOf (ErrPath), @DLLName [1], DLLHandle) <> 0) - then - begin - if ErrPath [0] <> #0 then - begin - Write (#13#10'Error while loading module '); - WriteLn (PChar (@ErrPath)); - end; - {$IFDEF FPC} - end else DLLInit := DosQueryProcAddr (DLLHandle, UzpMainOrd, nil, pointer (UzpMain)) = 0; - {$ELSE} - end else DLLInit := DosQueryProcAddr (DLLHandle, UzpMainOrd, nil, @UzpMain) = 0; - {$ENDIF} -{$ELSE} - {$IFDEF WIN32} - DLLHandle := LoadLibrary (@DLLPath [1]); - if DLLHandle = 0 then DLLHandle := LoadLibrary (@DLLName [1]); - if DLLHandle = 0 then WriteLn (#13#10'Error while loading DLL.') else - begin -(* UzpMain := UzpMainFunc (GetProcAddress (DLLHandle, 'UzpMain')); -*) - UzpMain := UzpMainFunc (GetProcAddress (DLLHandle, 'Unz_Unzip')); - DLLInit := Assigned (UzpMain); - end; - {$ENDIF} -{$ENDIF} -end; - -procedure NewExit; -begin - ExitProc := OldExit; -{$IFDEF OS2} - DosFreeModule (DLLHandle); -{$ELSE} - {$IFDEF WIN32} - FreeLibrary (DLLHandle); - {$ENDIF} -{$ENDIF} -end; - -function DllFileUnzipEx (SourceZipFile, TargetDirectory, - FileSpecs: PChar): integer; -var - I, FCount, ArgC: longint; - ArgV: TArgV; - P: PChar; - StrLen: array [Succ (OptCount)..1024] of longint; -begin - ArgV [0] := @DLLName; - ArgV [1] := @QuiteOpt; - ArgV [2] := @OverOpt; - ArgV [3] := @CaseInsOpt; - ArgV [4] := SourceZipFile; - FCount := 0; - if FileSpecs^ <> #0 then - begin - P := FileSpecs; - I := 0; - repeat - case FileSpecs^ of - '"': begin - Inc (FileSpecs); - repeat Inc (I) until (FileSpecs^ = '"') or (FileSpecs^ = #0); - Inc (FileSpecs); - Inc (I); - end; - '''': begin - Inc (FileSpecs); - repeat Inc (I) until (FileSpecs^ = '''') or (FileSpecs^ = #0); - Inc (FileSpecs); - Inc (I); - end; - #0, ' ', #9: begin - Inc (I); - Inc (FCount); - GetMem (ArgV [OptCount + FCount], I); - Move (P^, ArgV [OptCount + FCount]^, Pred (I)); - PCharArray (ArgV [OptCount + FCount])^ [I] := #0; - StrLen [OptCount + FCount] := I; - while (FileSpecs^ = #9) or (FileSpecs^ = ' ') do Inc (FileSpecs); - P := FileSpecs; - I := 0; - end; - else - begin - Inc (I); - Inc (FileSpecs); - end; - end; - until (FileSpecs^ = #0) and (I = 0); - end else - begin - FCount := 1; - StrLen [OptCount + FCount] := Succ (byte (AllFiles [0])); - GetMem (ArgV [OptCount + FCount], StrLen [OptCount + FCount]); - Move (AllFiles [1], ArgV [OptCount + FCount]^, StrLen [OptCount + FCount]); - end; - ArgC := Succ (FCount + OptCount); - ArgV [ArgC] := @ExDirOpt; - Inc (ArgC); - ArgV [ArgC] := TargetDirectory; - Inc (ArgC); - ArgV [ArgC] := @ExDirOpt [3]; (* contains #0 *) - UnzipErr := UzpMain (ArgC, ArgV); - if UnzipErr <> 0 then DllFileUnzipEx := 0 else DllFileUnzipEx := FCount; - for I := 1 to FCount do FreeMem (ArgV [I + OptCount], StrLen [I + OptCount]); -end; - -begin - if DLLInit then - begin - OldExit := ExitProc; - ExitProc := @NewExit; - end else - begin - WriteLn (#13#10'Dynamic library UNZIP32.DLL from InfoZip is needed to install.'); - WriteLn ('This library could not be found on your system, however.'); - WriteLn ('Please, download the library, either from the location where you found'); - WriteLn ('this installer, or from any FTP archive carrying InfoZip programs.'); - WriteLn ('If you have this DLL on your disk, please, check your configuration (' + LIBPATH + ').'); - WriteLn (#13#10'If you want to try unpacking the files with internal unpacking routine,'); - WriteLn ('answer the following question with Y. However, this might not work correctly'); - WriteLn ('under some conditions (e.g. for long names and drives not supporting them).'); - Write (#13#10'Do you want to continue now (y/N)? '); - ReadLn (C); - if UpCase (C) = 'Y' then FileUnzipEx := TFileUnzipEx (@Unzip.FileUnzipEx) else Halt (255); - end; -end. -{ - $Log$ - Revision 1.3 2000-11-26 19:02:19 hajny - * little enhancement - - Revision 1.2 2000/10/18 20:14:32 hajny - * FPC compatibility issues - - Revision 1.1 2000/07/13 06:30:22 michael - + Initial import - - Revision 1.5 2000/06/18 18:27:32 hajny - + archive validity checking, progress indicator, better error checking - - Revision 1.4 2000/06/13 16:21:36 hajny - * Win32 support corrected/completed - - Revision 1.3 2000/03/05 17:57:08 hajny - + added support for Win32 (untested) - - Revision 1.2 1999/06/10 07:28:29 hajny - * compilable with TP again - - Revision 1.1 1999/02/19 16:45:26 peter - * moved to fpinst/ directory - + makefile - -} diff --git a/install/fpinst/ziptypes.pas b/install/fpinst/ziptypes.pas deleted file mode 100644 index 382aba5ce1..0000000000 --- a/install/fpinst/ziptypes.pas +++ /dev/null @@ -1,215 +0,0 @@ -{ - $Id$ -} -UNIT ziptypes; -{ -Type definitions for UNZIP - * original version by Christian Ghisler - * extended - and - amended for Win32 by Dr Abimbola Olowofoyeku (The African Chief) - Homepage: http://ourworld.compuserve.com/homepages/African_Chief - * extended by Tomas Hajny, XHajT03@mbox.vol.cz to support other 32-bit - compilers/platforms (OS/2, GO32, ...); search for (* TH ... *) -} - -{$IFDEF FPC} - {$DEFINE BIT32} -{$ENDIF} - -{$IFDEF OS2} - {$DEFINE BIT32} -{$ENDIF} - -{$IFDEF WIN32} - {$DEFINE BIT32} -{$ENDIF} - - -INTERFACE - -{$ifdef BIT32} -TYPE - nWord = longint; - Integer = Longint; {Default Integer is 16 bit!} -{$else BIT32} -TYPE - nWord = Word; -{$endif BIT32} - -CONST - tBufSize = {$ifdef BIT32}256{$else}63{$endif} * 1024; {buffer size} - tFSize = {$ifdef BIT32}259{$else}79{$endif}; {filename length} - -{$IFDEF OS2} - AllFiles = '*'; -{$ELSE} - {$ifdef linux} - AllFiles = '*'; - {$else} - AllFiles = '*.*'; - {$endif} -{$ENDIF} - -{$ifdef linux} - DirSep='/'; -{$else} - DirSep='\'; -{$endif} - -TYPE - { Record for UNZIP } - buftype = ARRAY [ 0..tBufSize ] of char; - TDirtype = ARRAY [ 0..tFSize ] of char; - TZipRec = PACKED RECORD - buf : ^buftype; {please} {buffer containing central dir} - bufsize, {do not} {size of buffer} - localstart : word; {change these!} {start pos in buffer} - Time, - Size, - CompressSize, - headeroffset : Longint; - FileName : tdirtype; - PackMethod : word; - Attr : Byte; - END; { TZipRec } - - { record for callback progress Reports, etc. } - pReportRec = ^TReportRec; {passed to callback functions} - TReportRec = PACKED RECORD - FileName : tdirtype; {name of individual file} - Time, {date and time stamp of individual file} - Size, {uncompressed and time stamp of individual file} - CompressSize : Longint;{compressed and time stamp of individual file} - Attr : integer; {file attribute of individual file} - PackMethod : Word; {compression method of individual file} - Ratio : byte; {compression ratio of individual file} - Status : longint; {callback status code to show where we are} - IsaDir : Boolean; {is this file a directory?} - END; {TReportRec} - -{ callback status codes } -CONST - file_starting = -1000; {beginning the unzip process; file} - file_unzipping = -1001; {continuing the unzip process; file} - file_completed = -1002; {completed the unzip process; file} - file_Failure = -1003; {failure in unzipping file} - unzip_starting = -1004; {starting with a new ZIP file} - unzip_completed = -1005; {completed this ZIP file} - - -{ procedural types for callbacks } -TYPE - UnzipReportProc = PROCEDURE ( Retcode : longint;Rec : pReportRec );{$ifdef Delphi32}STDCALL;{$endif} -{ procedural type for "Report" callback: the callback function - (if any) is called several times during the unzip process - - Error codes are sent to the callback in "Retcode". Other - details are sent in the record pointed to by "Rec". - * Note particularly Rec^.Status - this contains information about - the current status or stage of the unzip process. It can have - any of the following values; - (archive status) - unzip_starting = starting with a new ZIP archive (rec^.filename) - unzip_completed = finished with the ZIP archive (rec^.filename) - - (file status) - file_starting = starting to unzip (extract) a file (from archive) - file_unzipping = continuing to unzip a file (from archive) - (when this status value is reported, the actual number of - bytes written to the file are reported in "Retcode"; this is - valuable for updating any progress bar) - - file_completed = finshed unzip a file (from archive) - file_Failure = could not extract the file (from archive) -} - -UnzipQuestionProc = FUNCTION ( Rec : pReportRec ) : Boolean; -{$ifdef Delphi32}STDCALL;{$endif} -{ procedural type for "Question" callback:if a file already - exists, the callback (if any) will be called to ask whether - the file should be overwritten by the one in the ZIP file; - - the details of the file in the ZIP archive are supplied in the - record pointed to by "Rec" - - in your callback function, you should; - return TRUE if you want the existing file to be overwritten - return FALSE is you want the existing file to be skipped -} - - -{Error codes returned by the main unzip functions} -CONST - unzip_Ok = 0; - unzip_CRCErr = -1; - unzip_WriteErr = -2; - unzip_ReadErr = -3; - unzip_ZipFileErr = -4; - unzip_UserAbort = -5; - unzip_NotSupported = -6; - unzip_Encrypted = -7; - unzip_InUse = -8; - unzip_InternalError = -9; {Error in zip format} - unzip_NoMoreItems = -10; - unzip_FileError = -11; {Error Accessing file} - unzip_NotZipfile = -12; {not a zip file} - unzip_SeriousError = -100; {serious error} - unzip_MissingParameter = -500; {missing parameter} - - -{ the various unzip methods } -CONST -Unzipmethods : ARRAY [ 0..9 ] of pchar = - ( 'stored', 'shrunk', 'reduced 1', 'reduced 2', 'reduced 3', - 'reduced 4', 'imploded', 'tokenized', 'deflated', 'skipped' ); - -{ unzip actions being undertaken } -CONST -UnzipActions : ARRAY [ 0..9 ] of pchar = - ( 'copying', 'unshrinking', 'unreducing 1', 'unreducing 2', 'unreducing 3', - 'unreducing 4', 'exploding', 'un-tokenizing', 'inflating', 'skipping' ); - -{ rudimentary "uppercase" function } -FUNCTION Upper ( s : String ) : String; - -{ remove path and return filename only } -FUNCTION StripPath ( CONST s : String ) : String; - -IMPLEMENTATION - -FUNCTION Upper ( s : String ) : String; -VAR i : integer; -BEGIN - FOR i := 1 TO length ( s ) DO s [ i ] := Upcase ( s [ i ] ); - Upper := s; -END; - -FUNCTION StripPath ( CONST s : String ) : String; -VAR -i, j : Word; -BEGIN - StripPath := s; - j := length ( s ); - FOR i := j DOWNTO 1 DO BEGIN - IF s [ i ] in [ '\', ':', '/' ] THEN BEGIN - StripPath := Copy ( s, succ ( i ), j -i ); - exit; - END; - END; -END; - -END. -{ - $Log$ - Revision 1.1 2000-07-13 06:30:22 michael - + Initial import - - Revision 1.2 1999/06/10 07:28:30 hajny - * compilable with TP again - - Revision 1.1 1999/02/19 16:45:26 peter - * moved to fpinst/ directory - + makefile - -} diff --git a/install/fpinst/Makefile b/installer/Makefile similarity index 96% rename from install/fpinst/Makefile rename to installer/Makefile index b44566c700..5ad76fbd34 100644 --- a/install/fpinst/Makefile +++ b/installer/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 1.1 [2002/01/27] +# Don't edit, this file is generated by FPCMake Version 1.1 [2002/01/29] # default: all MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx @@ -178,9 +178,9 @@ endif else UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) endif -PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages) +PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) override PACKAGE_NAME=fpinst -override PACKAGE_VERSION=1.0.5 +override PACKAGE_VERSION=1.0.6 ifeq ($(OS_TARGET),linux) override TARGET_PROGRAMS+=installer endif @@ -193,15 +193,11 @@ endif ifeq ($(OS_TARGET),os2) override TARGET_PROGRAMS+=install endif -override CLEAN_UNITS+=ziptypes unzip -ifeq ($(OS_TARGET),os2) -override CLEAN_UNITS+=unzipdll -endif ifeq ($(OS_TARGET),linux) override CLEAN_FILES+=installer.pas endif override INSTALL_FPCPACKAGE=y -override COMPILER_UNITDIR+=../ide/text +override COMPILER_UNITDIR+=../ide ifdef REQUIRE_UNITSDIR override UNITSDIR+=$(REQUIRE_UNITSDIR) endif @@ -715,50 +711,61 @@ else TAROPT=vz TAREXT=.tar.gz endif -override REQUIRE_PACKAGES=rtl fv +override REQUIRE_PACKAGES=rtl fv unzip ifeq ($(OS_TARGET),linux) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_FV=1 +REQUIRE_PACKAGES_UNZIP=1 endif ifeq ($(OS_TARGET),go32v2) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_FV=1 +REQUIRE_PACKAGES_UNZIP=1 endif ifeq ($(OS_TARGET),win32) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_FV=1 +REQUIRE_PACKAGES_UNZIP=1 endif ifeq ($(OS_TARGET),os2) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_FV=1 +REQUIRE_PACKAGES_UNZIP=1 endif ifeq ($(OS_TARGET),freebsd) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_FV=1 +REQUIRE_PACKAGES_UNZIP=1 endif ifeq ($(OS_TARGET),beos) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_FV=1 +REQUIRE_PACKAGES_UNZIP=1 endif ifeq ($(OS_TARGET),netbsd) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_FV=1 +REQUIRE_PACKAGES_UNZIP=1 endif ifeq ($(OS_TARGET),amiga) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_FV=1 +REQUIRE_PACKAGES_UNZIP=1 endif ifeq ($(OS_TARGET),atari) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_FV=1 +REQUIRE_PACKAGES_UNZIP=1 endif ifeq ($(OS_TARGET),sunos) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_FV=1 +REQUIRE_PACKAGES_UNZIP=1 endif ifeq ($(OS_TARGET),qnx) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_FV=1 +REQUIRE_PACKAGES_UNZIP=1 endif ifdef REQUIRE_PACKAGES_RTL PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/$(OS_TARGET)/Makefile.fpc,$(PACKAGESDIR)))))) @@ -802,6 +809,27 @@ ifdef UNITDIR_FV override COMPILER_UNITDIR+=$(UNITDIR_FV) endif endif +ifdef REQUIRE_PACKAGES_UNZIP +PACKAGEDIR_UNZIP:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /unzip/Makefile.fpc,$(PACKAGESDIR)))))) +ifneq ($(PACKAGEDIR_UNZIP),) +ifneq ($(wildcard $(PACKAGEDIR_UNZIP)/$(OS_TARGET)),) +UNITDIR_UNZIP=$(PACKAGEDIR_UNZIP)/$(OS_TARGET) +else +UNITDIR_UNZIP=$(PACKAGEDIR_UNZIP) +endif +else +PACKAGEDIR_UNZIP= +UNITDIR_UNZIP:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /unzip/Package.fpc,$(UNITSDIR))))) +ifneq ($(UNITDIR_UNZIP),) +UNITDIR_UNZIP:=$(firstword $(UNITDIR_UNZIP)) +else +UNITDIR_UNZIP= +endif +endif +ifdef UNITDIR_UNZIP +override COMPILER_UNITDIR+=$(UNITDIR_UNZIP) +endif +endif ifndef NOCPUDEF override FPCOPTDEF=$(CPU_TARGET) endif @@ -1272,3 +1300,5 @@ include fpcmake.loc endif installer.pas: install.pas $(COPY) install.pas installer.pas +install$(EXEEXT) : install.pas scroll$(PPUEXT) +installer$(EXEEXT) : installer.pas scroll$(PPUEXT) diff --git a/install/fpinst/Makefile.fpc b/installer/Makefile.fpc similarity index 70% rename from install/fpinst/Makefile.fpc rename to installer/Makefile.fpc index f5a93e13eb..98ab6647ec 100644 --- a/install/fpinst/Makefile.fpc +++ b/installer/Makefile.fpc @@ -4,7 +4,7 @@ [package] name=fpinst -version=1.0.5 +version=1.0.6 [target] programs_go32v2=install @@ -13,15 +13,13 @@ programs_os2=install programs_linux=installer [clean] -units=ziptypes unzip -units_os2=unzipdll files_linux=installer.pas [require] -packages=fv +packages=fv unzip [compiler] -unitdir=../ide/text +unitdir=../ide [install] fpcpackage=y @@ -33,3 +31,7 @@ fpcdir=.. [rules] installer.pas: install.pas $(COPY) install.pas installer.pas + +install$(EXEEXT) : install.pas scroll$(PPUEXT) + +installer$(EXEEXT) : installer.pas scroll$(PPUEXT) diff --git a/install/fpinst/install.dat b/installer/install.dat similarity index 95% rename from install/fpinst/install.dat rename to installer/install.dat index 91bba13b8f..7040690021 100644 --- a/install/fpinst/install.dat +++ b/installer/install.dat @@ -76,9 +76,14 @@ idecfgfile=fp.cfg ideinifile=fp.ini filecheck=*emx.zip package=baseemx.zip,~B~asic system for EMX (required) -package=asldemx.zip,GNU ~L~inker and assembler for EMX (required) +package=asldemx.zip,GNU ~L~inker and GNU assembler for EMX (required) +package=utilemx.zip,~E~xtra Utilities +package=makeemx.zip,GNU ~U~tilities (needed for Makefile usage) package=gdbemx.zip,GNU ~D~ebugger for EMX and PMGDB front-end -package=utilemx.zip,GNU ~U~tilities (for makefiles) +package=ufclemx.zip,~F~ree Component Libary (FCL) +package=ubasemx.zip,Ba~s~ic units (needed by FCL) +package=unetemx.zip,~N~etworking units +package=umisemx.zip,~M~iscellaneous units # @@ -108,7 +113,7 @@ package=docsrc.zip,~D~ocumentation sources (LaTeX) defaultcfg= # -# Example fpc.cfg for Free Pascal Compiler Version 1.0.2 +# Example fpc.cfg for Free Pascal Compiler Version 1.0.4 # # ---------------------- diff --git a/install/fpinst/install.def b/installer/install.def similarity index 100% rename from install/fpinst/install.def rename to installer/install.def diff --git a/install/fpinst/install.pas b/installer/install.pas similarity index 80% rename from install/fpinst/install.pas rename to installer/install.pas index 7fab672ee9..8872d97fc8 100644 --- a/install/fpinst/install.pas +++ b/installer/install.pas @@ -1,10 +1,10 @@ { $Id$ - This file is part of Free Pascal - Copyright (c) 1993-2000 by Florian Klaempfl + This file is part of the Free Pascal run time library. + Copyright (c) 1993-98 by Florian Klaempfl member of the Free Pascal development team - This is the install program for Free Pascal + This is the install program for the DOS and OS/2 versions of Free Pascal See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -17,6 +17,9 @@ program install; {$DEFINE FV} (* TH - added to make use of the original Turbo Vision possible. *) +{$ifdef FVISION} +{$undef FV} +{$endif} { $DEFINE DLL} (* TH - if defined, UNZIP32.DLL library is used to unpack. *) { $DEFINE DOSSTUB} (* TH - should _not_ be defined unless creating a bound DOS and OS/2 installer!!! *) (* Defining DOSSTUB causes adding a small piece of code *) @@ -44,6 +47,21 @@ program install; {$UNDEF DOSSTUB} {$ENDIF} +{$ifdef go32v2} +{$define MAYBE_LFN} +{$endif} + +{$ifdef debug} +{$ifdef win32} +{$define MAYBE_LFN} +{$endif win32} +{$endif debug} + +{$ifdef TP} +{$define MAYBE_LFN} +{$endif} + + uses {$IFDEF OS2} {$IFDEF FPC} @@ -57,7 +75,7 @@ program install; {$ENDIF FPC} {$ENDIF OS2} {$IFDEF GO32V2} - emu387, + { emu387, not needed anymore PM } {$ENDIF} {$ifdef HEAPTRC} heaptrc, @@ -66,20 +84,17 @@ program install; {$IFDEF FV} commands, {$ENDIF} + unzip,ziptypes, {$IFDEF DLL} unzipdll, {$ENDIF} - unzip,ziptypes, - app,dialogs,views,menus,msgbox,colortxt,tabs,inststr,scroll, + app,dialogs,views,menus,msgbox,colortxt,tabs,scroll, HelpCtx,WHTMLScn; - const - installerversion='1.0.2'; + installerversion='1.0.4'; - {$ifdef TP}lfnsupport=false;{$endif} - maxpacks=10; maxpackages=20; maxdefcfgs=1024; @@ -94,27 +109,11 @@ program install; haside : boolean = false; hashtmlhelp : boolean = false; -{$IFDEF LINUX} +{$ifdef linux} DirSep='/'; -{$ELSE} - {$IFDEF UNIX} - DirSep='/'; - {$ELSE} +{$else} DirSep='\'; - {$ENDIF} -{$ENDIF} - -{$IFNDEF GO32V2} - {$IFDEF GO32V1} - LFNSupport = false; - {$ELSE} - {$IFDEF TP} - LFNSupport = false; - {$ELSE} - LFNSupport = true; - {$ENDIF} - {$ENDIF} -{$ENDIF} +{$endif} type tpackage=record @@ -126,6 +125,7 @@ program install; name : string[12]; binsub : string[40]; ppc386 : string[20]; + targetname : string[20]; defidecfgfile, defideinifile, defcfgfile : string[12]; @@ -140,7 +140,6 @@ program install; cfgrec=record title : string[80]; version : string[20]; - language : string[30]; helpidx, docsub, basepath : DirStr; @@ -178,11 +177,6 @@ program install; constructor init; end; - planguagedialog = ^tlanguagedialog; - tlanguagedialog = object(tdialog) - constructor init; - end; - PFPHTMLFileLinkScanner = ^TFPHTMLFileLinkScanner; TFPHTMLFileLinkScanner = object(THTMLFileLinkScanner) function CheckURL(const URL: string): boolean; virtual; @@ -200,7 +194,6 @@ program install; procedure initmenubar;virtual; procedure handleevent(var event : tevent);virtual; procedure do_installdialog; - procedure do_languagedialog; procedure readcfg(const fn:string); procedure checkavailpack; end; @@ -242,7 +235,6 @@ program install; UnzDlg : punzipdialog; log : text; createlog : boolean; - msgfile : string; {$IFNDEF DLL} const @@ -280,18 +272,16 @@ program install; end; - function Replace(var s:string;const s1,s2:string) : boolean; + procedure Replace(var s:string;const s1,s2:string); var i : longint; begin - Replace:=false; repeat i:=pos(s1,s); if i>0 then begin Delete(s,i,length(s1)); Insert(s2,s,i); - Replace:=true; end; until i=0; end; @@ -363,7 +353,7 @@ program install; s : string; begin uncompressed:=DiskSpaceN (zipfile); - if Uncompressed = -1 then DiskSpace := str_invalid else + if Uncompressed = -1 then DiskSpace := ' [INVALID]' else begin str(uncompressed,s); diskspace:=' ('+s+' KB)'; @@ -384,11 +374,13 @@ program install; begin if Dir.Attr and Directory = 0 then begin - messagebox(msg_problems_create_dir,nil, + messagebox('A file with the name chosen as the installation '+ + 'directory exists already. Cannot create this directory!',nil, mferror+mfokbutton); createinstalldir:=false; end else - createinstalldir:=messagebox(msg_install_dir_exists,nil, + createinstalldir:=messagebox('The installation directory exists already. '+ + 'Do you want to continue ?',nil, mferror+mfyesbutton+mfnobutton)=cmYes; exit; end; @@ -396,7 +388,7 @@ program install; if err then begin params[0]:=@s; - messagebox(msg_install_cant_be_created, + messagebox('The installation directory %s couldn''t be created', @params,mferror+mfokbutton); createinstalldir:=false; exit; @@ -539,7 +531,8 @@ program install; r.assign(10,10,70,15); indexdlg:=new(phtmlindexdialog,init(r,'Creating HTML index file, please wait ...')); desktop^.insert(indexdlg); - New(LS, Init); +{$warning FIXME !!!! } + New(LS, Init('')); LS^.ProcessDocument(FileName,[soSubDocsOnly]); if LS^.GetDocumentCount=0 then begin @@ -590,7 +583,7 @@ program install; Writing of fpc.cfg *****************************************************************************} - procedure writedefcfg(const fn:string;const cfgdata : tcfgarray;count : longint); + procedure writedefcfg(const fn:string;const cfgdata : tcfgarray;count : longint;const targetname : string); var t : text; i : longint; @@ -606,7 +599,7 @@ program install; if doserror=0 then begin params[0]:=@fn; - if MessageBox(msg_overwrite_cfg,@params, + if MessageBox('Config %s already exists, continue writing default config?',@params, mfinformation+mfyesbutton+mfnobutton)=cmNo then exit; end; @@ -621,7 +614,7 @@ program install; if ioresult<>0 then begin params[0]:=@fn; - MessageBox(msg_problems_writing_cfg,@params,mfinformation+mfokbutton); + MessageBox(#3'A config not written.'#13#3'%s'#13#3'couldn''t be created',@params,mfinformation+mfokbutton); exit; end; for i:=1 to count do @@ -629,21 +622,11 @@ program install; begin s:=cfgdata[i]^; Replace(s,'$1',data.basepath); - - { error msg file entry? } - if Replace(s,'$L',msgfile) then - begin - { if we've to set an error msg file, we } - { write it else we discard the line } - if msgfile<>'' then - writeln(t,s); - end - else - writeln(t,s); + Replace(s,'$target',targetname); + writeln(t,s); end else writeln(t,''); - close(t); end; @@ -685,7 +668,8 @@ program install; DrawView; end; end; - file_failure: UnzipErr := RetCode; + file_failure: + UnzipErr := RetCode; file_unzipping: begin with UnzDlg^.FileText^ do @@ -705,16 +689,14 @@ program install; again : boolean; fn,dir,wild : string; Cnt: integer; - params : array[0..0] of pointer; - begin Disposestr(filetext^.text); - filetext^.Text:=NewStr(#3+str_file+s+ #13#3' '); + filetext^.Text:=NewStr(#3'File: '+s + #13#3' '); filetext^.drawview; if not(file_exists(s,startpath)) then begin - params[0]:=@s; - messagebox(msg_file_missing,@params,mferror+mfokbutton); + messagebox('File "'+s+'" missing for the selected installation. '+ + 'Installation hasn''t been completed.',nil,mferror+mfokbutton); errorhalt; end; {$IFNDEF DLL} @@ -733,8 +715,8 @@ program install; if (UnzipErr <> 0) then begin Str(UnzipErr,s); - params[0]:=@s; - if messagebox(msg_extraction_error,@params,mferror+mfyesbutton+mfnobutton)=cmNo then + if messagebox('Error (' + S + ') while extracting. Disk full?'#13+ + #13#3'Try again?',nil,mferror+mfyesbutton+mfnobutton)=cmNo then errorhalt else again:=true; @@ -802,13 +784,13 @@ program install; {$ENDIF} R.Assign(6, 6, 74, YB); - inherited init(r,dialog_enddialog_title); + inherited init(r,'Installation Successfull'); {$IFNDEF LINUX} if WPath then begin R.Assign(2, 3, 64, 5); - P:=new(pstatictext,init(r,str_extend_path+''''+S+'''')); + P:=new(pstatictext,init(r,'Extend your PATH variable with '''+S+'''')); insert(P); end; @@ -816,9 +798,9 @@ program install; if WLibPath then begin if WPath then - S := str_libpath+'''' + S + '\'+str_dll+'''' + S := 'and your LIBPATH with ''' + S + '\dll''' else - S := str_extend_libpath+'''' + S + '\'+str_dll+''''; + S := 'Extend your LIBPATH with ''' + S + '\dll'''; R.Assign (2, YB - 14, 64, YB - 12); P := New (PStaticText, Init (R, S)); Insert (P); @@ -827,18 +809,18 @@ program install; {$ENDIF} R.Assign(2, YB - 13, 64, YB - 12); - P:=new(pstatictext,init(r,str_to_compile+''''+cfg.pack[1].ppc386+str_file2+'''')); + P:=new(pstatictext,init(r,'To compile files enter '''+cfg.pack[1].ppc386+' [file]''')); insert(P); if haside then begin R.Assign(2, YB - 12, 64, YB - 10); - P:=new(pstatictext,init(r,str_start_ide)); + P:=new(pstatictext,init(r,'To start the IDE (Integrated Development Environment) type ''fp'' at a command line prompt')); insert(P); end; R.Assign (29, YB - 9, 39, YB - 7); - Control := New (PButton, Init (R,str_ok, cmOK, bfDefault)); + Control := New (PButton, Init (R,'~O~k', cmOK, bfDefault)); Insert (Control); end; @@ -846,14 +828,11 @@ program install; {***************************************************************************** TInstallDialog *****************************************************************************} - +{$ifdef MAYBE_LFN} var islfn : boolean; procedure lfnreport( Retcode : longint;Rec : pReportRec ); -{$IFDEF TP} - far; -{$ENDIF} var p : pathstr; @@ -862,7 +841,7 @@ program install; begin fsplit(strpas(rec^.Filename),p,n,e); - if length(n)>8 then + if (length(n)>8) or (length(e)>4) then islfn:=true; end; @@ -881,47 +860,7 @@ program install; {$endif FPC} haslfn:=islfn; end; - - constructor tlanguagedialog.init; - const - languages = 8; - width = 40; - height = languages+6; - x1 = (79-width) div 2; - y1 = (23-height) div 2; - x2 = x1+width; - y2 = y1+height; - var - r : trect; - okbut : pbutton; - line : longint; - rb : PRadioButtons; - - begin - r.assign(x1,y1,x2,y2); - inherited init(r,dialog_language_title); - GetExtent(R); - R.Grow(-2,-1); - line:=r.a.y+1; - r.assign((width div 2)-15,line,(width div 2)+15,line+languages); - New(rb, Init(r, - NewSItem(dialog_language_english, - NewSItem(dialog_language_dutch, - NewSItem(dialog_language_french, - NewSItem(dialog_language_russian, - NewSItem(dialog_language_hungarian, - NewSItem(dialog_language_spanish, - NewSItem(dialog_language_german, - NewSItem(dialog_language_russian_win, - nil)))))))))); - insert(rb); - inc(line,languages); - inc(line,1); - r.assign((width div 2)-5,line,(width div 2)+5,line+2); - new(okbut,init(r,str_ok,cmok,bfdefault)); - - Insert(OkBut); - end; +{$endif MAYBE_LFN} constructor tinstalldialog.init; const @@ -964,7 +903,7 @@ program install; begin if file_exists(package[i].zip,startpath) then begin -{$ifdef go32v2} +{$ifdef MAYBE_LFN} if not(lfnsupport) then begin if not(haslfn(package[i].zip,startpath)) then @@ -973,17 +912,19 @@ program install; packmask[j]:=packmask[j] or packagemask(i); firstitem[j]:=i; if createlog then - writeln(log,str_checking_lfn,startpath+DirSep+package[i].zip,' ... no lfn'); + writeln(log,'Checking lfn usage for ',startpath+DirSep+package[i].zip,' ... no lfn'); end else begin - items[j]:=newsitem(package[i].name+str_requires_lfn,items[j]); + items[j]:=newsitem(package[i].name+' (requires LFN support)',items[j]); + packmask[j]:=packmask[j] or packagemask(i); + firstitem[j]:=i; if createlog then - writeln(log,str_checking_lfn,startpath+DirSep+package[i].zip,' ... uses lfn'); + writeln(log,'Checking lfn usage for ',startpath+DirSep+package[i].zip,' ... uses lfn'); end; end else -{$endif go32v2} +{$endif MAYBE_LFN} begin items[j]:=newsitem(package[i].name+diskspace(startpath+DirSep+package[i].zip),items[j]); packmask[j]:=packmask[j] or packagemask(i); @@ -1002,7 +943,7 @@ program install; found:=true; if not found then begin - messagebox(msg_no_components_found,nil,mferror+mfokbutton); + messagebox('No components found to install, aborting.',nil,mferror+mfokbutton); errorhalt; end; @@ -1025,7 +966,7 @@ program install; r.move(0,2); r.b.x:=r.a.x+40; - new(labpath,init(r,dialog_install_basepath,f)); + new(labpath,init(r,'~B~ase path',f)); r.move(0,1); r.b.x:=r.a.x+40; r.b.y:=r.a.y+1; @@ -1033,11 +974,11 @@ program install; r.move(0,2); r.b.x:=r.a.x+40; - new(labcfg,init(r,dialog_install_config,f)); + new(labcfg,init(r,'Con~f~ig',f)); r.move(0,1); r.b.x:=r.a.x+40; r.b.y:=r.a.y+1; - new(cfgcb,init(r,newsitem(dialog_install_createppc386cfg,nil))); + new(cfgcb,init(r,newsitem('create fpc.cfg',nil))); data.cfgval:=1; {-------- Pack Sheets ----------} @@ -1078,7 +1019,7 @@ program install; end; New(Tab, Init(TabR, - NewTabDef(dialog_install_general,IlPath, + NewTabDef('~G~eneral',IlPath, NewTabItem(TitleText, NewTabItem(LabPath, NewTabItem(ILPath, @@ -1093,75 +1034,17 @@ program install; line:=tabr.b.y; r.assign((width div 2)-18,line,(width div 2)-4,line+2); - new(okbut,init(r,str_continue,cmok,bfdefault)); + new(okbut,init(r,'~C~ontinue',cmok,bfdefault)); Insert(OkBut); r.assign((width div 2)+4,line,(width div 2)+14,line+2); - new(cancelbut,init(r,str_quit,cmcancel,bfnormal)); + new(cancelbut,init(r,'~Q~uit',cmcancel,bfnormal)); Insert(CancelBut); Tab^.Select; end; -{***************************************************************************** - TUnZipDialog -*****************************************************************************} - - procedure tapp.do_languagedialog; - - var - p : planguagedialog; - langdata : longint; - c : word; - - begin - { select components } - new(p,init); - langdata:=0; - c:=executedialog(p,@langdata); - writeln(langdata); - if c=cmok then - begin - case langdata of - 0: - cfg.language:='English'; - 1: - begin - cfg.language:='Dutch'; - msgfile:='errorn.msg'; - end; - 2: - begin - cfg.language:='French'; - msgfile:='errorf.msg'; - end; - 3: - begin - cfg.language:='Russian'; - msgfile:='errorr.msg'; - end; - 4: - cfg.language:='Hungarian'; - 5: - begin - cfg.language:='Spanish'; - msgfile:='errors.msg'; - end; - 6: - begin - cfg.language:='German'; - msgfile:='errord.msg'; - end; - 7: - begin - cfg.language:='RussianWin'; - msgfile:='errorrw.msg'; - end; - end; - end; - end; - {***************************************************************************** TApp *****************************************************************************} @@ -1178,7 +1061,6 @@ program install; c : word; i,j : longint; found : boolean; - params : array[0..0] of pointer; {$ifndef linux} DSize,Space,ASpace : longint; S: DirStr; @@ -1192,15 +1074,15 @@ program install; begin for i:=1 to cfg.packs do if cfg.pack[i].defcfgfile<>'' then - writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defcfgfile,cfg.defcfg,cfg.defcfgs); + writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defcfgfile,cfg.defcfg,cfg.defcfgs,cfg.pack[i].targetname); if haside then begin for i:=1 to cfg.packs do if cfg.pack[i].defidecfgfile<>'' then - writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defidecfgfile,cfg.defidecfg,cfg.defidecfgs); + writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defidecfgfile,cfg.defidecfg,cfg.defidecfgs,cfg.pack[i].targetname); for i:=1 to cfg.packs do if cfg.pack[i].defideinifile<>'' then - writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defideinifile,cfg.defideini,cfg.defideinis); + writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defideinifile,cfg.defideini,cfg.defideinis,cfg.pack[i].targetname); if hashtmlhelp then writehlpindex(data.basepath+DirSep+cfg.DocSub+DirSep+cfg.helpidx); end; @@ -1219,7 +1101,7 @@ program install; if (c=cmok) then begin if Data.BasePath = '' then - messagebox(msg_select_dir,nil,mferror+mfokbutton) + messagebox('Please, choose the directory for installation first.',nil,mferror+mfokbutton) else begin found:=false; @@ -1240,12 +1122,10 @@ program install; begin ASpace := DiskSpaceN (package[i].zip); if ASpace = -1 then - begin - params[0]:=@package[i].zip; - MessageBox (msg_corrupt_zip, - @params,mferror + mfokbutton); - end - else Inc (DSize, ASpace); + MessageBox ('File ' + package[i].zip + + ' is probably corrupted!', nil, + mferror + mfokbutton) + else Inc (DSize, ASpace); end; end; end; @@ -1255,15 +1135,16 @@ program install; Space := DiskFree (byte (Upcase(S [1])) - 64) shr 10; if Space < DSize then - S := str_is_not + S := 'is not' else S := ''; if (Space < DSize + 500) then begin if S = '' then - S := str_might_not_be; - params[0]:=@s; - if messagebox(msg_space_warning,@params, + S := 'might not be'; + if messagebox('There ' + S + ' enough space on the target ' + + 'drive for all the selected components. Do you ' + + 'want to change the installation path?',nil, mferror+mfyesbutton+mfnobutton) = cmYes then Continue; end; @@ -1276,7 +1157,7 @@ program install; { maybe only config } if (data.cfgval and 1)<>0 then begin - result:=messagebox(msg_no_components_selected,nil, + result:=messagebox('No components selected.'#13#13'Create a configfile ?',nil, mfinformation+mfyesbutton+mfnobutton); if (result=cmYes) and createinstalldir(data.basepath) then doconfigwrite; @@ -1284,7 +1165,7 @@ program install; end else begin - result:=messagebox(msg_nocomponents,nil, + result:=messagebox('No components selected.'#13#13'Abort installation?',nil, mferror+mfyesbutton+mfnobutton); if result=cmYes then exit; @@ -1301,7 +1182,7 @@ program install; with cfg.pack[j] do begin r.assign(10,7,70,18); - UnzDlg:=new(punzipdialog,init(r,dialog_unzipdialog_title)); + UnzDlg:=new(punzipdialog,init(r,'Extracting Packages')); desktop^.insert(UnzDlg); for i:=1 to packages do begin @@ -1376,7 +1257,7 @@ program install; if ioresult<>0 then begin params[0]:=@fn; - messagebox(msg_file_not_found,@params,mferror+mfokbutton); + messagebox('File %s not found!',@params,mferror+mfokbutton); errorhalt; end; end; @@ -1397,9 +1278,6 @@ program install; else if item='TITLE' then cfg.title:=s - else - if item='LANGUAGE' then - cfg.language:=s else if item='BASEPATH' then cfg.basepath:=s @@ -1520,6 +1398,16 @@ program install; end; cfg.pack[cfg.packs].filechk:=s; end + else + if item='TARGETNAME' then + begin + if cfg.packs=0 then + begin + writeln('No pack set'); + halt(1); + end; + cfg.pack[cfg.packs].targetname:=s; + end else if item='PACKAGE' then begin @@ -1581,7 +1469,7 @@ program install; getextent(r); r.b.y:=r.a.y+1; menubar:=new(pmenubar,init(r,newmenu( - newsubmenu(menu_install,hcnocontext,newmenu(nil + newsubmenu('Free Pascal Installer',hcnocontext,newmenu(nil ), nil)))); end; @@ -1710,11 +1598,18 @@ begin begin if paramstr(i)='-l' then createlog:=true +{$ifdef MAYBE_LFN} + else if paramstr(i)='--nolfn' then + lfnsupport:=false +{$endif MAYBE_LFN} else if paramstr(i)='-h' then begin - writeln('FPC Installer Copyright (c) 1993-2000 Florian Klaempfl'); + writeln('FPC Installer Copyright (c) 1993-2001 Florian Klaempfl'); writeln('Command line options:'); writeln(' -l create log file'); +{$ifdef MAYBE_LFN} + writeln(' --nolfn force installation with short file names'); +{$endif MAYBE_LFN} writeln; writeln(' -h displays this help'); halt(0); @@ -1729,8 +1624,10 @@ begin begin assign(log,'install.log'); rewrite(log); +{$ifdef GO32V2} if not(lfnsupport) then writeln(log,'OS doesn''t have LFN support'); +{$endif} end; getdir(0,startpath); successfull:=false; @@ -1738,22 +1635,18 @@ begin fillchar(cfg, SizeOf(cfg), 0); fillchar(data, SizeOf(data), 0); - { set a default language } - cfg.language:='English'; - - { don't use a message file by default } - msgfile:=''; - installapp.init; FSplit (FExpand (ParamStr (0)), DStr, CfgName, EStr); installapp.readcfg(CfgName + CfgExt); installapp.checkavailpack; - installapp.do_languagedialog; { installapp.readcfg(startpath+dirsep+cfgfile);} +{$ifdef GO32V2} if not(lfnsupport) then - MessageBox(msg_no_lfn,nil,mfinformation or mfokbutton); + MessageBox('The operating system doesn''t support LFN (long file names),'+ + ' so some packages will get shorten filenames when installed',nil,mfinformation or mfokbutton); +{$endif} installapp.do_installdialog; installapp.done; if createlog then @@ -1761,40 +1654,56 @@ begin end. { $Log$ - Revision 1.13 2001-11-24 14:34:10 carl + Revision 1.1 2002-01-29 17:59:15 peter + * moved installer + + Revision 1.2.2.16 2001/11/24 14:29:54 carl * ppc386.cfg -> fpc.cfg - Revision 1.12 2000/11/26 19:00:44 hajny + Revision 1.2.2.15 2001/05/02 16:22:43 pierre + + Shorten file names to comply with Dos 8+3 limitation + + Revision 1.2.2.14 2001/04/19 15:50:24 pierre + * remove use of reals so emu387 is not needed anymore + + Revision 1.2.2.13 2001/01/02 09:43:12 florian + * vresion fixed + + Revision 1.2.2.12 2001/01/02 09:35:50 florian + * targetname is now read from the .dat file too + + Revision 1.2.2.11 2000/11/26 19:02:58 hajny * English correction - Revision 1.11 2000/10/11 17:16:01 peter - * fixed a typo and the setting of haside and hashtmlhelp (merged) + Revision 1.2.2.10 2000/11/26 16:49:57 hajny + * removed unneeded OS/2 conditionals - Revision 1.10 2000/10/11 15:57:47 peter - * merged ide additions + Revision 1.2.2.9 2000/11/09 22:02:33 florian + * fixed bug 1226: wrong target for the win32 IDE - Revision 1.9 2000/10/08 18:43:17 hajny - * the language dialog repaired + Revision 1.2.2.8 2000/10/11 18:08:45 peter + * lfnsupport is only for go32v2 - Revision 1.8 2000/09/24 10:52:36 peter - * smaller window + Revision 1.2.2.7 2000/10/11 16:49:02 florian + + fixed a typo and the setting of haside and hashtmlhelp - Revision 1.7 2000/09/22 23:13:37 pierre - * add emulation for go32v2 and display currently extraced file - and changes by Gabor for scrolling support (merged) + Revision 1.2.2.6 2000/10/11 13:10:20 florian + + added preconfiguratioh of help files - Revision 1.6 2000/09/22 12:15:49 florian - + support of Russian (Windows) + Revision 1.2.2.5 2000/10/10 22:12:10 florian + + added a message how to start the IDE - Revision 1.5 2000/09/22 11:07:51 florian - + all language dependend strings are now resource strings - + the -Fr switch is now set in the ppc386.cfg + Revision 1.2.2.4 2000/10/10 16:36:12 florian + + creation of IDE configuration files added - Revision 1.4 2000/09/21 22:09:23 florian - + start of multilanguage support + Revision 1.2.2.3 2000/09/24 10:52:14 peter + * window can now also be smaller again - Revision 1.3 2000/09/17 14:44:12 hajny - * compilable with TP again + Revision 1.2.2.2 2000/09/22 08:41:36 pierre + * add emulation for go32v2 and display currently extraced file + + Revision 1.2.2.1 2000/09/21 10:57:11 pierre + changes by Gabor for scrolling support Revision 1.2 2000/07/21 10:43:01 florian + added for lfn support @@ -1802,4 +1711,112 @@ end. Revision 1.1 2000/07/13 06:30:21 michael + Initial import + Revision 1.20 2000/07/09 12:55:45 hajny + * updated for version 1.0 + + Revision 1.19 2000/06/18 18:27:32 hajny + + archive validity checking, progress indicator, better error checking + + Revision 1.18 2000/02/24 17:47:47 peter + * last fixes for 0.99.14a release + + Revision 1.17 2000/02/23 17:17:56 peter + * write ppc386.cfg for all found targets + + Revision 1.16 2000/02/06 12:59:39 peter + * change upper -> upcase + * fixed stupid debugging leftover with diskspace check + + Revision 1.15 2000/02/02 17:19:10 pierre + * avoid diskfree problem and get mouse visible + + Revision 1.14 2000/02/02 15:21:31 peter + * show errorcode in message when error in unzipping + + Revision 1.13 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.12 2000/01/26 21:15:59 hajny + * compilable with TP again (lines < 127install.pas, ifdef around findclose) + + Revision 1.11 2000/01/24 22:21:48 peter + * new install version (keys not wrong correct yet) + + Revision 1.10 2000/01/18 00:22:48 peter + * fixed uninited local var + + Revision 1.9 1999/08/03 20:21:53 peter + * fixed sources mask which was not set correctly + + Revision 1.7 1999/07/01 07:56:58 hajny + * installation to root fixed + + Revision 1.6 1999/06/29 22:20:19 peter + * updated to use tab pages + + Revision 1.5 1999/06/25 07:06:30 hajny + + searching for installation script updated + + Revision 1.4 1999/06/10 20:01:23 peter + + fcl,fv,gtk support + + Revision 1.3 1999/06/10 15:00:14 peter + * fixed to compile for not os2 + * update install.dat + + Revision 1.2 1999/06/10 07:28:27 hajny + * compilable with TP again + + Revision 1.1 1999/02/19 16:45:26 peter + * moved to fpinst/ directory + + makefile + + Revision 1.15 1999/02/17 22:34:08 peter + * updates from TH for OS2 + + Revision 1.14 1998/12/22 22:47:34 peter + * updates for OS2 + * small fixes + + Revision 1.13 1998/12/21 13:11:39 peter + * updates for 0.99.10 + + Revision 1.12 1998/12/16 00:25:34 peter + * updated for 0.99.10 + * new end dialogbox + + Revision 1.11 1998/11/01 20:32:25 peter + * packed record + + Revision 1.10 1998/10/25 23:38:35 peter + * removed warnings + + Revision 1.9 1998/10/23 16:57:40 pierre + * compiles without -So option + * the main dialog init was buggy !! + + Revision 1.8 1998/09/22 21:10:31 jonas + * initialize cfg and data with 0 at startup + + Revision 1.7 1998/09/16 16:46:37 peter + + updates + + Revision 1.6 1998/09/15 13:11:14 pierre + small fix to cleanup if no package + + Revision 1.5 1998/09/15 12:06:06 peter + * install updated to support w32 and dos and config file + + Revision 1.4 1998/09/10 10:50:49 florian + * DOS install program updated + + Revision 1.3 1998/09/09 13:39:58 peter + + internal unzip + * dialog is showed automaticly + + Revision 1.2 1998/04/07 22:47:57 florian + + version/release/patch numbers as string added + } diff --git a/install/fpinst/scroll.pas b/installer/scroll.pas similarity index 96% rename from install/fpinst/scroll.pas rename to installer/scroll.pas index ec84c11bbd..bdf60308dd 100644 --- a/install/fpinst/scroll.pas +++ b/installer/scroll.pas @@ -223,7 +223,8 @@ end; procedure TScrollBox.AfterDelete(P: PView); begin - UpdateLimits; + { UpdateLimits; + removed because it creates GPF PM } end; procedure TScrollBox.Draw; @@ -250,11 +251,13 @@ end; END. { $Log$ - Revision 1.2 2000-09-22 23:13:37 pierre - * add emulation for go32v2 and display currently extraced file - and changes by Gabor for scrolling support (merged) + Revision 1.1 2002-01-29 17:59:15 peter + * moved installer + + Revision 1.1.2.2 2001/05/02 16:22:44 pierre + + Shorten file names to comply with Dos 8+3 limitation Revision 1.1.2.1 2000/09/21 10:51:33 pierre new file from Gabor -} \ No newline at end of file +}