From 38c074d5ea77e7133b6cc0d228a5dbf3e52d897a Mon Sep 17 00:00:00 2001 From: Martok Date: Tue, 3 May 2016 15:22:21 +0200 Subject: [PATCH] * implemented seekable de/compression streams zlib-stream with zlib, zip, gzip handling xz-stream with block-level random read using liblzma.dll --- uutlCompression.pas | 1432 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1432 insertions(+) create mode 100644 uutlCompression.pas diff --git a/uutlCompression.pas b/uutlCompression.pas new file mode 100644 index 0000000..00001d7 --- /dev/null +++ b/uutlCompression.pas @@ -0,0 +1,1432 @@ +unit uutlCompression; + +{ Package: Utils + Prefix: utl - UTiLs + Beschreibung: diese Unit enthält Stream-Wrapper die Daten de/komprimieren. + Teile basierend auf gzio.pas} + +{$mode objfpc}{$H+} +{$TYPEDADDRESS ON} +{$WRITEABLECONST OFF} + +{$DEFINE HAVE_ZLIB} +{$DEFINE HAVE_LIBLZMA} + +{$IFNDEF WINDOWS} + {$WARNING LibLZMA only supported on Windows for now} + {$UNDEF HAVE_LIBLZMA} +{$ENDIF} + +interface + +uses + Classes, SysUtils + {$IFDEF HAVE_ZLIB} + , zbase, zinflate, zdeflate + {$ENDIF}; + +const + Z_BUFSIZE = 16384; + +type + TutlCustomCompressedStream = class(TOwnerStream) + private + fWriting: boolean; + fStartPos: Int64; + fKnownSize: Int64; + protected + function GetSize: Int64; override; + function GetTotalOut: QWord; virtual; abstract; + function GetTotalIn: QWord; virtual; abstract; + public + constructor Create(ASource: TStream); + property Writing: boolean read fWriting; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; overload; + function Rewind: integer; virtual; abstract; + end; + +{$IFDEF HAVE_ZLIB} +const + { gzip magic header } + gz_magic : array[0..1] of byte = ($1F, $8B); + + { gzip flag byte } + + GZ_ASCII_FLAG = $01; { bit 0 set: file probably ascii text } + GZ_HEAD_CRC = $02; { bit 1 set: header CRC present } + GZ_EXTRA_FIELD = $04; { bit 2 set: extra field present } + GZ_ORIG_NAME = $08; { bit 3 set: original file name present } + GZ_COMMENT = $10; { bit 4 set: file comment present } + GZ_RESERVED = $E0; { bits 5..7: reserved } + + { gzip os code byte } + + GZ_OS_FAT = $00; + GZ_OS_AMIGA = $01; + GZ_OS_VMS = $02; + GZ_OS_UNIX = $03; + GZ_OS_VMCMS = $04; + GZ_OS_ATARI_TOS = $05; + GZ_OS_HPFS = $06; + GZ_OS_MACINTOSH = $07; + GZ_OS_ZSYSTEM = $08; + GZ_OS_CPM = $09; + GZ_OS_TOPS20 = $0A; + GZ_OS_NTFS = $0B; + GZ_OS_QDOS = $0C; + GZ_OS_ACORNRISC = $0D; + GZ_OS_UNKNOWN = $FF; + +type + TutlCustomZLibStream = class(TutlCustomCompressedStream) + private + fStream: z_stream; + fMode: Char; + fLevel: Integer; + fStrategy: Integer; + fBuffer: array[0..Z_BUFSIZE-1] of Byte; + fBufStart: Pointer; + protected + function zlibInitRead: LongInt; virtual; abstract; + function zlibInitWrite: LongInt; virtual; abstract; + function zlibFinishRead: LongInt; virtual; + function zlibFinishWrite: LongInt; virtual; + function DoFlush(flags: integer): integer; + function GetTotalIn: QWord; override; + function GetTotalOut: QWord; override; + public + constructor Create(aBaseStream: TStream; aMode: string); + destructor Destroy; override; + property Mode: Char read fMode; + property Level: Integer read fLevel; + property Strategy: Integer read fStrategy; + + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + procedure Flush(flags: integer); + function Rewind: integer; override; + end; + + TutlZLibStream = class(TutlCustomZLibStream) + protected + function zlibInitRead: LongInt; override; + function zlibInitWrite: LongInt; override; + end; + + TutlZipStream = class(TutlCustomZLibStream) + protected + function zlibInitRead: LongInt; override; + function zlibInitWrite: LongInt; override; + end; + + TGZHeader = packed record + magic: array[0..1] of byte; + method: Byte; + flags: Byte; + time: DWord; + xflags: byte; + oscode: byte; + end; + TGZFooter = packed record + crc32: DWord; + size: DWord; + end; + + TutlGZipStream = class(TutlZipStream) + private + fOrigFileName: string; + fComment: string; + fOrigTimestamp: TDateTime; + fCRC: DWord; + protected + function zlibInitRead: LongInt; override; + function zlibInitWrite: LongInt; override; + function zlibFinishWrite: LongInt; override; + procedure WriteHeader; + procedure CheckHeader; + public + constructor Create(aBaseStream: TStream; aMode: string); + property OrigFileame: string read fOrigFileName; + property OrigTimestamp: TDateTime read fOrigTimestamp; + property Comment: string read fComment; + function Write(const Buffer; Count: Longint): Longint; override; + + procedure ReadFooter; + end; +{$ENDIF HAVE_ZLIB} + +{$IFDEF HAVE_LIBLZMA} +const + LZMA_DLL = 'liblzma.dll'; + LZMA_VER = 50020012; + { Return values used by several functions in liblzma } + LZMA_OK = 0; + LZMA_STREAM_END = 1; + LZMA_NO_CHECK = 2; + LZMA_UNSUPPORTED_CHECK = 3; + LZMA_GET_CHECK = 4; + LZMA_MEM_ERROR = 5; + LZMA_MEMLIMIT_ERROR = 6; + LZMA_FORMAT_ERROR = 7; + LZMA_OPTIONS_ERROR = 8; + LZMA_DATA_ERROR = 9; + LZMA_BUF_ERROR = 10; + LZMA_PROG_ERROR = 11; + { Type of the integrity check (Check ID) } + LZMA_CHECK_NONE = 0; + LZMA_CHECK_CRC32 = 1; + LZMA_CHECK_CRC64 = 4; + LZMA_CHECK_SHA256 = 10; + { Type of the integrity check (Check ID) } + LZMA_INDEX_ITER_ANY = 0; + LZMA_INDEX_ITER_STREAM = 1; + LZMA_INDEX_ITER_BLOCK = 2; + LZMA_INDEX_ITER_NONEMPTY_BLOCK = 3; + { The 'action' argument for lzma_code() } + LZMA_RUN = 0; + LZMA_SYNC_FLUSH = 1; + LZMA_FULL_FLUSH = 2; + LZMA_FULL_BARRIER = 4; + LZMA_FINISH = 3; + { Encoding } + LZMA_PRESET_EXTREME = $80000000; + { Decoding } + LZMA_TELL_NO_CHECK = $01; + LZMA_TELL_UNSUPPORTED_CHECK = $02; + LZMA_TELL_ANY_CHECK = $04; + LZMA_IGNORE_CHECK = $10; + LZMA_CONCATENATED = $08; + { Misc} + LZMA_STREAM_HEADER_SIZE = 12; + LZMA_BLOCK_HEADER_SIZE_MIN = 8; + LZMA_BLOCK_HEADER_SIZE_MAX = 1024; + LZMA_CHECK_SIZE_MAX = 64; + LZMA_FILTERS_MAX = 4; + LZMA_VLI_UNKNOWN: QWord = high(QWord); + + +type + {$PackRecords C} + lzma_ret = integer; + lzma_action = integer; + lzma_check = integer; + lzma_reserved_enum = (_LZMA_RESERVED_ENUM); + lzma_index_iter_mode = integer; + lzma_vli = QWord; + lzma_bool = ByteBool; + {* + * Custom functions for memory handling. + *} + TAlloc = function(opaque: Pointer; Items, Size: size_t): Pointer; cdecl; + TFree = procedure(opaque, Block: Pointer); cdecl; + lzma_allocator = record + XZalloc : TAlloc; + XZfree : TFree; + opaque : pointer; + end; + p_lzma_allocator = ^lzma_allocator; + {* + * Passing data to and from liblzma. + *} + lzma_stream = record + next_in : PByte; //Pointer to the next input byte. + avail_in : size_t; //Number of available input bytes in next_in. + total_in : QWord; //Total number of bytes read by liblzma. + next_out : PByte; //Pointer to the next output position. + avail_out : size_t; //Amount of free space in next_out. + total_out : QWord; //Total number of bytes written by liblzma. + //Custom memory allocation functions + //In most cases this is nil which makes liblzma use + //the standard malloc() and free(). + allocator : p_lzma_allocator; //pointer; + //Internal state is not visible to applications. + internal : pointer; + //Reserved space to allow possible future extensions without + //breaking the ABI. Excluding the initialization of this structure, + //you should not touch these, because the names of these variables + //may change. + reserved_ptr1 : pointer; + reserved_ptr2 : pointer; + reserved_ptr3 : pointer; + reserved_ptr4 : pointer; + reserved_int1 : QWord; + reserved_int2 : QWord; + reserved_int3 : size_t; + reserved_int4 : size_t; + reserved_enum1 : lzma_reserved_enum; + reserved_enum2 : lzma_reserved_enum; + end; + p_lzma_stream = ^lzma_stream; + lzma_stream_flags = record + version: DWord; + backward_size: lzma_vli; + check: lzma_check; + reserved_enum : array[1..4] of lzma_reserved_enum; + reserved_bool : array[1..8] of lzma_bool; + reserved_int : array[1..2] of DWord; + end; + p_lzma_stream_flags = ^lzma_stream_flags; + p_lzma_index = Pointer; + pp_lzma_index = ^p_lzma_index; + lzma_index_iter = record + stream: record + flags: p_lzma_stream_flags; + reserved_ptr1, + reserved_ptr2, + reserved_ptr3: Pointer; + number, + block_count, + compressed_offset, + uncompressed_offset, + compressed_size, + uncompressed_size, + padding, + reserved_vli1, + reserved_vli2, + reserved_vli3, + reserved_vli4: lzma_vli; + end; + block: record + number_in_file, + compressed_file_offset, + uncompressed_file_offset, + number_in_stream, + compressed_stream_offset, + uncompressed_stream_offset, + uncompressed_size, + unpadded_size, + total_size, + + reserved_vli1, + reserved_vli2, + reserved_vli3, + reserved_vli4: lzma_vli; + + reserved_ptr1, + reserved_ptr2, + reserved_ptr3, + reserved_ptr4: Pointer; + end; + internal: array[1..6] of record case byte of + 0: (p: Pointer); + 1: (s: size_t); + 2: (v: lzma_vli); + end; + end; + lzma_filter = record + id: lzma_vli; + options: Pointer; + end; + p_lzma_filter = ^lzma_filter; + lzma_block = record + version: dword; + header_size: DWord; + check: lzma_check; + compressed_size: lzma_vli; + uncompressed_size: lzma_vli; + filters: p_lzma_filter; + raw_check: array [0..LZMA_CHECK_SIZE_MAX-1] of byte; + reserved_ptr1, + reserved_ptr2, + reserved_ptr3: Pointer; + reserved_int1, + reserved_int2: DWord; + reserved_int3, + reserved_int4, + reserved_int5, + reserved_int6, + reserved_int7, + reserved_int8: lzma_vli; + reserved_enum1, + reserved_enum2, + reserved_enum3, + reserved_enum4: lzma_reserved_enum; + ignore_check: lzma_bool; + + reserved_bool2, + reserved_bool3, + reserved_bool4, + reserved_bool5, + reserved_bool6, + reserved_bool7, + reserved_bool8: lzma_bool; + end; + {$PackRecords Default} + + TlibLZMA = object + Handle: THandle; + PascalAllocator: lzma_allocator; + + lzma_version_number: function(): DWord; cdecl; + { Initialize .xz Stream encoder using a preset number. } + lzma_easy_encoder: function(var strm: lzma_stream; preset: DWord; check: lzma_check): lzma_ret; cdecl; + { Initialize .xz Stream decoder } + lzma_stream_decoder: function(var strm: lzma_stream; memlimit: QWord; flags: DWord): lzma_ret; cdecl; + lzma_auto_decoder: function(var strm: lzma_stream; memlimit: QWord; flags: DWord): lzma_ret; cdecl; + {* + * Encode or decode data. + * + * Once the lzma_stream has been successfully initialized (e.g. with + * lzma_stream_encoder()), the actual encoding or decoding is done + * using this function. The application has to update strm->next_in, + * strm->avail_in, strm->next_out, and strm->avail_out to pass input + * to and get output from liblzma. + *} + lzma_code: function(var strm: lzma_stream; action: lzma_action): lzma_ret; cdecl; + { Free memory allocated for the coder data structures } + lzma_end: procedure(var strm: lzma_stream); cdecl; + { All-in-one functions } + lzma_easy_buffer_encode: function(preset: DWord; check: lzma_check; allocator: p_lzma_allocator; in_: PChar; in_size: size_t; out_: PChar; out_pos: pointer; out_size: size_t): lzma_ret; cdecl; + lzma_stream_buffer_decode: function(memlimit: PQWord; flags: DWord; allocator: p_lzma_allocator; in_: PChar; in_pos: pointer; in_size: size_t; out_: PChar; out_pos: pointer; out_size: size_t): lzma_ret; cdecl; + { Stream decoding } + lzma_stream_footer_decode: function (out options: lzma_stream_flags; fin: PByte): lzma_ret; cdecl; + lzma_stream_header_decode: function (out options: lzma_stream_flags; fin: PByte): lzma_ret; cdecl; + lzma_stream_flags_compare: function (var a, b: lzma_stream_flags): lzma_ret; cdecl; + { Index access } + lzma_index_decoder: function(var strm: lzma_stream; i: pp_lzma_index; memlimit: QWord): lzma_ret; cdecl; + lzma_index_buffer_decode: function(var i: p_lzma_index; var memlimit: QWord; allocator: p_lzma_allocator; in_: PByte; var in_pos: size_t; in_size: size_t): lzma_ret; cdecl; + lzma_index_uncompressed_size: function(i: p_lzma_index): lzma_vli; cdecl; + lzma_index_end: procedure(i: p_lzma_index; allocator: p_lzma_allocator); cdecl; + lzma_index_cat: function(dest, src: p_lzma_index; const allocator: p_lzma_allocator): lzma_ret; cdecl; + lzma_index_stream_flags: function(i: p_lzma_index; var flags: lzma_stream_flags): lzma_ret; cdecl; + lzma_index_stream_padding: function(i: p_lzma_index; padding: lzma_vli): lzma_ret; cdecl; + lzma_index_total_size: function(i: p_lzma_index): lzma_vli; cdecl; + { Index iterator } + lzma_index_iter_init: procedure (var iter:lzma_index_iter; i: p_lzma_index); cdecl; + lzma_index_iter_locate: function (var iter:lzma_index_iter; target: lzma_vli): lzma_bool; cdecl; + lzma_index_iter_next: function (var iter:lzma_index_iter; mode: lzma_index_iter_mode): lzma_bool; cdecl; + { Block access } + lzma_block_decoder: function(var strm: lzma_stream; var i: lzma_block): lzma_ret; cdecl; + lzma_block_header_decode: function(var i: lzma_block; const allocator: p_lzma_allocator; fin: PByte): lzma_ret; cdecl; + lzma_block_compressed_size: function(var i: lzma_block; unpadded_size: lzma_vli): lzma_ret; cdecl; + function lzma_block_header_size_decode(b: dword): dword; + + procedure Load; + procedure Unload; + end; + + TutlXZStream = class(TutlCustomCompressedStream) + private + fStream: lzma_stream; + fMode: Char; + fLevel: DWORD; + fBuffer: array[0..Z_BUFSIZE-1] of Byte; + fBufStart: Pointer; + private + fIndex: p_lzma_index; + fStreamNr, + fBlockNr: DWord; + fMaxUncompBlockSize: QWord; + fUncompPos: QWord; + fBlock: lzma_block; + fBlockOffs: Int64; + fFilters: array[0..LZMA_FILTERS_MAX] of lzma_filter; // MUST be 1 entry longer than LZMA_FILTERS_MAX for LZMA_VLI_UNKNOWN terminator + protected + function DoFlush(flags: integer): integer; + function GetTotalIn: QWord; override; + function GetTotalOut: QWord; override; + function GetPosition: Int64; override; + procedure BlockEnd; + function ParseIndexes: boolean; + procedure IterateIndexes; + public + constructor Create(aBaseStream: TStream; aMode: string); + destructor Destroy; override; + property Mode: Char read fMode; + property Level: DWORD read fLevel; + + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + procedure Flush({%H-}flags: integer); + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; overload; + function Rewind: integer; override; + public + class function CheckLibraryAvailable: boolean; + end; +{$ENDIF HAVE_LIBLZMA} + +resourcestring + sInvalidMode = 'Invalid mode specified'; + sFailedInitZLib = 'Failed to init ZLIB'; + sGZipNoHeader = 'No GZip header found'; + sGZIPUnsupportedMethod = 'Unsupported Method'; + sLibLZMANotFound = 'liblzma not found or bad version: %s'; + sLZMAErrorOpen = 'Error opening XZ file'; + +implementation + +uses + dateutils, crc, dynlibs; + +{$IFDEF HAVE_LIBLZMA} +var + libLZMA: TlibLZMA; +{$ENDIF HAVE_LIBLZMA} + +{ TutlCustomCompressedStream } + +constructor TutlCustomCompressedStream.Create(ASource: TStream); +begin + inherited Create(ASource); + fWriting:= false; + fStartPos:= ASource.Position; + fKnownSize:= -1; +end; + +function TutlCustomCompressedStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +var + ofs: Int64; + sz : int64; + tmp: array [0..Z_BUFSIZE-1] of byte; +begin + if Origin = soEnd then begin + if fWriting then begin + if Offset <= 0 then + // No going back + Exit(-1) + else + // Current = End + Exit(Seek(Offset, soCurrent)); + end; + + // computes size, if possible + ofs:= GetSize - Offset; + // if we know the size now, translate to seek from beginning + if fKnownSize >= 0 then + Exit(Seek(ofs, soBeginning)); + Exit(-1); + end; + + ofs:= Offset; + + if fWriting then begin + if Origin = soBeginning then + dec(ofs, GetTotalOut); + if ofs < 0 then + Exit(-1); + + { At this point, ofs is the number of zero bytes to write. } + FillChar({%H-}tmp[0], Z_BUFSIZE, 0); + while (ofs > 0) do begin + sz := Z_BUFSIZE; + if (ofs < Z_BUFSIZE) then + sz := ofs; + + sz:= Write(tmp[0], sz); + if (size <= 0) then + Exit(-1); + + dec(ofs,sz); + end; + + Result:= GetTotalIn; + end else begin + { compute absolute position } + if Origin = soCurrent then + inc(ofs, GetTotalOut); + + if ofs < 0 then + Exit(-1); + + { For a negative seek, rewind and use positive seek } + if (ofs >= GetTotalOut) then + dec(ofs, GetTotalOut) + else if (Rewind <> 0) then begin + Exit(-1); + end; + + { ofs is now the number of bytes to skip. } + while (ofs > 0) do begin + sz := Z_BUFSIZE; + if (ofs < Z_BUFSIZE) then + sz := ofs; + + sz := Read(tmp[0], sz); + if (sz <= 0) then + Exit(-1); + dec(ofs, sz); + end; + + Result:= GetTotalOut; + end; +end; + +function TutlCustomCompressedStream.GetSize: Int64; +var + tmp: array[0..Z_BUFSIZE-1] of byte; + sz: Int64; +begin + if fKnownSize < 0 then begin + if fKnownSize < -1 then + // we tried before and it was not possible + Exit(-1); + + // read until EOF + repeat + sz := Read({%H-}tmp[0], Z_BUFSIZE); + if sz < 0 then begin + fKnownSize:= -2; + Exit(-1); + end; + until sz < Z_BUFSIZE; + fKnownSize:= GetTotalOut; + end; + Result:= fKnownSize; +end; + +{$IFDEF HAVE_ZLIB} + +{ TutlCustomZLibStream } + +constructor TutlCustomZLibStream.Create(aBaseStream: TStream; aMode: string); +var + err: Integer; + m: Char; +begin + inherited Create(aBaseStream); + fMode:= #0; + fLevel:= Z_DEFAULT_COMPRESSION; + fStrategy:= Z_DEFAULT_STRATEGY; + for m in aMode do begin + case m of + 'r', + 'w': fMode:= m; + '0'..'9': fLevel:= Ord(m) - Ord('0'); + 'f': fStrategy:= Z_FILTERED; + 'h': fStrategy:= Z_HUFFMAN_ONLY; + end; + end; + if not (fMode in ['r', 'w']) then + raise EFOpenError.Create(sInvalidMode); + + fWriting:= fMode = 'w'; + fBufStart:= @fBuffer[0]; + fStream:= Default(z_stream); + if fWriting then begin + err:= zlibInitWrite; + fStream.next_out:= fBufStart; + end else begin + err:= zlibInitRead; + fStream.next_in:= fBufStart; + end; + if err <> Z_OK then + raise EFOpenError.Create(sFailedInitZLib); + + fStream.avail_out:= Z_BUFSIZE; + fStartPos:= Source.Position; +end; + +destructor TutlCustomZLibStream.Destroy; +begin + if fWriting then begin + DoFlush(Z_FINISH); + zlibFinishWrite; + end else begin + zlibFinishRead; + end; + inherited Destroy; +end; + +function TutlCustomZLibStream.Read(var Buffer; Count: Longint): Longint; +var + res: Int64; +begin + Result:= 0; + fStream.next_out := @Buffer; + fStream.avail_out := Count; + while (fStream.avail_out > 0) do begin + if fStream.avail_in = 0 then begin + res:= Source.Read(fBufStart^, Z_BUFSIZE); + if res = 0 then begin + // reached input end, return + Result:= Count - fStream.avail_out; + Exit; + end; + fStream.avail_in := res; + fStream.next_in := fBufStart; + end; + res:= inflate(fStream, Z_SYNC_FLUSH); + if res = Z_STREAM_END then + Exit(Count - fStream.avail_out) + else if res < 0 then + Exit(res); + end; + Result := Count; +end; + +function TutlCustomZLibStream.Write(const Buffer; Count: Longint): Longint; +var + res: int64; +begin + fStream.next_in := @Buffer; + fStream.avail_in := Count; + while (fStream.avail_in > 0) do begin + res:= deflate(fStream, 0); + if res < 0 then + Exit(res); + if fStream.avail_out = 0 then begin + Source.WriteBuffer(fBufStart^, Z_BUFSIZE); + fStream.next_out:= fBufStart; + fStream.avail_out:= Z_BUFSIZE; + end; + end; + Result := Count; +end; + +procedure TutlCustomZLibStream.Flush(flags: integer); +begin + DoFlush(flags); + { TODO : Check Result} +end; + +function TutlCustomZLibStream.DoFlush(flags: integer): integer; +var + len : cardinal; + done : boolean; + written, + err: int64; +begin + done := false; + + if not fWriting then + Exit(Z_STREAM_ERROR); + + fStream.avail_in := 0; { should be zero already anyway } + + while true do begin + len := Z_BUFSIZE - fStream.avail_out; + + if (len <> 0) then begin + written:= Source.Write(fBufStart^, len); + if (written <> len) then begin + Exit(Z_ERRNO); + end; + fStream.next_out := fBufStart; + fStream.avail_out := Z_BUFSIZE; + end; + + if done then + break; + err := deflate(fStream, flags); + + { Ignore the second of two consecutive flushes: } + if (len = 0) and (err = Z_BUF_ERROR) then + err := Z_OK; + + { deflate has finished flushing only when it hasn't used up + all the available space in the output buffer: } + + done := (fStream.avail_out <> 0) or (err = Z_STREAM_END); + if (err <> Z_OK) and (err <> Z_STREAM_END) then + break; + end; {WHILE} + + if (err = Z_STREAM_END) then + Result:= Z_OK + else + Result:= err; +end; + +function TutlCustomZLibStream.Rewind: integer; +begin + if fWriting then + Exit(-1); + + fStream.avail_in := 0; + fStream.next_in := fBufStart; + + inflateReset(fStream); + Source.Seek(fStartPos, soBeginning); + Result:= 0; +end; + +function TutlCustomZLibStream.zlibFinishRead: LongInt; +begin + Result:= inflateEnd(fStream); +end; + +function TutlCustomZLibStream.zlibFinishWrite: LongInt; +begin + Result:= deflateEnd(fStream); +end; + +function TutlCustomZLibStream.GetTotalIn: QWord; +begin + Result:= fStream.total_in; +end; + +function TutlCustomZLibStream.GetTotalOut: QWord; +begin + Result:= fStream.total_out; +end; + + +{ TutlZLibStream } + +function TutlZLibStream.zlibInitRead: LongInt; +begin + Result:= inflateInit_(@fStream, ZLIB_VERSION, sizeof(fStream)); +end; + +function TutlZLibStream.zlibInitWrite: LongInt; +begin + Result:= deflateInit_(@fStream, level, ZLIB_VERSION, sizeof(fStream)); +end; + +{ TutlZipStream } + +function TutlZipStream.zlibInitRead: LongInt; +begin + { + Well-documented undocumented feature: passing negative window bits tells zlib not to + excpect a zlib header and instead read raw deflate blocks. + We use 15 bits here instead of 13 because that's what everybody else does, and it doesn't really + matter for decompression anyway. + } + Result:= inflateInit2_(fStream, -MAX_WBITS, ZLIB_VERSION, sizeof(fStream)); +end; + +function TutlZipStream.zlibInitWrite: LongInt; +begin + Result:= deflateInit2_(fStream, level, Z_DEFLATED, -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, ZLIB_VERSION, sizeof(fStream)); +end; + +{ TutlGZipStream } + +function TutlGZipStream.zlibInitRead: LongInt; +begin + Result:= inherited; +end; + +function TutlGZipStream.zlibInitWrite: LongInt; +begin + Result:= inherited; +end; + +constructor TutlGZipStream.Create(aBaseStream: TStream; aMode: string); +begin + inherited Create(aBaseStream, aMode); + fOrigFileName:= ''; + fOrigTimestamp:= 0; + fComment:= ''; + if fWriting then begin + fCRC:= crc32(0, nil, 0); + WriteHeader; + end + else begin + CheckHeader; + end; + fStartPos:= Source.Position; +end; + +procedure TutlGZipStream.WriteHeader; +var + h: TGZHeader; +begin + { TODO : use actual data } + h.magic:= gz_magic; + h.method:= Z_DEFLATED; + h.flags:= 0; + h.time:= 0; + h.xflags:= 0; + h.oscode:= 0; + Source.Write(h, sizeof(h)); +end; + +procedure TutlGZipStream.CheckHeader; +var + h: TGZHeader; + w: Word; + + function ReadNullTerm: AnsiString; + var + b: byte; + begin + Result:= ''; + b:= 0; + while Source.Read(b, sizeof(b)) = sizeof(b) do begin + if b = 0 then break; + Result:= Result + Chr(b); + end; + end; + +begin + Source.ReadBuffer(h{%H-}, sizeof(h)); + if not CompareMem(@h.magic, @gz_magic, sizeof(gz_magic)) then + raise EFOpenError.Create(sGZipNoHeader); + if (h.method <> Z_DEFLATED) or ((h.flags and GZ_RESERVED) <> 0) then + raise EReadError.Create(sGZIPUnsupportedMethod); + + fOrigTimestamp:= UnixToDateTime(LEtoN(h.time)); + + if (h.flags and GZ_EXTRA_FIELD) > 0 then begin + w:= 0; + Source.ReadBuffer(w, sizeof(w)); + w:= LEtoN(w); + // Skip Extra Field + Source.Seek(w, soFromCurrent); + end; + if (h.flags and GZ_ORIG_NAME) > 0 then begin + fOrigFileName:= ReadNullTerm; + end; + if (h.flags and GZ_COMMENT) > 0 then begin + fComment:= ReadNullTerm; + end; + if (h.flags and GZ_HEAD_CRC) > 0 then begin + // Skip Header Checksum + Source.Seek(2, soFromCurrent); + end; +end; + +function TutlGZipStream.zlibFinishWrite: LongInt; +var + f: TGZFooter; +begin + Result:=inherited zlibFinishWrite; + f.crc32:= fCRC; + f.size:= fStream.total_in; + Source.WriteBuffer(f, sizeof(f)); +end; + +function TutlGZipStream.Write(const Buffer; Count: Longint): Longint; +begin + Result:=inherited Write(Buffer, Count); + if Result > 0 then + fCRC:= crc32(fCRC, @Buffer, Result); +end; + +procedure TutlGZipStream.ReadFooter; +var + bp: Int64; + f: TGZFooter; +begin + bp:= Source.Position; + try + Source.Seek(-Sizeof(f), soEnd); + Source.ReadBuffer(f{%H-}, sizeof(f)); + fKnownSize:= f.size; + finally + Source.Position:= bp; + end; +end; + +{$ENDIF HAVE_ZLIB} + +{$IFDEF HAVE_LIBLZMA} + +{ TlibLZMA } + +function TlibLZMA.lzma_block_header_size_decode(b: dword): dword; +begin + Result:= (b + 1) * 4; +end; + +function PasAlloc({%H-}opaque: Pointer; Items, Size: size_t): Pointer; cdecl; +begin + Result:= AllocMem(Size * Items); +end; + +procedure PasFree({%H-}opaque, Block: Pointer); cdecl; +begin + Freemem(Block); +end; + +procedure TlibLZMA.Load; +begin + if Handle = 0 then + Handle:= SafeLoadLibrary(LZMA_DLL); + PascalAllocator.XZalloc:= @PasAlloc; + PascalAllocator.XZfree:= @PasFree; + if Handle <> 0 then begin + Pointer(lzma_version_number):= GetProcedureAddress(Handle, 'lzma_version_number'); + Pointer(lzma_easy_encoder):= GetProcedureAddress(Handle, 'lzma_easy_encoder'); + Pointer(lzma_stream_decoder):= GetProcedureAddress(Handle, 'lzma_stream_decoder'); + Pointer(lzma_auto_decoder):= GetProcedureAddress(Handle, 'lzma_auto_decoder'); + Pointer(lzma_code):= GetProcedureAddress(Handle, 'lzma_code'); + Pointer(lzma_end):= GetProcedureAddress(Handle, 'lzma_end'); + Pointer(lzma_easy_buffer_encode):= GetProcedureAddress(Handle, 'lzma_easy_buffer_encode'); + Pointer(lzma_stream_buffer_decode):= GetProcedureAddress(Handle, 'lzma_stream_buffer_decode'); + Pointer(lzma_stream_footer_decode):= GetProcedureAddress(Handle, 'lzma_stream_footer_decode'); + Pointer(lzma_stream_header_decode):= GetProcedureAddress(Handle, 'lzma_stream_header_decode'); + Pointer(lzma_stream_flags_compare):= GetProcedureAddress(Handle, 'lzma_stream_flags_compare'); + Pointer(lzma_index_decoder):= GetProcedureAddress(Handle, 'lzma_index_decoder'); + Pointer(lzma_index_buffer_decode):= GetProcedureAddress(Handle, 'lzma_index_buffer_decode'); + Pointer(lzma_index_uncompressed_size):= GetProcedureAddress(Handle, 'lzma_index_uncompressed_size'); + Pointer(lzma_index_end):= GetProcedureAddress(Handle, 'lzma_index_end'); + Pointer(lzma_index_cat):= GetProcedureAddress(Handle, 'lzma_index_cat'); + Pointer(lzma_index_stream_flags):= GetProcedureAddress(Handle, 'lzma_index_stream_flags'); + Pointer(lzma_index_stream_padding):= GetProcedureAddress(Handle, 'lzma_index_stream_padding'); + Pointer(lzma_index_total_size):= GetProcedureAddress(Handle, 'lzma_index_total_size'); + Pointer(lzma_index_iter_init):= GetProcedureAddress(Handle, 'lzma_index_iter_init'); + Pointer(lzma_index_iter_locate):= GetProcedureAddress(Handle, 'lzma_index_iter_locate'); + Pointer(lzma_index_iter_next):= GetProcedureAddress(Handle, 'lzma_index_iter_next'); + Pointer(lzma_block_decoder):= GetProcedureAddress(Handle, 'lzma_block_decoder'); + Pointer(lzma_block_header_decode):= GetProcedureAddress(Handle, 'lzma_block_header_decode'); + Pointer(lzma_block_compressed_size):= GetProcedureAddress(Handle, 'lzma_block_compressed_size'); + end; +end; + +procedure TlibLZMA.Unload; +begin + UnloadLibrary(Handle); + FillByte(Self, sizeof(Self), 0); +end; + +{ TutlXZStream } + +constructor TutlXZStream.Create(aBaseStream: TStream; aMode: string); +var + m: Char; + err: integer; +begin + inherited Create(aBaseStream); + if not CheckLibraryAvailable then + raise Exception.CreateFmt(sLibLZMANotFound, [LZMA_DLL]); + fMode:= #0; + fLevel:= 0; + for m in aMode do begin + case m of + 'r', + 'w': fMode:= m; + '0'..'9': fLevel:= Ord(m) - Ord('0'); + 'e': fLevel:= fLevel or LZMA_PRESET_EXTREME; + end; + end; + if not (fMode in ['r', 'w']) then + raise EFOpenError.Create(sInvalidMode); + + fWriting:= fMode = 'w'; + fBufStart:= @fBuffer[0]; + fStream:= Default(lzma_stream); + fBlockOffs:= -1; + if fWriting then begin + err:= libLZMA.lzma_easy_encoder(fStream, fLevel, LZMA_CHECK_CRC64); + fStream.next_out:= fBufStart; + end else begin + if not ParseIndexes then + raise EFOpenError.Create(sLZMAErrorOpen); + IterateIndexes; + fKnownSize:= libLZMA.lzma_index_uncompressed_size(fIndex); + Seek(0, soBeginning); + fStream.next_in:= fBufStart; + err:= 0; + end; + if err <> Z_OK then + raise EFOpenError.Create(sFailedInitZLib); + + fStream.avail_out:= Z_BUFSIZE; + fStartPos:= Source.Position; +end; + +destructor TutlXZStream.Destroy; +begin + if fWriting then begin; + DoFlush(LZMA_FINISH); + end; + libLZMA.lzma_index_end(fIndex, nil); + libLZMA.lzma_end(fStream); + inherited Destroy; +end; + +function TutlXZStream.DoFlush(flags: integer): integer; +begin + fStream.next_in := nil; + fStream.avail_in := 0; + while (libLZMA.lzma_code(fStream,flags) <> LZMA_STREAM_END) and + (fStream.avail_out = 0) do begin + Source.WriteBuffer(fBufStart^, Z_BUFSIZE); + fStream.next_out := fBufStart; + fStream.avail_out := Z_BUFSIZE; + end; + if fStream.avail_out < Z_BUFSIZE then + Source.WriteBuffer(fBufStart^, Z_BUFSIZE - fStream.avail_out); + Result:= LZMA_OK; +end; + +procedure TutlXZStream.Flush(flags: integer); +begin + DoFlush(LZMA_SYNC_FLUSH); +end; + +function TutlXZStream.Read(var Buffer; Count: Longint): Longint; +var + res, sz: Int64; + a, b, current_read: QWord; + r: lzma_ret; +begin + Result:= 0; + // is a block loaded? + if fBlockOffs < 0 then begin + // if no block is loaded, we might be at EOF + Exit(0); + end; + fStream.next_out := @Buffer; + fStream.avail_out := Count; + while (fStream.avail_out > 0) do begin + if fStream.avail_in = 0 then begin + // read remaining data from current block + a:= fBlock.compressed_size; + b:= fStream.total_in; + sz:= a - b; + if sz > Z_BUFSIZE then + sz:= Z_BUFSIZE; + // if this block has no more data, read next + if sz = 0 then begin + // finish coding current block + libLZMA.lzma_code(fStream, LZMA_FINISH); + current_read:= Count - fStream.avail_out; + Inc(Result, current_read); + inc(fUncompPos, current_read); + // begin new block + res:= Seek(0, soCurrent); + if res < 0 then + Exit; + // setup writing to next part + inc(fStream.next_out, current_read); + dec(Count, current_read); + fStream.avail_out:= Count; + // re-read from this new block + continue; + end else begin + res:= Source.Read(fBufStart^, sz); + if res = 0 then begin + // block should have more data, but we didn't get any + libLZMA.lzma_code(fStream, LZMA_FINISH); + current_read:= Count - fStream.avail_out; + Inc(Result, current_read); + inc(fUncompPos, current_read); + Exit; + end; + fStream.avail_in := res; + fStream.next_in := fBufStart; + end; + end; + r:= libLZMA.lzma_code(fStream, LZMA_RUN); + if r <> LZMA_OK then + break; + end; + current_read:= Count - fStream.avail_out; + Inc(Result, current_read); + inc(fUncompPos, current_read); +end; + +function TutlXZStream.Write(const Buffer; Count: Longint): Longint; +var + res: Integer; +begin + fStream.next_in := @Buffer; + fStream.avail_in := Count; + while (fStream.avail_in > 0) do begin + res:= libLZMA.lzma_code(fStream, LZMA_RUN); + if res < 0 then + Exit(res); + if fStream.avail_out = 0 then begin + Source.WriteBuffer(fBufStart^, Z_BUFSIZE); + fStream.next_out:= fBufStart; + fStream.avail_out:= Z_BUFSIZE; + end; + end; + Result := Count; +end; + +function TutlXZStream.Rewind: integer; +begin + if fWriting then + Exit(-1); + Seek(0, soBeginning); + Result:= 0; +end; + +function TutlXZStream.GetTotalIn: QWord; +begin + Result:= fStream.total_in; +end; + +function TutlXZStream.GetTotalOut: QWord; +begin + Result:= fStream.total_out; +end; + +function TutlXZStream.ParseIndexes: boolean; +const + MAX_INDEX_LENGTH = 16384; + MAX_QWORD = high(QWord); + BUFSIZE = 16384; +var + bp, fs: Int64; + stream_padding: lzma_vli; + combined_index: p_lzma_index; + + function ReadOneStream: boolean; + var + footer, + header: array[0..LZMA_STREAM_HEADER_SIZE-1] of byte; + buf: array[0..BUFSIZE-1] of byte; + footer_flags, + header_flags: lzma_stream_flags; + inddec: lzma_stream; + this_index: p_lzma_index; + r: lzma_ret; + index_size: lzma_vli; + begin + Result:= false; + if Source.Position < LZMA_STREAM_HEADER_SIZE then + // Corrupted File + Exit; + Source.Seek(-LZMA_STREAM_HEADER_SIZE, soCurrent); + Source.ReadBuffer(footer{%H-}, sizeof(footer)); + + // Skip stream padding. + if (footer[8] = 0) and (footer[9] = 0) and (footer[10] = 0) and (footer[11] = 0) then begin + inc(stream_padding, 4); + Source.Seek(-4, soCurrent); + Exit(true); + end; + + inc(fStreamNr); + Source.Seek(-LZMA_STREAM_HEADER_SIZE, soCurrent); + + // decode footer + r:= libLZMA.lzma_stream_footer_decode(footer_flags, @footer[0]); + if r <> LZMA_OK then + Exit; + index_size:= footer_flags.backward_size; + // Safeguard, the index should be right before the footer + if (index_size > MAX_INDEX_LENGTH) or (Source.Position < index_size + LZMA_STREAM_HEADER_SIZE) then + Exit; + // Compute start of index for this stream + Source.Seek(-index_size, soCurrent); + + // Decode Index + this_index:= nil; + inddec:= Default(lzma_stream); + r:= libLZMA.lzma_index_decoder(inddec, @this_index, MAX_QWORD); + try + if r <> LZMA_OK then + Exit; + repeat + inddec.avail_in:= index_size; + if inddec.avail_in > BUFSIZE then + inddec.avail_in:= BUFSIZE; + Source.ReadBuffer({%H-}buf[0], inddec.avail_in); + index_size -= inddec.avail_in; + inddec.next_in:= @buf[0]; + r:= libLZMA.lzma_code(inddec, LZMA_RUN); + until (r <> LZMA_OK) or (index_size=0); + + if r <> LZMA_STREAM_END then + Exit; + + index_size:= libLZMA.lzma_index_total_size(this_index); + Source.Seek(- (inddec.total_in + index_size + LZMA_STREAM_HEADER_SIZE), soCurrent); + // Read and decode Stream Header + Source.ReadBuffer(header{%H-}[0], LZMA_STREAM_HEADER_SIZE); + Source.Seek(-LZMA_STREAM_HEADER_SIZE, soCurrent); + r:= libLZMA.lzma_stream_header_decode(header_flags, @header[0]); + if r <> LZMA_OK then + Exit; + // should be equal + r:= libLZMA.lzma_stream_flags_compare(header_flags, footer_flags); + if r <> LZMA_OK then + Exit; + // store decoded flags in this index + r:= libLZMA.lzma_index_stream_flags(this_index, footer_flags); + if r <> LZMA_OK then + Exit; + // store padding accumulated so far (needed for seeking in multi-stream-files) + r:= libLZMA.lzma_index_stream_padding(this_index, stream_padding); + if r <> LZMA_OK then + Exit; + + if Assigned(combined_index) then begin + r:= libLZMA.lzma_index_cat(this_index, combined_index, nil); + if r <> LZMA_OK then + Exit; + end; + + combined_index:= this_index; + this_index:= nil; + Result:= true; + finally + libLZMA.lzma_end(inddec); + libLZMA.lzma_index_end(this_index, nil); + end; + end; + +begin + Result:= false; + bp:= Source.Position; + try + fs:= Source.Seek(0, soEnd); + // file size must be 4 byte aligned + if (fs <= 0) or (fs and 3 > 0) then + Exit; + + stream_padding:= 0; + fStreamNr:= 0; + combined_index:= nil; + try + // Jump backwards through the file identifying each stream. + while Source.Position > 0 do begin + if not ReadOneStream then + Exit; + end; + fIndex:= combined_index; + combined_index:= nil; + Result:= true; + except + libLZMA.lzma_index_end(combined_index, nil); + end; + finally + if not Result then + Source.Position:= bp; + end; +end; + +procedure TutlXZStream.IterateIndexes; +var + iter: lzma_index_iter; +begin + fBlockNr:= 0; + fMaxUncompBlockSize:= 0; + + iter:= Default(lzma_index_iter); + libLZMA.lzma_index_iter_init(iter, fIndex); + while not libLZMA.lzma_index_iter_next(iter, LZMA_INDEX_ITER_NONEMPTY_BLOCK) do begin + if iter.block.uncompressed_size > fMaxUncompBlockSize then + fMaxUncompBlockSize:= iter.block.uncompressed_size; + inc(fBlockNr); + end; +end; + +function TutlXZStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +var + iter: lzma_index_iter; + header: array[0..LZMA_BLOCK_HEADER_SIZE_MAX-1] of byte; + tmp: array[0..Z_BUFSIZE] of byte; + r: lzma_ret; + ofs, sz: Int64; +begin + if fWriting then + Exit(inherited Seek(Offset, Origin)); + + // only support absolute position + case Origin of + soEnd: Exit(Seek(fKnownSize + Offset, soBeginning)); + soCurrent: Exit(Seek(Position + Offset, soBeginning)); + end; + + Result:= -1; + + if Offset = fKnownSize then begin + // seek to last - pretend it worked, but reading will fail + fUncompPos:= fKnownSize; + BlockEnd; + Exit; + end; + + // find what block the target is in + iter:= Default(lzma_index_iter); + libLZMA.lzma_index_iter_init(iter, fIndex); + if libLZMA.lzma_index_iter_locate(iter, Offset) then begin + // not found, don't change anything + Exit; + end; + + if (iter.block.compressed_file_offset <> fBlockOffs) or + (Offset < fUncompPos) then begin + + // free current Block + BlockEnd; + + // seek to block begin + fBlockOffs:= iter.block.compressed_file_offset; + if Source.Seek(iter.block.compressed_file_offset, soBeginning)<0 then + Exit; + //Read the block header. Start by reading a single byte which tell us how big the block header is. + Source.ReadBuffer({%H-}header[0], 1); + if header[0] = 0 then + Exit; + + fBlock.version:= 0; + fBlock.check:= iter.stream.flags^.check; + fBlock.filters:= @fFilters[0]; + fBlock.header_size:= libLZMA.lzma_block_header_size_decode(header[0]); + + //Now read and decode the block header. + Source.ReadBuffer(header[1], fBlock.header_size-1); + + r:= libLZMA.lzma_block_header_decode(fBlock, @libLZMA.PascalAllocator, @header[0]); + if r <> LZMA_OK then + Exit; + + // What this actually does is it checks that the block header matches the index. + r:= libLZMA.lzma_block_compressed_size(fBlock, iter.block.unpadded_size); + if r <> LZMA_OK then + Exit; + + // copy over info we need later + fBlock.uncompressed_size:= iter.block.uncompressed_size; + + // Read the block data. + fStream:= Default(lzma_stream); + r:= libLZMA.lzma_block_decoder(fStream, fBlock); + if r <> LZMA_OK then + Exit; + + fUncompPos:= iter.block.uncompressed_file_offset; + end; + + // fast-forward to actual pos + ofs:= Offset - fUncompPos; + while (ofs > 0) do begin + sz := Z_BUFSIZE; + if (ofs < Z_BUFSIZE) then + sz := ofs; + + sz := Read({%H-}tmp[0], sz); + if (sz <= 0) then + Exit; + dec(ofs, sz); + end; + + Result:= fUncompPos; +end; + +function TutlXZStream.GetPosition: Int64; +begin + if fWriting then + Exit(inherited GetPosition); + Result:= fUncompPos; +end; + +procedure TutlXZStream.BlockEnd; +var + i: Integer; +begin + libLZMA.lzma_end(fStream); + fStream:= Default(lzma_stream); + fBlock:= Default(lzma_block); + fBlockOffs:= -1; + + for i:= 0 to LZMA_FILTERS_MAX-1 do begin + if fFilters[i].id <> LZMA_VLI_UNKNOWN then + libLZMA.PascalAllocator.XZfree(nil, fFilters[i].options); + fFilters[i].id:= LZMA_VLI_UNKNOWN; + end; +end; + +class function TutlXZStream.CheckLibraryAvailable: boolean; +begin + libLZMA.Load; + Result:= Assigned(libLZMA.lzma_version_number) and (libLZMA.lzma_version_number()>=LZMA_VER); +end; + +{$ENDIF HAVE_LIBLZMA} + +finalization +{$IFDEF HAVE_LIBLZMA} + libLZMA.Unload; +{$ENDIF HAVE_LIBLZMA} +end. +