Vichingo455-RePacks/xtool
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 1 Wiki Activity

source upload

Browse Source
This commit is contained in:
Razor12911
2022-01-17 22:16:47 +02:00
parent 12936d065b
commit 098e8c48de
1778 changed files with 1206749 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

597
contrib/fundamentals/ZLib/paszlib/minizip/MiniUnz.pas Normal file
View File

@@ -0,0 +1,597 @@
Program MiniUnz;
{ mini unzip demo package by Gilles Vollant
Usage : miniunz [-exvlo] file.zip [file_to_extract]
-l or -v list the content of the zipfile.
-e extract a specific file or all files if [file_to_extract] is missing
-x like -e, but extract without path information
-o overwrite an existing file without warning
Pascal tranlastion
Copyright (C) 2000 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
{$ifdef WIN32}
{$define Delphi}
{$ifndef FPC}
{$define Delphi32}
{$endif}
{$endif}
uses
{$ifdef Delphi}
SysUtils, Windows,
{$else}
WinDos, strings,
{$endif}
zutil,
gzlib, ziputils,
unzip;
const
CASESENSITIVITY = 0;
WRITEBUFFERSIZE = 8192;
{ change_file_date : change the date/time of a file
filename : the filename of the file where date/time must be modified
dosdate : the new date at the MSDos format (4 bytes)
tmu_date : the SAME new date at the tm_unz format }
procedure change_file_date(const filename : PChar;
dosdate : uLong;
tmu_date : tm_unz);
{$ifdef Delphi32}
var
hFile : THandle;
ftm,ftLocal,ftCreate,ftLastAcc,ftLastWrite : TFileTime;
begin
hFile := CreateFile(filename,GENERIC_READ or GENERIC_WRITE,
0,NIL,OPEN_EXISTING,0,0);
GetFileTime(hFile, @ftCreate, @ftLastAcc, @ftLastWrite);
DosDateTimeToFileTime(WORD((dosdate shl 16)), WORD(dosdate), ftLocal);
LocalFileTimeToFileTime(ftLocal, ftm);
SetFileTime(hFile,@ftm, @ftLastAcc, @ftm);
CloseHandle(hFile);
end;
{$else}
{$ifdef FPC}
var
hFile : THandle;
ftm,ftLocal,ftCreate,ftLastAcc,ftLastWrite : TFileTime;
begin
hFile := CreateFile(filename,GENERIC_READ or GENERIC_WRITE,
0,NIL,OPEN_EXISTING,0,0);
GetFileTime(hFile, @ftCreate, @ftLastAcc, @ftLastWrite);
DosDateTimeToFileTime(WORD((dosdate shl 16)), WORD(dosdate), @ftLocal);
LocalFileTimeToFileTime(ftLocal, @ftm);
SetFileTime(hFile,ftm, ftLastAcc, ftm);
CloseHandle(hFile);
end;
{$else} { msdos }
var
f: file;
begin
Assign(f, filename);
Reset(f, 1); { open file for reading }
{ (Otherwise, close will update time) }
SetFTime(f,dosDate);
Close(f);
end;
{$endif}
{$endif}
{ mymkdir and change_file_date are not 100 % portable
As I don't know well Unix, I wait feedback for the unix portion }
function mymkdir(dirname : PChar) : boolean;
var
S : string;
begin
S := StrPas(dirname);
{$I-}
mkdir(S);
mymkdir := IOresult = 0;
end;
function makedir (newdir : PChar) : boolean;
var
buffer : PChar;
p : PChar;
len : int;
var
hold : char;
begin
makedir := false;
len := strlen(newdir);
if (len <= 0) then
exit;
buffer := PChar(zcalloc (NIL, len+1, 1));
strcopy(buffer,newdir);
if (buffer[len-1] = '/') then
buffer[len-1] := #0;
if mymkdir(buffer) then
begin
if Assigned(buffer) then
zcfree(NIL, buffer);
makedir := true;
exit;
end;
p := buffer+1;
while true do
begin
while( (p^<>#0) and (p^ <> '\') and (p^ <> '/') ) do
Inc(p);
hold := p^;
p^ := #0;
if (not mymkdir(buffer)) {and (errno = ENOENT)} then
begin
WriteLn('couldn''t create directory ',buffer);
if Assigned(buffer) then
zcfree(NIL, buffer);
exit;
end;
if (hold = #0) then
break;
p^ := hold;
Inc(p);
end;
if Assigned(buffer) then
zcfree(NIL, buffer);
makedir := true;
end;
procedure do_banner;
begin
WriteLn('MiniUnz 0.15, demo package written by Gilles Vollant');
WriteLn('Pascal port by Jacques Nomssi Nzali');
WriteLn('more info at http://wwww.tu-chemnitz.de/~nomssi/paszlib.html');
WriteLn;
end;
procedure do_help;
begin
WriteLn('Usage : miniunz [-exvlo] file.zip [file_to_extract]');
WriteLn;
end;
function LeadingZero(w : Word) : String;
var
s : String;
begin
Str(w:0,s);
if Length(s) = 1 then
s := '0' + s;
LeadingZero := s;
end;
function HexToStr(w : long) : string;
const
ByteToChar : array[0..$F] of char ='0123456789ABCDEF';
var
s : string;
i : int;
x : long;
begin
s := '';
x := w;
for i := 0 to 3 do
begin
s := ByteToChar[Byte(x) shr 4] + ByteToChar[Byte(x) and $F] + s;
x := x shr 8;
end;
HexToStr := s;
end;
function do_list(uf : unzFile) : int;
var
i : uLong;
gi : unz_global_info;
err : int;
var
filename_inzip : array[0..255] of char;
file_info : unz_file_info;
ratio : uLong;
string_method : string[255];
var
iLevel : uInt;
begin
err := unzGetGlobalInfo(uf, gi);
if (err <> UNZ_OK) then
WriteLn('error ',err,' with zipfile in unzGetGlobalInfo');
WriteLn(' Length Method Size Ratio Date Time CRC-32 Name');
WriteLn(' ------ ------ ---- ----- ---- ---- ------ ----');
for i := 0 to gi.number_entry-1 do
begin
ratio := 0;
err := unzGetCurrentFileInfo(uf, @file_info, filename_inzip, sizeof(filename_inzip),NIL,0,NIL,0);
if (err <> UNZ_OK) then
begin
WriteLn('error ',err,' with zipfile in unzGetCurrentFileInfo');
break;
end;
if (file_info.uncompressed_size>0) then
ratio := (file_info.compressed_size*100) div file_info.uncompressed_size;
if (file_info.compression_method=0) then
string_method := 'Stored'
else
if (file_info.compression_method=Z_DEFLATED) then
begin
iLevel := uInt((file_info.flag and $06) div 2);
Case iLevel of
0: string_method := 'Defl:N';
1: string_method := 'Defl:X';
2,3: string_method := 'Defl:F'; { 2:fast , 3 : extra fast}
else
string_method := 'Unkn. ';
end;
end;
WriteLn(file_info.uncompressed_size:7, ' ',
string_method:6, ' ',
file_info.compressed_size:7, ' ',
ratio:3,'% ', LeadingZero(uLong(file_info.tmu_date.tm_mon)+1),'-',
LeadingZero(uLong(file_info.tmu_date.tm_mday)):2,'-',
LeadingZero(uLong(file_info.tmu_date.tm_year mod 100)):2,' ',
LeadingZero(uLong(file_info.tmu_date.tm_hour)),':',
LeadingZero(uLong(file_info.tmu_date.tm_min)),' ',
HexToStr(uLong(file_info.crc)),' ',
filename_inzip);
if ((i+1)<gi.number_entry) then
begin
err := unzGoToNextFile(uf);
if (err <> UNZ_OK) then
begin
WriteLn('error ',err,' with zipfile in unzGoToNextFile');
break;
end;
end;
end;
do_list := 0;
end;
function do_extract_currentfile(
uf : unzFile;
const popt_extract_without_path : int;
var popt_overwrite : int) : int;
var
filename_inzip : packed array[0..255] of char;
filename_withoutpath : PChar;
p: PChar;
err : int;
fout : FILEptr;
buf : pointer;
size_buf : uInt;
file_info : unz_file_info;
var
write_filename : PChar;
skip : int;
var
rep : char;
ftestexist : FILEptr;
var
answer : string[127];
var
c : char;
begin
fout := NIL;
err := unzGetCurrentFileInfo(uf, @file_info, filename_inzip,
sizeof(filename_inzip), NIL, 0, NIL,0);
if (err <> UNZ_OK) then
begin
WriteLn('error ',err, ' with zipfile in unzGetCurrentFileInfo');
do_extract_currentfile := err;
exit;
end;
size_buf := WRITEBUFFERSIZE;
buf := zcalloc (NIL, size_buf, 1);
if (buf = NIL) then
begin
WriteLn('Error allocating memory');
do_extract_currentfile := UNZ_INTERNALERROR;
exit;
end;
filename_withoutpath := filename_inzip;
p := filename_withoutpath;
while (p^ <> #0) do
begin
if (p^='/') or (p^='\') then
filename_withoutpath := p+1;
Inc(p);
end;
if (filename_withoutpath^=#0) then
begin
if (popt_extract_without_path=0) then
begin
WriteLn('creating directory: ',filename_inzip);
mymkdir(filename_inzip);
end;
end
else
begin
skip := 0;
if (popt_extract_without_path=0) then
write_filename := filename_inzip
else
write_filename := filename_withoutpath;
err := unzOpenCurrentFile(uf);
if (err <> UNZ_OK) then
WriteLn('error ',err,' with zipfile in unzOpenCurrentFile');
if ((popt_overwrite=0) and (err=UNZ_OK)) then
begin
rep := #0;
ftestexist := fopen(write_filename,fopenread);
if (ftestexist <> NIL) then
begin
fclose(ftestexist);
repeat
Write('The file ',write_filename,
' exist. Overwrite ? [y]es, [n]o, [A]ll: ');
ReadLn(answer);
rep := answer[1] ;
if ((rep>='a') and (rep<='z')) then
Dec(rep, $20);
until (rep = 'Y') or (rep = 'N') or (rep = 'A');
end;
if (rep = 'N') then
skip := 1;
if (rep = 'A') then
popt_overwrite := 1;
end;
if (skip=0) and (err=UNZ_OK) then
begin
fout := fopen(write_filename,fopenwrite);
{ some zipfile don't contain directory alone before file }
if (fout=NIL) and (popt_extract_without_path=0) and
(filename_withoutpath <> PChar(@filename_inzip)) then
begin
c := (filename_withoutpath-1)^;
(filename_withoutpath-1)^ := #0;
makedir(write_filename);
(filename_withoutpath-1)^ := c;
fout := fopen(write_filename, fopenwrite);
end;
if (fout=NIL) then
WriteLn('error opening ',write_filename);
end;
if (fout <> NIL) then
begin
WriteLn(' extracting: ',write_filename);
repeat
err := unzReadCurrentFile(uf,buf,size_buf);
if (err<0) then
begin
WriteLn('error ',err,' with zipfile in unzReadCurrentFile');
break;
end;
if (err>0) then
begin
if (fwrite(buf,err,1,fout) <> 1) then
begin
WriteLn('error in writing extracted file');
err := UNZ_ERRNO;
break;
end;
end;
until (err=0);
fclose(fout);
if (err=0) then
change_file_date(write_filename,file_info.dosDate,
file_info.tmu_date);
end;
if (err=UNZ_OK) then
begin
err := unzCloseCurrentFile (uf);
if (err <> UNZ_OK) then
WriteLn('error ',err,' with zipfile in unzCloseCurrentFile')
else
unzCloseCurrentFile(uf); { don't lose the error }
end;
end;
if buf <> NIL then
zcfree(NIL, buf);
do_extract_currentfile := err;
end;
function do_extract(uf : unzFile;
opt_extract_without_path : int;
opt_overwrite : int) : int;
var
i : uLong;
gi : unz_global_info;
err : int;
begin
err := unzGetGlobalInfo (uf, gi);
if (err <> UNZ_OK) then
WriteLn('error ',err,' with zipfile in unzGetGlobalInfo ');
for i:=0 to gi.number_entry-1 do
begin
if (do_extract_currentfile(uf, opt_extract_without_path,
opt_overwrite) <> UNZ_OK) then
break;
if ((i+1)<gi.number_entry) then
begin
err := unzGoToNextFile(uf);
if (err <> UNZ_OK) then
begin
WriteLn('error ',err,' with zipfile in unzGoToNextFile');
break;
end;
end;
end;
do_extract := 0;
end;
function do_extract_onefile(uf : unzFile;
const filename : PChar;
opt_extract_without_path : int;
opt_overwrite : int) : int;
begin
if (unzLocateFile(uf,filename,CASESENSITIVITY) <> UNZ_OK) then
begin
WriteLn('file ',filename,' not found in the zipfile');
do_extract_onefile := 2;
exit;
end;
if (do_extract_currentfile(uf, opt_extract_without_path,
opt_overwrite) = UNZ_OK) then
do_extract_onefile := 0
else
do_extract_onefile := 1;
end;
{ -------------------------------------------------------------------- }
function main : int;
const
zipfilename : PChar = NIL;
filename_to_extract : PChar = NIL;
var
i : int;
opt_do_list : int;
opt_do_extract : int;
opt_do_extract_withoutpath : int;
opt_overwrite : int;
filename_try : array[0..512-1] of char;
uf : unzFile;
var
p : int;
pstr : string[255];
c : char;
begin
opt_do_list := 0;
opt_do_extract := 1;
opt_do_extract_withoutpath := 0;
opt_overwrite := 0;
uf := NIL;
do_banner;
if (ParamCount=0) then
begin
do_help;
Halt(0);
end
else
begin
for i := 1 to ParamCount do
begin
pstr := ParamStr(i);
if pstr[1]='-' then
begin
for p := 2 to Length(pstr) do
begin
c := pstr[p];
Case UpCase(c) of
'L',
'V' : opt_do_list := 1;
'X' : opt_do_extract := 1;
'E' : begin
opt_do_extract := 1;
opt_do_extract_withoutpath := 1;
end;
'O' : opt_overwrite := 1;
end;
end;
end
else
begin
pstr := pstr + #0;
if (zipfilename = NIL) then
zipfilename := StrNew(PChar(@pstr[1]))
else
if (filename_to_extract=NIL) then
filename_to_extract := StrNew(PChar(@pstr[1]));
end;
end; { for }
end;
if (zipfilename <> NIL) then
begin
strcopy(filename_try,zipfilename);
uf := unzOpen(zipfilename);
if (uf = NIL) then
begin
strcat(filename_try,'.zip');
uf := unzOpen(filename_try);
end;
end;
if (uf = NIL) then
begin
WriteLn('Cannot open ',zipfilename,' or ',zipfilename,'.zip');
Halt(1);
end;
WriteLn(filename_try,' opened');
if (opt_do_list=1) then
begin
main := do_list(uf);
exit;
end
else
if (opt_do_extract=1) then
begin
if (filename_to_extract = NIL) then
begin
main := do_extract(uf,opt_do_extract_withoutpath,opt_overwrite);
exit;
end
else
begin
main := do_extract_onefile(uf,filename_to_extract,
opt_do_extract_withoutpath,opt_overwrite);
exit;
end;
end;
unzCloseCurrentFile(uf);
strDispose(zipfilename);
strDispose(filename_to_extract);
main := 0;
end;
begin
main;
Write('Done...');
Readln;
end.

344
contrib/fundamentals/ZLib/paszlib/minizip/MiniZip.pas Normal file
View File

@@ -0,0 +1,344 @@
Program MiniZip;
{ minizip demo package by Gilles Vollant
Usage : minizip [-o] file.zip [files_to_add]
a file.zip file is created, all files listed in [files_to_add] are added
to the new .zip file.
-o an existing .zip file with be overwritten without warning
Pascal tranlastion
Copyright (C) 2000 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
{$ifdef WIN32}
{$define Delphi}
{$ifndef FPC}
{$define Delphi32}
{$endif}
{$endif}
uses
{$ifdef Delphi}
SysUtils, Windows,
{$else}
WinDos, strings,
{$endif}
zutil, gzlib, ziputils, zip;
const
WRITEBUFFERSIZE = Z_BUFSIZE;
MAXFILENAME = Z_MAXFILENAMEINZIP;
{$ifdef Delphi32}
function filetime(f : PChar; { name of file to get info on }
var tmzip : tm_zip; { return value: access, modific. and creation times }
var dt : uLong) : uLong; { dostime }
var
ret : int;
var
ftLocal : TFileTime; // FILETIME;
hFind : THandle; // HANDLE;
ff32 : TWIN32FindData; // WIN32_FIND_DATA;
begin
ret := 0;
hFind := FindFirstFile(f, ff32);
if (hFind <> INVALID_HANDLE_VALUE) then
begin
FileTimeToLocalFileTime(ff32.ftLastWriteTime,ftLocal);
FileTimeToDosDateTime(ftLocal,LongRec(dt).hi,LongRec(dt).lo);
FindClose(hFind);
ret := 1;
end;
filetime := ret;
end;
{$else}
{$ifdef FPC}
function filetime(f : PChar; { name of file to get info on }
var tmzip : tm_zip; { return value: access, modific. and creation times }
var dt : uLong) : uLong; { dostime }
var
ret : int;
var
ftLocal : TFileTime; // FILETIME;
hFind : THandle; // HANDLE;
ff32 : TWIN32FindData; // WIN32_FIND_DATA;
begin
ret := 0;
hFind := FindFirstFile(f, @ff32);
if (hFind <> INVALID_HANDLE_VALUE) then
begin
FileTimeToLocalFileTime(ff32.ftLastWriteTime,@ftLocal);
FileTimeToDosDateTime(ftLocal,@LongRec(dt).hi,@LongRec(dt).lo);
FindClose(hFind);
ret := 1;
end;
filetime := ret;
end;
{$else}
function filetime(f : PChar; { name of file to get info on }
var tmzip : tm_zip; { return value: access, modific. and creation times }
var dt : uLong) : uLong; { dostime }
var
fl : file;
yy, mm, dd, dow : Word;
h, m, s, hund : Word; { For GetTime}
dtrec : TDateTime; { For Pack/UnpackTime}
begin
{$i-}
Assign(fl, f);
Reset(fl, 1);
if IOresult = 0 then
begin
GetFTime(fl,dt); { Get creation time }
UnpackTime(dt, dtrec);
Close(fl);
tmzip.tm_sec := dtrec.sec;
tmzip.tm_min := dtrec.min;
tmzip.tm_hour := dtrec.hour;
tmzip.tm_mday := dtrec.day;
tmzip.tm_mon := dtrec.month;
tmzip.tm_year := dtrec.year;
end;
filetime := 0;
end;
{$endif}
{$endif}
function check_exist_file(const filename : PChar) : int;
var
ftestexist : FILE;
ret : int;
begin
ret := 1;
Assign(ftestexist, filename);
{$i-}
reset(ftestexist);
if IOresult <> 0 then
ret := 0
else
system.close(ftestexist);
check_exist_file := ret;
end;
procedure do_banner;
begin
WriteLn('MiniZip 0.15, demo package written by Gilles Vollant');
WriteLn('Pascal port by Jacques Nomssi Nzali');
WriteLn('more info at http://www.tu-chemnitz.de/~nomssi/paszlib.html');
WriteLn;
end;
procedure do_help;
begin
WriteLn('Usage : minizip [-o] file.zip [files_to_add]');
WriteLn;
end;
function main : int;
var
argstr : string;
i : int;
opt_overwrite : int;
opt_compress_level : int;
zipfilenamearg : int;
filename_try : array[0..MAXFILENAME-1] of char;
zipok : int;
err : int;
size_buf : int;
buf : voidp;
var
p : PChar;
c : char;
var
len : int;
dot_found : int;
var
rep : char;
answer : string[128];
var
zf : zipFile;
errclose : int;
var
fin : FILEptr;
size_read : int;
filenameinzip : {const} PChar;
zi : zip_fileinfo;
begin
opt_overwrite := 0;
opt_compress_level := Z_DEFAULT_COMPRESSION;
zipfilenamearg := 0;
err := 0;
main := 0;
do_banner;
if (ParamCount=0) then
begin
do_help;
main := 0;
exit;
end
else
begin
for i:=1 to ParamCount-1+1 do
begin
argstr := ParamStr(i)+#0;
if (argstr[1]='-') then
begin
p := @argstr[1+1]; {const char *p=argv[i]+1;}
while (p^<>#0) do
begin
c := p^;
Inc(p);
if (c='o') or (c='O') then
opt_overwrite := 1;
if (c>='0') and (c<='9') then
opt_compress_level := Byte(c)-Byte('0');
end;
end
else
if (zipfilenamearg = 0) then
zipfilenamearg := i;
end;
end;
size_buf := WRITEBUFFERSIZE;
buf := ALLOC(size_buf);
if (buf=NIL) then
begin
WriteLn('Error allocating memory');
main := ZIP_INTERNALERROR;
exit;
end;
if (zipfilenamearg=0) then
zipok := 0
else
begin
dot_found := 0;
zipok := 1 ;
argstr := ParamStr(zipfilenamearg) + #0;
strcopy(filename_try, PChar(@argstr[1]));
len := strlen(filename_try);
for i:=0 to len-1 do
if (filename_try[i]='.') then
dot_found := 1;
if (dot_found = 0) then
strcat(filename_try,'.zip');
if (opt_overwrite=0) then
if (check_exist_file(filename_try)<>0) then
begin
repeat
WriteLn('The file ',filename_try,
' exist. Overwrite ? [y]es, [n]o : ');
ReadLn(answer);
rep := answer[1] ;
if (rep>='a') and (rep<='z') then
Dec(rep, $20);
until (rep='Y') or (rep='N');
if (rep='N') then
zipok := 0;
end;
end;
if (zipok=1) then
begin
zf := zipOpen(filename_try,0);
if (zf = NIL) then
begin
WriteLn('error opening ', filename_try);
err := ZIP_ERRNO;
end
else
WriteLn('creating ',filename_try);
i := zipfilenamearg+1;
while (i<=ParamCount) and (err=ZIP_OK) do
begin
argstr := ParamStr(i)+#0;
if (argstr[1] <>'-') and (argstr[1] <>'/') then
begin
filenameinzip := PChar(@argstr[1]);
zi.tmz_date.tm_sec := 0;
zi.tmz_date.tm_min := 0;
zi.tmz_date.tm_hour := 0;
zi.tmz_date.tm_mday := 0;
zi.tmz_date.tm_min := 0;
zi.tmz_date.tm_year := 0;
zi.dosDate := 0;
zi.internal_fa := 0;
zi.external_fa := 0;
filetime(filenameinzip,zi.tmz_date,zi.dosDate);
if (opt_compress_level <> 0) then
err := zipOpenNewFileInZip(zf,filenameinzip, @zi,
NIL,0,NIL,0,NIL { comment}, Z_DEFLATED, opt_compress_level)
else
err := zipOpenNewFileInZip(zf,filenameinzip, @zi,
NIL,0,NIL,0,NIL, 0, opt_compress_level);
if (err <> ZIP_OK) then
WriteLn('error in opening ',filenameinzip,' in zipfile')
else
begin
fin := fopen(filenameinzip, fopenread);
if (fin=NIL) then
begin
err := ZIP_ERRNO;
WriteLn('error in opening ',filenameinzip,' for reading');
end;
if (err = ZIP_OK) then
repeat
err := ZIP_OK;
size_read := fread(buf,1,size_buf,fin);
if (size_read < size_buf) then
if feof(fin)=0 then
begin
WriteLn('error in reading ',filenameinzip);
err := ZIP_ERRNO;
end;
if (size_read>0) then
begin
err := zipWriteInFileInZip (zf,buf,size_read);
if (err<0) then
WriteLn('error in writing ',filenameinzip,' in the zipfile');
end;
until (err <> ZIP_OK) or (size_read=0);
fclose(fin);
end;
if (err<0) then
err := ZIP_ERRNO
else
begin
err := zipCloseFileInZip(zf);
if (err<>ZIP_OK) then
WriteLn('error in closing ',filenameinzip,' in the zipfile');
end;
Inc(i);
end; { while }
end; { if }
errclose := zipClose(zf,NIL);
if (errclose <> ZIP_OK) then
WriteLn('error in closing ',filename_try);
end;
TRYFREE(buf); {FreeMem(buf, size_buf);}
end;
begin
main;
Write('Done...');
ReadLn;
end.

1629
contrib/fundamentals/ZLib/paszlib/minizip/UnZip.pas Normal file
View File

File diff suppressed because it is too large Load Diff

831
contrib/fundamentals/ZLib/paszlib/minizip/Zip.pas Normal file
View File

@@ -0,0 +1,831 @@
Unit zip;
{ zip.c -- IO on .zip files using zlib
zip.h -- IO for compress .zip files using zlib
Version 0.15 alpha, Mar 19th, 1998,
Copyright (C) 1998 Gilles Vollant
This package allows to create .ZIP file, compatible with PKZip 2.04g
WinZip, InfoZip tools and compatible.
Encryption and multi volume ZipFile (span) are not supported.
Old compressions used by old PKZip 1.x are not supported
For decompression of .zip files, look at unzip.pas
Pascal tranlastion
Copyright (C) 2000 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt }
interface
{$ifdef WIN32}
{$define Delphi}
{$endif}
uses
zutil,
gzLib,
ziputils;
const
ZIP_OK = (0);
ZIP_ERRNO = (Z_ERRNO);
ZIP_PARAMERROR = (-102);
ZIP_INTERNALERROR = (-104);
(*
{ tm_zip contain date/time info }
type
tm_zip = record
tm_sec : uInt; { seconds after the minute - [0,59] }
tm_min : uInt; { minutes after the hour - [0,59] }
tm_hour : uInt; { hours since midnight - [0,23] }
tm_mday : uInt; { day of the month - [1,31] }
tm_mon : uInt; { months since January - [0,11] }
tm_year : uInt; { years - [1980..2044] }
end;
*)
type
zip_fileinfo = record
tmz_date : tm_zip; { date in understandable format }
dosDate : uLong; { if dos_date = 0, tmu_date is used }
{ flag : uLong; } { general purpose bit flag 2 bytes }
internal_fa : uLong; { internal file attributes 2 bytes }
external_fa : uLong; { external file attributes 4 bytes }
end;
zip_fileinfo_ptr = ^zip_fileinfo;
function zipOpen (const pathname : PChar; append : int) : zipFile; {ZEXPORT}
{ Create a zipfile.
pathname contain on Windows NT a filename like "c:\\zlib\\zlib111.zip" or on
an Unix computer "zlib/zlib111.zip".
if the file pathname exist and append=1, the zip will be created at the end
of the file. (useful if the file contain a self extractor code)
If the zipfile cannot be opened, the return value is NIL.
Else, the return value is a zipFile Handle, usable with other function
of this zip package. }
function zipOpenNewFileInZip(afile : zipFile;
{const} filename : PChar;
const zipfi : zip_fileinfo_ptr;
const extrafield_local : voidp;
size_extrafield_local : uInt;
const extrafield_global : voidp;
size_extrafield_global : uInt;
const comment : PChar;
method : int;
level : int): int; {ZEXPORT}
{ Open a file in the ZIP for writing.
filename : the filename in zip (if NIL, '-' without quote will be used
zipfi^ contain supplemental information
if extrafield_local<>NIL and size_extrafield_local>0, extrafield_local
contains the extrafield data the the local header
if extrafield_global<>NIL and size_extrafield_global>0, extrafield_global
contains the extrafield data the the local header
if comment <> NIL, comment contain the comment string
method contain the compression method (0 for store, Z_DEFLATED for deflate)
level contain the level of compression (can be Z_DEFAULT_COMPRESSION) }
function zipWriteInFileInZip (afile : zipFile;
const buf : voidp;
len : unsigned) : int; {ZEXPORT}
{ Write data in the zipfile }
function zipCloseFileInZip (afile : zipFile): int; {ZEXPORT}
{ Close the current file in the zipfile }
function zipClose (afile : zipFile; const global_comment : PChar): int; {ZEXPORT}
{ Close the zipfile }
implementation
uses
{$ifdef Delphi}
SysUtils,
{$else}
strings,
{$endif}
zDeflate, crc;
const
VERSIONMADEBY = ($0); { platform depedent }
const
zip_copyright : PChar = ' zip 0.15 Copyright 1998 Gilles Vollant ';
const
SIZEDATA_INDATABLOCK = (4096-(4*4));
LOCALHEADERMAGIC = $04034b50;
{CENTRALHEADERMAGIC = $02014b50;}
ENDHEADERMAGIC = $06054b50;
FLAG_LOCALHEADER_OFFSET = $06;
CRC_LOCALHEADER_OFFSET = $0e;
SIZECENTRALHEADER = $2e; { 46 }
type
linkedlist_datablock_internal_ptr = ^linkedlist_datablock_internal;
linkedlist_datablock_internal = record
next_datablock : linkedlist_datablock_internal_ptr;
avail_in_this_block : uLong;
filled_in_this_block : uLong;
unused : uLong; { for future use and alignement }
data : array[0..SIZEDATA_INDATABLOCK-1] of byte;
end;
type
linkedlist_data = record
first_block : linkedlist_datablock_internal_ptr;
last_block : linkedlist_datablock_internal_ptr;
end;
linkedlist_data_ptr = ^linkedlist_data;
type
curfile_info = record
stream : z_stream; { zLib stream structure for inflate }
stream_initialised : boolean; { TRUE is stream is initialised }
pos_in_buffered_data : uInt; { last written byte in buffered_data }
pos_local_header : uLong; { offset of the local header of the file
currenty writing }
central_header : PChar; { central header data for the current file }
size_centralheader : uLong; { size of the central header for cur file }
flag : uLong; { flag of the file currently writing }
method : int; { compression method of file currenty wr.}
buffered_data : array[0..Z_BUFSIZE-1] of byte;{ buffer contain compressed data to be written}
dosDate : uLong;
crc32 : uLong;
end;
type
zip_internal = record
filezip : FILEptr;
central_dir : linkedlist_data; { datablock with central dir in construction}
in_opened_file_inzip : boolean; { TRUE if a file in the zip is currently writ.}
ci : curfile_info; { info on the file curretly writing }
begin_pos : uLong; { position of the beginning of the zipfile }
number_entry : uLong;
end;
zip_internal_ptr = ^zip_internal;
function allocate_new_datablock : linkedlist_datablock_internal_ptr;
var
ldi : linkedlist_datablock_internal_ptr;
begin
ldi := linkedlist_datablock_internal_ptr( ALLOC(sizeof(linkedlist_datablock_internal)) );
if (ldi<>NIL) then
begin
ldi^.next_datablock := NIL ;
ldi^.filled_in_this_block := 0 ;
ldi^.avail_in_this_block := SIZEDATA_INDATABLOCK ;
end;
allocate_new_datablock := ldi;
end;
procedure free_datablock(ldi : linkedlist_datablock_internal_ptr);
var
ldinext : linkedlist_datablock_internal_ptr;
begin
while (ldi<>NIL) do
begin
ldinext := ldi^.next_datablock;
TRYFREE(ldi);
ldi := ldinext;
end;
end;
procedure init_linkedlist(var ll : linkedlist_data);
begin
ll.last_block := NIL;
ll.first_block := NIL;
end;
procedure free_linkedlist(var ll : linkedlist_data);
begin
free_datablock(ll.first_block);
ll.last_block := NIL;
ll.first_block := NIL;
end;
function add_data_in_datablock(ll : linkedlist_data_ptr;
const buf : voidp;
len : uLong) : int;
var
ldi : linkedlist_datablock_internal_ptr;
from_copy : {const} pBytef ;
var
copy_this : uInt;
i : uInt;
to_copy : pBytef;
begin
if (ll=NIL) then
begin
add_data_in_datablock := ZIP_INTERNALERROR;
exit;
end;
if (ll^.last_block = NIL) then
begin
ll^.last_block := allocate_new_datablock;
ll^.first_block := ll^.last_block;
if (ll^.first_block = NIL) then
begin
add_data_in_datablock := ZIP_INTERNALERROR;
exit;
end;
end;
ldi := ll^.last_block;
from_copy := pBytef(buf);
while (len>0) do
begin
if (ldi^.avail_in_this_block=0) then
begin
ldi^.next_datablock := allocate_new_datablock;
if (ldi^.next_datablock = NIL) then
begin
add_data_in_datablock := ZIP_INTERNALERROR;
exit;
end;
ldi := ldi^.next_datablock ;
ll^.last_block := ldi;
end;
if (ldi^.avail_in_this_block < len) then
copy_this := uInt(ldi^.avail_in_this_block)
else
copy_this := uInt(len);
to_copy := @(ldi^.data[ldi^.filled_in_this_block]);
for i :=0 to copy_this-1 do
pzByteArray(to_copy)^[i] := pzByteArray(from_copy)^[i];
Inc(ldi^.filled_in_this_block, copy_this);
Dec(ldi^.avail_in_this_block, copy_this);
Inc(from_copy, copy_this);
Dec(len, copy_this);
end;
add_data_in_datablock := ZIP_OK;
end;
function write_datablock(fout : FILEptr; ll : linkedlist_data_ptr) : int;
var
ldi : linkedlist_datablock_internal_ptr;
begin
ldi := ll^.first_block;
while (ldi<>NIL) do
begin
if (ldi^.filled_in_this_block > 0) then
begin
if (fwrite(@ldi^.data,uInt(ldi^.filled_in_this_block),1,fout)<>1) then
begin
write_datablock := ZIP_ERRNO;
exit;
end;
end;
ldi := ldi^.next_datablock;
end;
write_datablock := ZIP_OK;
end;
{**************************************************************************}
{ ===========================================================================
Outputs a long in LSB order to the given file
nbByte = 1, 2 or 4 (byte, short or long) }
function ziplocal_putValue (afile : FILEptr; x : uLong; nbByte : int) : int;
var
buf : array[0..4-1] of byte;
n : int;
begin
for n := 0 to nbByte-1 do
begin
buf[n] := Byte(x and $ff);
x := x shr 8;
end;
if (fwrite(@buf,nbByte,1,afile)<>1) then
ziplocal_putValue := ZIP_ERRNO
else
ziplocal_putValue := ZIP_OK;
end;
procedure ziplocal_putValue_inmemory (dest : voidp;
x : uLong;
nbByte : int);
var
buf : pzByteArray;
n : int;
begin
buf := pzByteArray(dest);
for n := 0 to nbByte-1 do
begin
buf^[n] := Bytef(x and $ff);
x := x shr 8;
end;
end;
{**************************************************************************}
function ziplocal_TmzDateToDosDate(var ptm : tm_zip; dosDate : uLong) : uLong;
var
year : uLong;
begin
year := uLong(ptm.tm_year);
if (year>1980) then
Dec(year, 1980)
else
if (year>80) then
Dec(year, 80);
ziplocal_TmzDateToDosDate := uLong (
((ptm.tm_mday) + (32 * (ptm.tm_mon+1)) + (512 * year)) shl 16) or
((ptm.tm_sec div 2) + (32* ptm.tm_min) + (2048 * uLong(ptm.tm_hour)));
end;
{**************************************************************************}
function zipOpen (const pathname : PChar; append : int) : zipFile; {ZEXPORT}
var
ziinit : zip_internal;
zi : zip_internal_ptr;
begin
if (append = 0) then
ziinit.filezip := fopen(pathname, fopenwrite)
else
ziinit.filezip := fopen(pathname, fappendwrite);
if (ziinit.filezip = NIL) then
begin
zipOpen := NIL;
exit;
end;
ziinit.begin_pos := ftell(ziinit.filezip);
ziinit.in_opened_file_inzip := False;
ziinit.ci.stream_initialised := False;
ziinit.number_entry := 0;
init_linkedlist(ziinit.central_dir);
zi := zip_internal_ptr(ALLOC(sizeof(zip_internal)));
if (zi=NIL) then
begin
fclose(ziinit.filezip);
zipOpen := NIL;
exit;
end;
zi^ := ziinit;
zipOpen := zipFile(zi);
end;
function zipOpenNewFileInZip (afile : zipFile;
{const} filename : PChar;
const zipfi : zip_fileinfo_ptr;
const extrafield_local : voidp;
size_extrafield_local : uInt;
const extrafield_global : voidp;
size_extrafield_global : uInt;
const comment : PChar;
method : int;
level : int) : int; {ZEXPORT}
var
zi : zip_internal_ptr;
size_filename : uInt;
size_comment : uInt;
i : uInt;
err : int;
begin
err := ZIP_OK;
if (afile = NIL) then
begin
zipOpenNewFileInZip := ZIP_PARAMERROR;
exit;
end;
if ((method<>0) and (method<>Z_DEFLATED)) then
begin
zipOpenNewFileInZip := ZIP_PARAMERROR;
exit;
end;
zi := zip_internal_ptr(afile);
if (zi^.in_opened_file_inzip = True) then
begin
err := zipCloseFileInZip (afile);
if (err <> ZIP_OK) then
begin
zipOpenNewFileInZip := err;
exit;
end;
end;
if (filename=NIL) then
filename := '-';
if (comment=NIL) then
size_comment := 0
else
size_comment := strlen(comment);
size_filename := strlen(filename);
if (zipfi = NIL) then
zi^.ci.dosDate := 0
else
begin
if (zipfi^.dosDate <> 0) then
zi^.ci.dosDate := zipfi^.dosDate
else
zi^.ci.dosDate := ziplocal_TmzDateToDosDate(zipfi^.tmz_date,zipfi^.dosDate);
end;
zi^.ci.flag := 0;
if ((level=8) or (level=9)) then
zi^.ci.flag := zi^.ci.flag or 2;
if ((level=2)) then
zi^.ci.flag := zi^.ci.flag or 4;
if ((level=1)) then
zi^.ci.flag := zi^.ci.flag or 6;
zi^.ci.crc32 := 0;
zi^.ci.method := method;
zi^.ci.stream_initialised := False;
zi^.ci.pos_in_buffered_data := 0;
zi^.ci.pos_local_header := ftell(zi^.filezip);
zi^.ci.size_centralheader := SIZECENTRALHEADER + size_filename +
size_extrafield_global + size_comment;
zi^.ci.central_header := PChar( ALLOC( uInt(zi^.ci.size_centralheader)) );
ziplocal_putValue_inmemory(zi^.ci.central_header,uLong(CENTRALHEADERMAGIC),4);
{ version info }
ziplocal_putValue_inmemory(zi^.ci.central_header+4,uLong(VERSIONMADEBY),2);
ziplocal_putValue_inmemory(zi^.ci.central_header+6,uLong(20),2);
ziplocal_putValue_inmemory(zi^.ci.central_header+8,uLong(zi^.ci.flag),2);
ziplocal_putValue_inmemory(zi^.ci.central_header+10,uLong(zi^.ci.method),2);
ziplocal_putValue_inmemory(zi^.ci.central_header+12,uLong(zi^.ci.dosDate),4);
ziplocal_putValue_inmemory(zi^.ci.central_header+16,uLong(0),4); {crc}
ziplocal_putValue_inmemory(zi^.ci.central_header+20,uLong(0),4); {compr size}
ziplocal_putValue_inmemory(zi^.ci.central_header+24,uLong(0),4); {uncompr size}
ziplocal_putValue_inmemory(zi^.ci.central_header+28,uLong(size_filename),2);
ziplocal_putValue_inmemory(zi^.ci.central_header+30,uLong(size_extrafield_global),2);
ziplocal_putValue_inmemory(zi^.ci.central_header+32,uLong(size_comment),2);
ziplocal_putValue_inmemory(zi^.ci.central_header+34,uLong(0),2); {disk nm start}
if (zipfi=NIL) then
ziplocal_putValue_inmemory(zi^.ci.central_header+36,uLong(0),2)
else
ziplocal_putValue_inmemory(zi^.ci.central_header+36,uLong(zipfi^.internal_fa),2);
if (zipfi=NIL) then
ziplocal_putValue_inmemory(zi^.ci.central_header+38,uLong(0),4)
else
ziplocal_putValue_inmemory(zi^.ci.central_header+38,uLong(zipfi^.external_fa),4);
ziplocal_putValue_inmemory(zi^.ci.central_header+42,uLong(zi^.ci.pos_local_header),4);
i := 0;
while (i < size_filename) do
begin
(zi^.ci.central_header+SIZECENTRALHEADER+i)^ := (filename+i)^;
Inc(i);
end;
i := 0;
while (i < size_extrafield_global) do
begin
(zi^.ci.central_header+SIZECENTRALHEADER+size_filename+i)^ :=
({const} PChar(extrafield_global)+i)^;
Inc(i);
end;
i:= 0;
while (i < size_comment) do
begin
(zi^.ci.central_header+SIZECENTRALHEADER+size_filename+ size_extrafield_global+i)^ := (filename+i)^;
Inc(i);
end;
if (zi^.ci.central_header = NIL) then
begin
zipOpenNewFileInZip := ZIP_INTERNALERROR;
exit;
end;
{ write the local header }
err := ziplocal_putValue(zi^.filezip, uLong(LOCALHEADERMAGIC),4);
if (err=ZIP_OK) then
err := ziplocal_putValue(zi^.filezip,uLong(20),2); { version needed to extract }
if (err=ZIP_OK) then
err := ziplocal_putValue(zi^.filezip,uLong(zi^.ci.flag),2);
if (err=ZIP_OK) then
err := ziplocal_putValue(zi^.filezip,uLong(zi^.ci.method),2);
if (err=ZIP_OK) then
err := ziplocal_putValue(zi^.filezip,uLong(zi^.ci.dosDate),4);
if (err=ZIP_OK) then
err := ziplocal_putValue(zi^.filezip,uLong(0),4); { crc 32, unknown }
if (err=ZIP_OK) then
err := ziplocal_putValue(zi^.filezip,uLong(0),4); { compressed size, unknown }
if (err=ZIP_OK) then
err := ziplocal_putValue(zi^.filezip,uLong(0),4); { uncompressed size, unknown }
if (err=ZIP_OK) then
err := ziplocal_putValue(zi^.filezip,uLong(size_filename),2);
if (err=ZIP_OK) then
err := ziplocal_putValue(zi^.filezip,uLong(size_extrafield_local),2);
if ((err=ZIP_OK) and (size_filename>0)) then
begin
if (fwrite(filename,uInt(size_filename),1,zi^.filezip)<>1) then
err := ZIP_ERRNO;
end;
if ((err=ZIP_OK) and (size_extrafield_local>0)) then
begin
if (fwrite(extrafield_local, uInt(size_extrafield_local),1,zi^.filezip) <>1) then
err := ZIP_ERRNO;
end;
zi^.ci.stream.avail_in := uInt(0);
zi^.ci.stream.avail_out := uInt(Z_BUFSIZE);
zi^.ci.stream.next_out := pBytef(@zi^.ci.buffered_data);
zi^.ci.stream.total_in := 0;
zi^.ci.stream.total_out := 0;
if ((err=ZIP_OK) and (zi^.ci.method = Z_DEFLATED)) then
begin
zi^.ci.stream.zalloc := NIL;
zi^.ci.stream.zfree := NIL;
zi^.ci.stream.opaque := NIL;
err := deflateInit2(zi^.ci.stream, level,
Z_DEFLATED, -MAX_WBITS, DEF_MEM_LEVEL, 0);
if (err=Z_OK) then
zi^.ci.stream_initialised := True;
end;
if (err=Z_OK) then
zi^.in_opened_file_inzip := True;
zipOpenNewFileInZip := err;
end;
function zipWriteInFileInZip (afile : zipFile; const buf : voidp; len : unsigned) : int; {ZEXPORT}
var
zi : zip_internal_ptr;
err : int;
var
uTotalOutBefore : uLong;
var
copy_this,i : uInt;
begin
err := ZIP_OK;
if (afile = NIL) then
begin
zipWriteInFileInZip := ZIP_PARAMERROR;
exit;
end;
zi := zip_internal_ptr(afile);
if (zi^.in_opened_file_inzip = False) then
begin
zipWriteInFileInZip := ZIP_PARAMERROR;
exit;
end;
zi^.ci.stream.next_in := buf;
zi^.ci.stream.avail_in := len;
zi^.ci.crc32 := crc32(zi^.ci.crc32,buf,len);
while ((err=ZIP_OK) and (zi^.ci.stream.avail_in>0)) do
begin
if (zi^.ci.stream.avail_out = 0) then
begin
if fwrite(@zi^.ci.buffered_data,uInt(zi^.ci.pos_in_buffered_data),1,zi^.filezip)<>1 then
err := ZIP_ERRNO;
zi^.ci.pos_in_buffered_data := 0;
zi^.ci.stream.avail_out := uInt(Z_BUFSIZE);
zi^.ci.stream.next_out := pBytef(@zi^.ci.buffered_data);
end;
if (zi^.ci.method = Z_DEFLATED) then
begin
uTotalOutBefore := zi^.ci.stream.total_out;
err := deflate(zi^.ci.stream, Z_NO_FLUSH);
Inc(zi^.ci.pos_in_buffered_data, uInt(zi^.ci.stream.total_out - uTotalOutBefore) );
end
else
begin
if (zi^.ci.stream.avail_in < zi^.ci.stream.avail_out) then
copy_this := zi^.ci.stream.avail_in
else
copy_this := zi^.ci.stream.avail_out;
for i := 0 to copy_this-1 do
(PChar(zi^.ci.stream.next_out)+i)^ :=
( {const} PChar(zi^.ci.stream.next_in) +i)^;
Dec(zi^.ci.stream.avail_in, copy_this);
Dec(zi^.ci.stream.avail_out, copy_this);
Inc(zi^.ci.stream.next_in, copy_this);
Inc(zi^.ci.stream.next_out, copy_this);
Inc(zi^.ci.stream.total_in, copy_this);
Inc(zi^.ci.stream.total_out, copy_this);
Inc(zi^.ci.pos_in_buffered_data, copy_this);
end;
end;
zipWriteInFileInZip := 0;
end;
function zipCloseFileInZip (afile : zipFile) : int; {ZEXPORT}
var
zi : zip_internal_ptr;
err : int;
var
uTotalOutBefore : uLong;
var
cur_pos_inzip : long;
begin
err := ZIP_OK;
if (afile = NIL) then
begin
zipCloseFileInZip := ZIP_PARAMERROR;
exit;
end;
zi := zip_internal_ptr(afile);
if (zi^.in_opened_file_inzip = False) then
begin
zipCloseFileInZip := ZIP_PARAMERROR;
exit;
end;
zi^.ci.stream.avail_in := 0;
if (zi^.ci.method = Z_DEFLATED) then
while (err=ZIP_OK) do
begin
if (zi^.ci.stream.avail_out = 0) then
begin
if fwrite(@zi^.ci.buffered_data,uInt(zi^.ci.pos_in_buffered_data),1,zi^.filezip) <>1 then
err := ZIP_ERRNO;
zi^.ci.pos_in_buffered_data := 0;
zi^.ci.stream.avail_out := uInt(Z_BUFSIZE);
zi^.ci.stream.next_out := pBytef(@zi^.ci.buffered_data);
end;
uTotalOutBefore := zi^.ci.stream.total_out;
err := deflate(zi^.ci.stream, Z_FINISH);
Inc(zi^.ci.pos_in_buffered_data, uInt(zi^.ci.stream.total_out - uTotalOutBefore) );
end;
if (err=Z_STREAM_END) then
err := ZIP_OK; { this is normal }
if (zi^.ci.pos_in_buffered_data>0) and (err=ZIP_OK) then
begin
if fwrite(@zi^.ci.buffered_data,uInt(zi^.ci.pos_in_buffered_data),1,zi^.filezip) <>1 then
err := ZIP_ERRNO;
end;
if ((zi^.ci.method = Z_DEFLATED) and (err=ZIP_OK)) then
begin
err := deflateEnd(zi^.ci.stream);
zi^.ci.stream_initialised := False;
end;
ziplocal_putValue_inmemory(zi^.ci.central_header+16, uLong(zi^.ci.crc32),4); {crc}
ziplocal_putValue_inmemory(zi^.ci.central_header+20, uLong(zi^.ci.stream.total_out),4); {compr size}
ziplocal_putValue_inmemory(zi^.ci.central_header+24, uLong(zi^.ci.stream.total_in),4); {uncompr size}
if (err=ZIP_OK) then
err := add_data_in_datablock(@zi^.central_dir,zi^.ci.central_header, uLong(zi^.ci.size_centralheader));
TRYFREE(zi^.ci.central_header);
if (err=ZIP_OK) then
begin
cur_pos_inzip := ftell(zi^.filezip);
if fseek(zi^.filezip, zi^.ci.pos_local_header + 14,SEEK_SET)<>0 then
err := ZIP_ERRNO;
if (err=ZIP_OK) then
err := ziplocal_putValue(zi^.filezip, uLong(zi^.ci.crc32),4); { crc 32, unknown }
if (err=ZIP_OK) then { compressed size, unknown }
err := ziplocal_putValue(zi^.filezip, uLong(zi^.ci.stream.total_out),4);
if (err=ZIP_OK) then { uncompressed size, unknown }
err := ziplocal_putValue(zi^.filezip,uLong(zi^.ci.stream.total_in),4);
if fseek(zi^.filezip, cur_pos_inzip,SEEK_SET)<>0 then
err := ZIP_ERRNO;
end;
Inc(zi^.number_entry);
zi^.in_opened_file_inzip := False;
zipCloseFileInZip := err;
end;
function zipClose (afile : zipFile;
const global_comment : PChar) : int; {ZEXPORT}
var
zi : zip_internal_ptr;
err : int;
size_centraldir : uLong;
centraldir_pos_inzip : uLong;
size_global_comment : uInt;
var
ldi : linkedlist_datablock_internal_ptr;
begin
err := 0;
size_centraldir := 0;
if (afile = NIL) then
begin
zipClose := ZIP_PARAMERROR;
exit;
end;
zi := zip_internal_ptr(afile);
if (zi^.in_opened_file_inzip = True) then
begin
err := zipCloseFileInZip (afile);
end;
if (global_comment=NIL) then
size_global_comment := 0
else
size_global_comment := strlen(global_comment);
centraldir_pos_inzip := ftell(zi^.filezip);
if (err=ZIP_OK) then
begin
ldi := zi^.central_dir.first_block ;
while (ldi<>NIL) do
begin
if ((err=ZIP_OK) and (ldi^.filled_in_this_block>0)) then
begin
if fwrite(@ldi^.data,uInt(ldi^.filled_in_this_block), 1,zi^.filezip)<>1 then
err := ZIP_ERRNO;
end;
Inc(size_centraldir, ldi^.filled_in_this_block);
ldi := ldi^.next_datablock;
end;
end;
free_datablock(zi^.central_dir.first_block);
if (err=ZIP_OK) then { Magic End }
err := ziplocal_putValue(zi^.filezip, uLong(ENDHEADERMAGIC),4);
if (err=ZIP_OK) then { number of this disk }
err := ziplocal_putValue(zi^.filezip, uLong(0),2);
if (err=ZIP_OK) then { number of the disk with the start of the central directory }
err := ziplocal_putValue(zi^.filezip, uLong(0),2);
if (err=ZIP_OK) then { total number of entries in the central dir on this disk }
err := ziplocal_putValue(zi^.filezip, uLong(zi^.number_entry),2);
if (err=ZIP_OK) then { total number of entries in the central dir }
err := ziplocal_putValue(zi^.filezip, uLong(zi^.number_entry),2);
if (err=ZIP_OK) then { size of the central directory }
err := ziplocal_putValue(zi^.filezip, uLong(size_centraldir),4);
if (err=ZIP_OK) then { offset of start of central directory with respect to the
starting disk number }
err := ziplocal_putValue(zi^.filezip, uLong(centraldir_pos_inzip) ,4);
if (err=ZIP_OK) then { zipfile comment length }
err := ziplocal_putValue(zi^.filezip, uLong(size_global_comment),2);
if ((err=ZIP_OK) and (size_global_comment>0)) then
begin
if fwrite(global_comment, uInt(size_global_comment),1,zi^.filezip)<>1 then
err := ZIP_ERRNO;
end;
fclose(zi^.filezip);
TRYFREE(zi);
zipClose := err;
end;
end.

331
contrib/fundamentals/ZLib/paszlib/minizip/ZipUtil.pas Normal file
View File

@@ -0,0 +1,331 @@
Unit ziputils;
{ ziputils.pas - IO on .zip files using zlib
- definitions, declarations and routines used by both
zip.pas and unzip.pas
The file IO is implemented here.
based on work by Gilles Vollant
March 23th, 2000,
Copyright (C) 2000 Jacques Nomssi Nzali }
interface
{$undef UseStream}
{$ifdef WIN32}
{$define Delphi}
{$ifdef UseStream}
{$define Streams}
{$endif}
{$endif}
uses
{$ifdef Delphi}
classes, SysUtils,
{$endif}
zutil;
{ -------------------------------------------------------------- }
{$ifdef Streams}
type
FILEptr = TFileStream;
{$else}
type
FILEptr = ^file;
{$endif}
type
seek_mode = (SEEK_SET, SEEK_CUR, SEEK_END);
open_mode = (fopenread, fopenwrite, fappendwrite);
function fopen(filename : PChar; mode : open_mode) : FILEptr;
procedure fclose(fp : FILEptr);
function fseek(fp : FILEptr; recPos : uLong; mode : seek_mode) : int;
function fread(buf : voidp; recSize : uInt;
recCount : uInt; fp : FILEptr) : uInt;
function fwrite(buf : voidp; recSize : uInt;
recCount : uInt; fp : FILEptr) : uInt;
function ftell(fp : FILEptr) : uLong; { ZIP }
function feof(fp : FILEptr) : uInt; { MiniZIP }
{ ------------------------------------------------------------------- }
type
zipFile = voidp;
unzFile = voidp;
type
z_off_t = long;
{ tm_zip contain date/time info }
type
tm_zip = record
tm_sec : uInt; { seconds after the minute - [0,59] }
tm_min : uInt; { minutes after the hour - [0,59] }
tm_hour : uInt; { hours since midnight - [0,23] }
tm_mday : uInt; { day of the month - [1,31] }
tm_mon : uInt; { months since January - [0,11] }
tm_year : uInt; { years - [1980..2044] }
end;
tm_unz = tm_zip;
const
Z_BUFSIZE = (16384);
Z_MAXFILENAMEINZIP = (256);
const
CENTRALHEADERMAGIC = $02014b50;
const
SIZECENTRALDIRITEM = $2e;
SIZEZIPLOCALHEADER = $1e;
function ALLOC(size : int) : voidp;
procedure TRYFREE(p : voidp);
const
Paszip_copyright : PChar = ' Paszip Copyright 2000 Jacques Nomssi Nzali ';
implementation
function ALLOC(size : int) : voidp;
begin
ALLOC := zcalloc (NIL, size, 1);
end;
procedure TRYFREE(p : voidp);
begin
if Assigned(p) then
zcfree(NIL, p);
end;
{$ifdef Streams}
{ ---------------------------------------------------------------- }
function fopen(filename : PChar; mode : open_mode) : FILEptr;
var
fp : FILEptr;
begin
fp := NIL;
try
Case mode of
fopenread: fp := TFileStream.Create(filename, fmOpenRead);
fopenwrite: fp := TFileStream.Create(filename, fmCreate);
fappendwrite :
begin
fp := TFileStream.Create(filename, fmOpenReadWrite);
fp.Seek(soFromEnd, 0);
end;
end;
except
on EFOpenError do
fp := NIL;
end;
fopen := fp;
end;
procedure fclose(fp : FILEptr);
begin
fp.Free;
end;
function fread(buf : voidp;
recSize : uInt;
recCount : uInt;
fp : FILEptr) : uInt;
var
totalSize, readcount : uInt;
begin
if Assigned(buf) then
begin
totalSize := recCount * uInt(recSize);
readCount := fp.Read(buf^, totalSize);
if (readcount <> totalSize) then
fread := readcount div recSize
else
fread := recCount;
end
else
fread := 0;
end;
function fwrite(buf : voidp;
recSize : uInt;
recCount : uInt;
fp : FILEptr) : uInt;
var
totalSize, written : uInt;
begin
if Assigned(buf) then
begin
totalSize := recCount * uInt(recSize);
written := fp.Write(buf^, totalSize);
if (written <> totalSize) then
fwrite := written div recSize
else
fwrite := recCount;
end
else
fwrite := 0;
end;
function fseek(fp : FILEptr;
recPos : uLong;
mode : seek_mode) : int;
const
fsmode : array[seek_mode] of Word
= (soFromBeginning, soFromCurrent, soFromEnd);
begin
fp.Seek(recPos, fsmode[mode]);
fseek := 0; { = 0 for success }
end;
function ftell(fp : FILEptr) : uLong;
begin
ftell := fp.Position;
end;
function feof(fp : FILEptr) : uInt;
begin
feof := 0;
if Assigned(fp) then
if fp.Position = fp.Size then
feof := 1
else
feof := 0;
end;
{$else}
{ ---------------------------------------------------------------- }
function fopen(filename : PChar; mode : open_mode) : FILEptr;
var
fp : FILEptr;
OldFileMode : byte;
begin
fp := NIL;
OldFileMode := FileMode;
GetMem(fp, SizeOf(file));
Assign(fp^, filename);
{$i-}
Case mode of
fopenread:
begin
FileMode := 0;
Reset(fp^, 1);
end;
fopenwrite:
begin
FileMode := 1;
ReWrite(fp^, 1);
end;
fappendwrite :
begin
FileMode := 2;
Reset(fp^, 1);
Seek(fp^, FileSize(fp^));
end;
end;
FileMode := OldFileMode;
if IOresult<>0 then
begin
FreeMem(fp, SizeOf(file));
fp := NIL;
end;
fopen := fp;
end;
procedure fclose(fp : FILEptr);
begin
if Assigned(fp) then
begin
{$i-}
system.close(fp^);
if IOresult=0 then;
FreeMem(fp, SizeOf(file));
end;
end;
function fread(buf : voidp;
recSize : uInt;
recCount : uInt;
fp : FILEptr) : uInt;
var
totalSize, readcount : uInt;
begin
if Assigned(buf) then
begin
totalSize := recCount * uInt(recSize);
{$i-}
system.BlockRead(fp^, buf^, totalSize, readcount);
if (readcount <> totalSize) then
fread := readcount div recSize
else
fread := recCount;
end
else
fread := 0;
end;
function fwrite(buf : voidp;
recSize : uInt;
recCount : uInt;
fp : FILEptr) : uInt;
var
totalSize, written : uInt;
begin
if Assigned(buf) then
begin
totalSize := recCount * uInt(recSize);
{$i-}
system.BlockWrite(fp^, buf^, totalSize, written);
if (written <> totalSize) then
fwrite := written div recSize
else
fwrite := recCount;
end
else
fwrite := 0;
end;
function fseek(fp : FILEptr;
recPos : uLong;
mode : seek_mode) : int;
begin
{$i-}
case mode of
SEEK_SET : system.Seek(fp^, recPos);
SEEK_CUR : system.Seek(fp^, FilePos(fp^)+recPos);
SEEK_END : system.Seek(fp^, FileSize(fp^)-1-recPos); { ?? check }
end;
fseek := IOresult; { = 0 for success }
end;
function ftell(fp : FILEptr) : uLong;
begin
ftell := FilePos(fp^);
end;
function feof(fp : FILEptr) : uInt;
begin
feof := 0;
if Assigned(fp) then
if eof(fp^) then
feof := 1
else
feof := 0;
end;
{$endif}
{ ---------------------------------------------------------------- }
end.