mORMot and Open Source friends
Check-in [dec5dae65c]
Check-in [dec5dae65c]
Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
| Comment: | {643} fixed FPC compilation under Windows (previous commit about PasZLib integration was buggy) |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
dec5dae65cefbb7ec635b4b2fc63fc56 |
| User & Date: | ab 2014-12-12 20:52:33 |
|
2014-12-17
| ||
| 08:45 | {644} updated ORMCSD third-party demo by AntonE check-in: 18a17c7a76 user: ab tags: trunk | |
|
2014-12-12
| ||
| 20:52 | {643} fixed FPC compilation under Windows (previous commit about PasZLib integration was buggy) check-in: dec5dae65c user: ab tags: trunk | |
| 20:13 | {642} fixed LVCL compilation issue check-in: 6fa6bb1c26 user: ab tags: trunk | |
Changes to SynZip.pas.
284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 ... 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 .... 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 .... 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 .... 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 .... 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 .... 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 .... 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 .... 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 .... 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 .... 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 .... 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 .... 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 |
// -> do Codegear knows about regression tests?
type
/// exception raised internaly in case of Zip errors
ESynZipException = class(Exception);
/// the internal memory structure as expected by the ZLib library
{$ifndef UNICODE}
TZStream = object
{$else}
TZStream = record
{$endif}
next_in : PAnsiChar;
avail_in : cardinal;
total_in : cardinal;
next_out : PAnsiChar;
avail_out : cardinal;
total_out : cardinal;
msg : PAnsiChar;
................................................................................
state : pointer;
zalloc : pointer;
zfree : pointer;
opaque : pointer;
data_type: integer;
adler : cardinal;
reserved : cardinal;
procedure Init;
function DeflateInit(CompressionLevel: integer; ZipFormat: Boolean): Boolean;
end;
PZStream = ^TZStream;
{$A-} { force packed object (not allowed under Delphi 2009) }
PFileInfo = ^TFileInfo;
/// generic file information structure, as used in .zip file format
// - used in any header, contains info about following block
{$ifndef UNICODE}
TFileInfo = object
{$else}
................................................................................
end;
procedure zlibFreeMem(AppData, Block: Pointer); cdecl;
begin
FreeMem(Block);
end;
procedure TZStream.Init;
begin
fillchar(Self,sizeof(Self),0);
zalloc := @zlibAllocMem; // even under Linux, use program heap
zfree := @zlibFreeMem;
end;
{$else} // Windows:
{$ifndef USEZLIB}
// our very own short implementation of ZLibH
................................................................................
function crc32(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}crc32(crc,pointer(buf),len);
end;
function deflateInit2_(var strm: TZStream; level: integer; method: integer; windowBits: integer; memLevel: integer;strategy: integer; version: PAnsiChar; stream_size: integer): integer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}deflateInit2_(z_streamp(@strm)^,level,method,windowBits,memLevel,strategy,version,stream_size);
end;
function deflate(var strm: TZStream; flush: integer): integer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}deflate(z_streamp(@strm)^,flush);
end;
function deflateEnd(var strm: TZStream): integer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}deflateEnd(z_streamp(@strm)^);
end;
function inflateInit2_(var strm: TZStream; windowBits: integer; version: PAnsiChar; stream_size: integer): integer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}inflateInit2_(z_streamp(@strm)^,windowBits,version,stream_size);
end;
function inflate(var strm: TZStream; flush: integer): integer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}inflate(z_streamp(@strm)^,flush);
end;
function inflateEnd(var strm: TZStream): integer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}inflateEnd(z_streamp(@strm)^);
end;
function get_crc_table: pointer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}get_crc_table;
end;
................................................................................
function get_crc_table: pointer;
begin
result := @crc32tab;
end;
{$endif USEZLIB}
procedure TZStream.Init;
begin
fillchar(Self,sizeof(Self),0);
end;
{$endif LINUX}
function compressBound(sourceLen: cardinal): cardinal;
begin
result := sourceLen + (sourceLen shr 12) + (sourceLen shr 14) + 11;
................................................................................
end;
procedure _memset(dest: Pointer; val: Integer; count: integer); cdecl;
begin // will use fastcode if compiled within
FillChar(dest^, count, val);
end;
function TZStream.DeflateInit(CompressionLevel: integer; ZipFormat: Boolean): Boolean;
var Bits: integer;
begin
if ZipFormat then
Bits := MAX_WBITS else
Bits := -MAX_WBITS;
result := deflateInit2_(self, CompressionLevel, Z_DEFLATED, Bits, DEF_MEM_LEVEL,
Z_DEFAULT_STRATEGY, ZLIB_VERSION, sizeof(self))>=0
end;
function Check(const Code: Integer; const ValidCodes: array of Integer): integer;
var i: Integer;
begin
if Code=Z_MEM_ERROR then
OutOfMemoryError;
................................................................................
end;
end;
function CompressMem(src, dst: pointer; srcLen, dstLen: integer;
CompressionLevel: integer=6; ZipFormat: Boolean=false) : integer;
var strm: TZStream;
begin
strm.Init;
strm.next_in := src;
strm.avail_in := srcLen;
strm.next_out := dst;
strm.avail_out := dstLen; // -MAX_WBITS -> no zLib header => .zip compatible !
if strm.DeflateInit(CompressionLevel,ZipFormat) then
try
Check(deflate(strm,Z_FINISH),[Z_STREAM_END,Z_OK]);
finally
deflateEnd(strm);
end;
result := strm.total_out;
end;
................................................................................
Count := SizeOf(buf) - strm.avail_out;
if Count=0 then exit;
aStream.Write(buf,Count);
strm.next_out := @buf;
strm.avail_out := sizeof(buf);
end;
begin
strm.Init;
strm.next_in := src;
strm.avail_in := srcLen;
strm.next_out := @buf;
strm.avail_out := sizeof(buf);
if strm.DeflateInit(CompressionLevel,ZipFormat) then
try // -MAX_WBITS -> no zLib header => .zip compatible !
repeat
code := Check(deflate(strm, Z_FINISH),[Z_OK,Z_STREAM_END,Z_BUF_ERROR]);
FlushBuf;
until code=Z_STREAM_END;
FlushBuf;
finally
................................................................................
result := strm.total_out;
end;
function UnCompressMem(src, dst: pointer; srcLen, dstLen: integer) : integer;
var strm: TZStream;
// Z: TMemoryStream; R: Int64Rec;
begin
strm.Init;
strm.next_in := src;
strm.avail_in := srcLen;
strm.next_out := dst;
strm.avail_out := dstLen;
if inflateInit2_(strm, -MAX_WBITS, ZLIB_VERSION, sizeof(strm))>=0 then
try // -MAX_WBITS -> no zLib header => .zip compatible !
Check(inflate(strm, Z_FINISH),[Z_OK,Z_STREAM_END]);
................................................................................
CheckCRC^ := crc32(CheckCRC^,@buf,Count);
if aStream<>nil then
aStream.Write(buf,Count);
strm.next_out := @buf;
strm.avail_out := sizeof(buf);
end;
begin
strm.Init;
strm.next_in := src;
strm.avail_in := srcLen;
strm.next_out := @buf;
strm.avail_out := sizeof(buf);
if checkCRC<>nil then
CheckCRC^ := 0;
if inflateInit2_(strm, -MAX_WBITS, ZLIB_VERSION, sizeof(strm))>=0 then
................................................................................
end;
procedure CompressInternal(var Data: RawByteString; Compress: boolean; Bits: integer);
var strm: TZStream;
code, len: integer;
tmp: RawByteString;
begin
strm.Init;
strm.next_in := pointer(Data);
strm.avail_in := length(Data);
if Compress then begin
SetString(tmp,nil,strm.avail_in+256+strm.avail_in shr 3); // max mem required
strm.next_out := pointer(tmp);
strm.avail_out := length(tmp);
// +MAX_WBITS below = encode in deflate format
................................................................................
if inflateInit2_(strm, bits, ZLIB_VERSION, sizeof(strm))>=0 then
try
repeat
code := Check(inflate(strm, Z_FINISH),[Z_OK,Z_STREAM_END,Z_BUF_ERROR]);
if strm.avail_out=0 then begin
// need to increase buffer by chunk
SetLength(tmp,length(tmp)+len);
strm.next_out := PAnsiChar(pointer(tmp))+length(tmp)-len;
strm.avail_out := len;
end;
until code=Z_STREAM_END;
finally
inflateEnd(strm);
end;
end;
................................................................................
constructor TSynZipCompressor.Create(outStream: TStream; CompressionLevel: Integer;
Format: TSynZipCompressorFormat = szcfRaw);
begin
fDestStream := outStream;
fGZFormat := (Format=szcfGZ);
if fGZFormat then
fDestStream.Write(gzHeader,10);
with FStrm do begin
Init;
next_out := @FBufferOut;
avail_out := SizeOf(FBufferOut);
fInitialized := DeflateInit(CompressionLevel,Format=szcfZip);
end;
end;
procedure TSynZipCompressor.Flush;
begin
if FInitialized then begin
while (Check(deflate(FStrm, Z_FINISH),[Z_OK, Z_STREAM_END])<>Z_STREAM_END) and
(FStrm.avail_out=0) do
|
| | < < < > > | > > > > > | | | | | | | | | | | | | | | | > | | | | | | | | < | | | | < |
284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 ... 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 .... 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 .... 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 .... 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 .... 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 .... 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 .... 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 .... 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 .... 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 .... 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 .... 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 .... 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 |
// -> do Codegear knows about regression tests?
type
/// exception raised internaly in case of Zip errors
ESynZipException = class(Exception);
/// the internal memory structure as expected by the ZLib library
{$ifdef USEPASZLIB}
TZStream = z_stream;
{$else}
TZStream = record
next_in : PAnsiChar;
avail_in : cardinal;
total_in : cardinal;
next_out : PAnsiChar;
avail_out : cardinal;
total_out : cardinal;
msg : PAnsiChar;
................................................................................
state : pointer;
zalloc : pointer;
zfree : pointer;
opaque : pointer;
data_type: integer;
adler : cardinal;
reserved : cardinal;
end;
{$endif}
/// initialize the internal memory structure as expected by the ZLib library
procedure StreamInit(var Stream: TZStream);
/// prepare the internal memory structure as expected by the ZLib library for compression
function DeflateInit(var Stream: TZStream; CompressionLevel: integer; ZipFormat: Boolean): Boolean;
type
{$A-} { force packed object (not allowed under Delphi 2009) }
PFileInfo = ^TFileInfo;
/// generic file information structure, as used in .zip file format
// - used in any header, contains info about following block
{$ifndef UNICODE}
TFileInfo = object
{$else}
................................................................................
end;
procedure zlibFreeMem(AppData, Block: Pointer); cdecl;
begin
FreeMem(Block);
end;
procedure StreamInit(var Stream: TZStream);
begin
fillchar(Stream,sizeof(Stream),0);
Stream.zalloc := @zlibAllocMem; // even under Linux, use program heap
Stream.zfree := @zlibFreeMem;
end;
{$else} // Windows:
{$ifndef USEZLIB}
// our very own short implementation of ZLibH
................................................................................
function crc32(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}crc32(crc,pointer(buf),len);
end;
function deflateInit2_(var strm: TZStream; level: integer; method: integer; windowBits: integer; memLevel: integer;strategy: integer; version: PAnsiChar; stream_size: integer): integer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}deflateInit2_(strm,level,method,windowBits,memLevel,strategy,version,stream_size);
end;
function deflate(var strm: TZStream; flush: integer): integer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}deflate(strm,flush);
end;
function deflateEnd(var strm: TZStream): integer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}deflateEnd(strm);
end;
function inflateInit2_(var strm: TZStream; windowBits: integer; version: PAnsiChar; stream_size: integer): integer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}inflateInit2_(strm,windowBits,version,stream_size);
end;
function inflate(var strm: TZStream; flush: integer): integer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}inflate(strm,flush);
end;
function inflateEnd(var strm: TZStream): integer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}inflateEnd(strm);
end;
function get_crc_table: pointer;
begin
result := {$ifdef USEPASZLIB}paszlib.{$else}ZLib.{$endif}get_crc_table;
end;
................................................................................
function get_crc_table: pointer;
begin
result := @crc32tab;
end;
{$endif USEZLIB}
procedure StreamInit(var Stream: TZStream);
begin
fillchar(Stream,sizeof(Stream),0);
end;
{$endif LINUX}
function compressBound(sourceLen: cardinal): cardinal;
begin
result := sourceLen + (sourceLen shr 12) + (sourceLen shr 14) + 11;
................................................................................
end;
procedure _memset(dest: Pointer; val: Integer; count: integer); cdecl;
begin // will use fastcode if compiled within
FillChar(dest^, count, val);
end;
function DeflateInit(var Stream: TZStream; CompressionLevel: integer; ZipFormat: Boolean): Boolean;
var Bits: integer;
begin
if ZipFormat then
Bits := MAX_WBITS else
Bits := -MAX_WBITS;
result := deflateInit2_(Stream, CompressionLevel, Z_DEFLATED, Bits, DEF_MEM_LEVEL,
Z_DEFAULT_STRATEGY, ZLIB_VERSION, sizeof(Stream))>=0
end;
function Check(const Code: Integer; const ValidCodes: array of Integer): integer;
var i: Integer;
begin
if Code=Z_MEM_ERROR then
OutOfMemoryError;
................................................................................
end;
end;
function CompressMem(src, dst: pointer; srcLen, dstLen: integer;
CompressionLevel: integer=6; ZipFormat: Boolean=false) : integer;
var strm: TZStream;
begin
StreamInit(strm);
strm.next_in := src;
strm.avail_in := srcLen;
strm.next_out := dst;
strm.avail_out := dstLen;
// -MAX_WBITS -> no zLib header => .zip compatible !
if DeflateInit(strm,CompressionLevel,ZipFormat) then
try
Check(deflate(strm,Z_FINISH),[Z_STREAM_END,Z_OK]);
finally
deflateEnd(strm);
end;
result := strm.total_out;
end;
................................................................................
Count := SizeOf(buf) - strm.avail_out;
if Count=0 then exit;
aStream.Write(buf,Count);
strm.next_out := @buf;
strm.avail_out := sizeof(buf);
end;
begin
StreamInit(strm);
strm.next_in := src;
strm.avail_in := srcLen;
strm.next_out := @buf;
strm.avail_out := sizeof(buf);
if DeflateInit(strm,CompressionLevel,ZipFormat) then
try // -MAX_WBITS -> no zLib header => .zip compatible !
repeat
code := Check(deflate(strm, Z_FINISH),[Z_OK,Z_STREAM_END,Z_BUF_ERROR]);
FlushBuf;
until code=Z_STREAM_END;
FlushBuf;
finally
................................................................................
result := strm.total_out;
end;
function UnCompressMem(src, dst: pointer; srcLen, dstLen: integer) : integer;
var strm: TZStream;
// Z: TMemoryStream; R: Int64Rec;
begin
StreamInit(strm);
strm.next_in := src;
strm.avail_in := srcLen;
strm.next_out := dst;
strm.avail_out := dstLen;
if inflateInit2_(strm, -MAX_WBITS, ZLIB_VERSION, sizeof(strm))>=0 then
try // -MAX_WBITS -> no zLib header => .zip compatible !
Check(inflate(strm, Z_FINISH),[Z_OK,Z_STREAM_END]);
................................................................................
CheckCRC^ := crc32(CheckCRC^,@buf,Count);
if aStream<>nil then
aStream.Write(buf,Count);
strm.next_out := @buf;
strm.avail_out := sizeof(buf);
end;
begin
StreamInit(strm);
strm.next_in := src;
strm.avail_in := srcLen;
strm.next_out := @buf;
strm.avail_out := sizeof(buf);
if checkCRC<>nil then
CheckCRC^ := 0;
if inflateInit2_(strm, -MAX_WBITS, ZLIB_VERSION, sizeof(strm))>=0 then
................................................................................
end;
procedure CompressInternal(var Data: RawByteString; Compress: boolean; Bits: integer);
var strm: TZStream;
code, len: integer;
tmp: RawByteString;
begin
StreamInit(strm);
strm.next_in := pointer(Data);
strm.avail_in := length(Data);
if Compress then begin
SetString(tmp,nil,strm.avail_in+256+strm.avail_in shr 3); // max mem required
strm.next_out := pointer(tmp);
strm.avail_out := length(tmp);
// +MAX_WBITS below = encode in deflate format
................................................................................
if inflateInit2_(strm, bits, ZLIB_VERSION, sizeof(strm))>=0 then
try
repeat
code := Check(inflate(strm, Z_FINISH),[Z_OK,Z_STREAM_END,Z_BUF_ERROR]);
if strm.avail_out=0 then begin
// need to increase buffer by chunk
SetLength(tmp,length(tmp)+len);
strm.next_out := pointer(PAnsiChar(pointer(tmp))+length(tmp)-len);
strm.avail_out := len;
end;
until code=Z_STREAM_END;
finally
inflateEnd(strm);
end;
end;
................................................................................
constructor TSynZipCompressor.Create(outStream: TStream; CompressionLevel: Integer;
Format: TSynZipCompressorFormat = szcfRaw);
begin
fDestStream := outStream;
fGZFormat := (Format=szcfGZ);
if fGZFormat then
fDestStream.Write(gzHeader,10);
StreamInit(FStrm);
FStrm.next_out := @FBufferOut;
FStrm.avail_out := SizeOf(FBufferOut);
fInitialized := DeflateInit(FStrm,CompressionLevel,Format=szcfZip);
end;
procedure TSynZipCompressor.Flush;
begin
if FInitialized then begin
while (Check(deflate(FStrm, Z_FINISH),[Z_OK, Z_STREAM_END])<>Z_STREAM_END) and
(FStrm.avail_out=0) do
|
Changes to SynZipFiles.pas.
902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 |
{ TCompressorDecompressor }
constructor TZipCompressor.Create(outStream: TStream; CompressionLevel, Algorithm: Integer);
var Algo: TSynCompressionAlgoClass;
begin
fDestStream := outStream;
fBlobDataHeaderPosition := -1; // not AsBlobData
with FStrm do begin
Init;
next_out := @FBufferOut;
avail_out := SizeOf(FBufferOut);
next_in := @FBufferIn;
end;
if Algorithm<>0 then begin
Algo := SynCompressionAlgos.Algo(Algorithm);
if not Assigned(Algo) then // unknown algo -> error
raise TZipException.CreateFmt(sZipAlgoIDNUnknownN,[Algorithm,ClassName]);
fAlgorithm := Algo.Create;
fAlgorithmID := Algorithm;
fAlgorithm.CompressInit(fDestStream);
|
< | | | | < |
902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 |
{ TCompressorDecompressor }
constructor TZipCompressor.Create(outStream: TStream; CompressionLevel, Algorithm: Integer);
var Algo: TSynCompressionAlgoClass;
begin
fDestStream := outStream;
fBlobDataHeaderPosition := -1; // not AsBlobData
StreamInit(FStrm);
FStrm.next_out := @FBufferOut;
FStrm.avail_out := SizeOf(FBufferOut);
FStrm.next_in := @FBufferIn;
if Algorithm<>0 then begin
Algo := SynCompressionAlgos.Algo(Algorithm);
if not Assigned(Algo) then // unknown algo -> error
raise TZipException.CreateFmt(sZipAlgoIDNUnknownN,[Algorithm,ClassName]);
fAlgorithm := Algo.Create;
fAlgorithmID := Algorithm;
fAlgorithm.CompressInit(fDestStream);
|
Changes to SynopseCommit.inc.
1 |
'1.18.642'
|
| |
1 |
'1.18.643'
|