mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-05 07:05:55 +02:00
+ Initial implementation
This commit is contained in:
michael
parent
1606fbbef1
commit
48db2151bf
1117
packages/zip/Makefile
Normal file
1117
packages/zip/Makefile
Normal file
File diff suppressed because it is too large
Load Diff
16
packages/zip/Makefile.fpc
Normal file
16
packages/zip/Makefile.fpc
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
#
|
||||||
|
# Makefile.fpc for ZLib (LibC version)
|
||||||
|
#
|
||||||
|
|
||||||
|
[targets]
|
||||||
|
units=ziptypes unzip
|
||||||
|
units_os2=unzipdll
|
||||||
|
|
||||||
|
[dirs]
|
||||||
|
fpcdir=../..
|
||||||
|
|
||||||
|
[rules]
|
||||||
|
|
||||||
|
unzip$(PPUEXT): unzip$(PASEXT) ziptypes$(PPUEXT)
|
||||||
|
|
||||||
|
unzipdll$(PPUEXT): unzipdll$(PASEXT) ziptypes$(PPUEXT)
|
||||||
3357
packages/zip/unzip.pas
Normal file
3357
packages/zip/unzip.pas
Normal file
File diff suppressed because it is too large
Load Diff
187
packages/zip/unzipdll.pas
Normal file
187
packages/zip/unzipdll.pas
Normal file
@ -0,0 +1,187 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
}
|
||||||
|
unit UnzipDLL;
|
||||||
|
|
||||||
|
{$Cdecl+,AlignRec-,OrgName+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
const
|
||||||
|
{$IFDEF OS2}
|
||||||
|
AllFiles: string [1] = '*';
|
||||||
|
{$ELSE}
|
||||||
|
AllFiles: string [3] = '*.*';
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
type
|
||||||
|
TArgV = array [0..1024] of PChar;
|
||||||
|
PArgV = ^TArgV;
|
||||||
|
TCharArray = array [1..1024*1024] of char;
|
||||||
|
PCharArray = ^TCharArray;
|
||||||
|
|
||||||
|
function FileUnzipEx (SourceZipFile, TargetDirectory,
|
||||||
|
FileSpecs: PChar): integer;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF OS2}
|
||||||
|
{$IFDEF FPC}
|
||||||
|
DosCalls,
|
||||||
|
{$ELSE FPC}
|
||||||
|
{$IFDEF VirtualPascal}
|
||||||
|
OS2Base,
|
||||||
|
{$ELSE VirtualPascal}
|
||||||
|
BseDos,
|
||||||
|
{$ENDIF VirtualPascal}
|
||||||
|
{$ENDIF FPC}
|
||||||
|
{$ENDIF OS2}
|
||||||
|
Dos;
|
||||||
|
|
||||||
|
type
|
||||||
|
UzpMainFunc = function (ArgC: longint; var ArgV: TArgV): longint;
|
||||||
|
|
||||||
|
const
|
||||||
|
{$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;
|
||||||
|
|
||||||
|
function DLLInit: boolean;
|
||||||
|
var
|
||||||
|
ErrPath: array [0..259] of char;
|
||||||
|
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]));
|
||||||
|
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;
|
||||||
|
end else DLLInit := DosQueryProcAddr (DLLHandle, UzpMainOrd, nil, @UzpMain) = 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure NewExit;
|
||||||
|
begin
|
||||||
|
ExitProc := OldExit;
|
||||||
|
DosFreeModule (DLLHandle);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FileUnzipEx;
|
||||||
|
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 *)
|
||||||
|
if UzpMain (ArgC, ArgV) <> 0 then FileUnzipEx := 0 else FileUnzipEx := 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 + ').');
|
||||||
|
Halt (255);
|
||||||
|
end;
|
||||||
|
end.
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 2000-03-02 12:16:57 michael
|
||||||
|
+ Initial implementation
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
}
|
||||||
215
packages/zip/ziptypes.pas
Normal file
215
packages/zip/ziptypes.pas
Normal file
@ -0,0 +1,215 @@
|
|||||||
|
{
|
||||||
|
$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-03-02 12:16:57 michael
|
||||||
|
+ Initial implementation
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
}
|
||||||
Loading…
Reference in New Issue
Block a user