(* ***** BEGIN LICENSE BLOCK ***** * Version: MPL 1.1 * * The contents of this file are subject to the Mozilla Public License Version * 1.1 (the "License"); you may not use this file except in compliance with * the License. You may obtain a copy of the License at * http://www.mozilla.org/MPL/ * * Software distributed under the License is distributed on an "AS IS" basis, * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License * for the specific language governing rights and limitations under the * License. * * The Original Code is TurboPower Abbrevia * * The Initial Developer of the Original Code is Craig Peterson * * Portions created by the Initial Developer are Copyright (C) 2011 * the Initial Developer. All Rights Reserved. * * Contributor(s): * Craig Peterson * Pierre le Riche * * ***** END LICENSE BLOCK ***** *) {*********************************************************} {* ABBREVIA: AbLZMA.pas *} {*********************************************************} {* ABBREVIA: Lzma compression/decompression procedures. *} {*********************************************************} unit AbLZMA; {$I AbDefine.inc} interface uses Classes, Windows, SysUtils, AbCrtl, AbUtils; { Raw LZMA decompression =================================================== } { Decompresses the LZMA compressed data in ASrc to ADes. ASrc should not have the header used by the other compression/decompression routines, and AProperties should contain any necessary data. } procedure LzmaDecodeStream(AProperties: PByte; APropSize: Integer; ASrc, ADes: TStream; AUncompressedSize: Int64 = -1); overload; { Stream compression and decompression (taken from LzmaUtil.c) ============= } procedure LzmaDecodeStream(ASourceStream, ATargetStream: TStream); overload; procedure LzmaEncodeStream(ASourceStream, ATargetStream: TStream; ASourceSize: Int64); { In-memory compression and decompression ================================== } { Given a pointer to the compressed data, this will return the size of the decompressed data. } function LzmaGetUncompressedSize(APCompressedData: Pointer; ACompressedSize: Integer): Integer; { Decompresses the LZMA compressed data at APCompressedData to the buffer pointed to by APUncompressedData. The buffer at APUncompressedData should be large enough to hold the number of bytes as returned by LzmaGetDecompressedSize. } procedure LzmaDecodeBuffer(APCompressedData: Pointer; ACompressedSize: Integer; APUncompressedData: Pointer); { Compresses the data at APUncompressedData to the buffer at APCompressedData, and returns the number of bytes written. If ACompressedDataBufferCapacity is less than the number of bytes required to store the entire compressed stream, or any other error occurs, then an exception is raised. (A safe number for ACompressedDataBufferCapacity is slightly more than AUncompressedDataBufferSize.) Leave ACompressionLevel and ADictionarySize at -1 in order to use the default values (5 and 16MB respectively). } function LzmaEncodeBuffer(APUncompressedData: Pointer; AUncompressedSize: Integer; APCompressedData: Pointer; ACompressedDataBufferCapacity: Integer; ACompressionLevel: Integer = -1; ADictionarySize: Integer = -1): Integer; { Types.h declarations ===================================================== } const SZ_OK = 0; SZ_ERROR_DATA = 1; SZ_ERROR_MEM = 2; SZ_ERROR_CRC = 3; SZ_ERROR_UNSUPPORTED = 4; SZ_ERROR_PARAM = 5; SZ_ERROR_INPUT_EOF = 6; SZ_ERROR_OUTPUT_EOF = 7; SZ_ERROR_READ = 8; SZ_ERROR_WRITE = 9; SZ_ERROR_PROGRESS = 10; SZ_ERROR_FAIL = 11; SZ_ERROR_THREAD = 12; SZ_ERROR_ARCHIVE = 16; SZ_ERROR_NO_ARCHIVE = 17; type SRes = Integer; ISeqInStream = packed record Read: function(p: Pointer; var buf; var size: size_t): SRes; cdecl; end; PISeqInStream = ^ISeqInStream; ISeqOutStream = packed record Write: function(p: Pointer; const buf; size: size_t): size_t; cdecl; end; PISeqOutStream = ^ISeqOutStream; ICompressProgress = packed record Progress: function(p: Pointer; inSize, outSize: Int64): SRes; cdecl; end; PICompressProgress = ^ICompressProgress; ISzAlloc = packed record Alloc: function(p: Pointer; size: size_t): Pointer; cdecl; Free: procedure(p: Pointer; address: Pointer); cdecl; end; PISzAlloc = ^ISzAlloc; { LzmaDec.h declarations =================================================== } type CLzmaProb = Word; // LZMA Properties const LZMA_PROPS_SIZE = 5; type CLzmaProps = packed record lc, lp, pb: Cardinal; dicSize: UInt32; end; // LZMA Decoder state const LZMA_REQUIRED_INPUT_MAX = 20; type CLzmaDec = packed record prop: CLzmaProps; probs: ^CLzmaProb; dic: PByte; buf: PByte; range, code: UInt32; dicPos: size_t; dicBufSize: size_t; processedPos: UInt32; checkDicSize: UInt32; state: Cardinal; reps: array[0..3] of UInt32; remainLen: Cardinal; needFlush: Integer; needInitState: Integer; numProbs: UInt32; tempBufSize: Cardinal; tempBuf: array[0..LZMA_REQUIRED_INPUT_MAX - 1] of Byte; end; type ELzmaFinishMode = LongInt; const LZMA_FINISH_ANY = 0; // finish at any point LZMA_FINISH_END = 1; // block must be finished at the end type ELzmaStatus = LongInt; const LZMA_STATUS_NOT_SPECIFIED = 0; // use main error code instead LZMA_STATUS_FINISHED_WITH_MARK = 1; // stream was finished with end mark. LZMA_STATUS_NOT_FINISHED = 3; // stream was not finished LZMA_STATUS_NEEDS_MORE_INPUT = 4; // you must provide more input bytes LZMA_STATUS_MAYBE_FINISHED_WITHOUT_MARK = 5; // there is probability that stream was finished without end mark procedure LzmaDec_Construct(var p: CLzmaDec); cdecl; procedure LzmaDec_Init(var p: CLzmaDec); cdecl; external; function LzmaDec_DecodeToBuf(var p: CLzmaDec; dest: PByte; var destLen: size_t; src: PByte; var srcLen: size_t; finishMode: ELzmaFinishMode; var status: ELzmaStatus): SRes; cdecl; external; function LzmaDec_Allocate(var state: CLzmaDec; prop: PByte; propsSize: Integer; alloc: PISzAlloc): SRes; cdecl; external; procedure LzmaDec_Free(var state: CLzmaDec; alloc: PISzAlloc); cdecl; external; // One call decoding interface function LzmaDecode(dest: PByte; var destLen: size_t; src: PByte; var srcLen: size_t; propData: PByte; propSize: Integer; finishMode: ELzmaFinishMode; var status: ELzmaStatus; alloc: PISzAlloc): SRes; cdecl; external; { LzmaEnc.h declarations =================================================== } type CLzmaEncHandle = Pointer; CLzmaEncProps = packed record level: Integer; // 0 <= level <= 9 dictSize: UInt32; // (1 << 12) <= dictSize <= (1 << 27) for 32-bit version // (1 << 12) <= dictSize <= (1 << 30) for 64-bit version // default = (1 << 24) lc: Integer; // 0 <= lc <= 8, default = 3 lp: Integer; // 0 <= lp <= 4, default = 0 pb: Integer; // 0 <= pb <= 4, default = 2 algo: Integer; // 0 - fast, 1 - normal, default = 1 fb: Integer; // 5 <= fb <= 273, default = 32 btMode: Integer; // 0 - hashChain Mode, 1 - binTree mode - normal, default = 1 numHashBytes: Integer; // 2, 3 or 4, default = 4 mc: UInt32; // 1 <= mc <= (1 << 30), default = 32 writeEndMark: Cardinal; // 0 - do not write EOPM, 1 - write EOPM, default = 0 numThreads: Integer; // 1 or 2, default = 2 end; procedure LzmaEncProps_Init(var p: CLzmaEncProps); cdecl; external; function LzmaEnc_Create(Alloc: PISzAlloc): CLzmaEncHandle; cdecl; external; procedure LzmaEnc_Destroy(p: CLzmaEncHandle; Alloc, allocBig: PISzAlloc); cdecl; external; function LzmaEnc_SetProps(p: CLzmaEncHandle; var props: CLzmaEncProps): SRes; cdecl; external; function LzmaEnc_WriteProperties(p: CLzmaEncHandle; properties: PByte; var size: size_t): SRes; cdecl; external; function LzmaEnc_Encode(p: CLzmaEncHandle; outStream: PISeqOutStream; inStream: PISeqInStream; Progress: PICompressProgress; Alloc, allocBig: PISzAlloc): SRes; cdecl; external; function LzmaEnc_MemEncode(p: CLzmaEncHandle; dest: PByte; var destLen: size_t; src: PByte; srcLen: size_t; writeEndMark: Integer; Progress: PICompressProgress; Alloc, allocBig: PISzAlloc): SRes; cdecl; external; // One call encoding interface function LzmaEncode(dest: PByte; var destLen: size_t; src: PByte; srcLen: size_t; var props: CLzmaEncProps; propsEncoded: PByte; var propsSize: size_t; writeEndMark: Integer; progress: PICompressProgress; alloc: pISzAlloc; allocBig: PISzAlloc): SRes; cdecl; external; { LzFind.h declarations ==================================================== } procedure MatchFinder_NeedMove; external; procedure MatchFinder_GetPointerToCurrentPos; external; procedure MatchFinder_MoveBlock; external; procedure MatchFinder_ReadIfRequired; external; procedure MatchFinder_Construct; external; procedure MatchFinder_Create; external; procedure MatchFinder_Free; external; procedure MatchFinder_Normalize3; external; procedure MatchFinder_ReduceOffsets; external; procedure GetMatchesSpec1; external; procedure MatchFinder_Init; external; procedure MatchFinder_CreateVTable; external; { LzFindMt.h declarations ================================================== } procedure MatchFinderMt_Construct; external; procedure MatchFinderMt_Destruct; external; procedure MatchFinderMt_Create; external; procedure MatchFinderMt_CreateVTable; external; procedure MatchFinderMt_ReleaseStream; external; { Lzma header fields ======================================================= } type // The condensed compression properties TLZMAPropertyData = array[0..LZMA_PROPS_SIZE - 1] of Byte; // The header usually stored in front of LZMA compressed data TLZMAHeader = packed record PropertyData: TLZMAPropertyData; UncompressedSize: Int64; end; PLZMAHeader = ^TLZMAHeader; { Error handling =========================================================== } type EAbLZMAException = class(Exception); procedure LzmaCheck(AResultCode: SRes); procedure RaiseLzmaException(AResultCode: SRes); { Linker directives ======================================================== } {$WARN BAD_GLOBAL_SYMBOL OFF} {$IF DEFINED(WIN32)} {$L Win32\LzFind.obj} {$L Win32\LzFindMt.obj} {$L Win32\LzmaDec.obj} {$L Win32\LzmaEnc.obj} {$L Win32\Threads.obj} {$ELSEIF DEFINED(WIN64)} {$L Win64\LzFind.obj} {$L Win64\LzFindMt.obj} {$L Win64\LzmaDec.obj} {$L Win64\LzmaEnc.obj} {$L Win64\Threads.obj} {$IFEND} implementation { Error handling =========================================================== } procedure LzmaCheck(AResultCode: SRes); begin if AResultCode <> SZ_OK then RaiseLzmaException(AResultCode); end; { -------------------------------------------------------------------------- } procedure RaiseLzmaException(AResultCode: SRes); begin case AResultCode of SZ_ERROR_DATA: raise EAbLZMAException.Create('LZMA Data Error.'); SZ_ERROR_MEM: raise EAbLZMAException.Create('LZMA Memory Error.'); SZ_ERROR_CRC: raise EAbLZMAException.Create('LZMA CRC Error.'); SZ_ERROR_UNSUPPORTED: raise EAbLZMAException.Create('LZMA "Unsupported" Error.'); SZ_ERROR_PARAM: raise EAbLZMAException.Create('LZMA Parameter Error.'); SZ_ERROR_INPUT_EOF: raise EAbLZMAException.Create('LZMA Input EOF Error.'); SZ_ERROR_OUTPUT_EOF: raise EAbLZMAException.Create('LZMA Output EOF Error.'); SZ_ERROR_READ: raise EAbLZMAException.Create('LZMA Read Error.'); SZ_ERROR_WRITE: raise EAbLZMAException.Create('LZMA Write Error.'); SZ_ERROR_PROGRESS: raise EAbLZMAException.Create('LZMA Progress Error.'); SZ_ERROR_FAIL: raise EAbLZMAException.Create('LZMA "Fail" Error.'); SZ_ERROR_THREAD: raise EAbLZMAException.Create('LZMA Thread Error.'); SZ_ERROR_ARCHIVE: raise EAbLZMAException.Create('LZMA Archive Error.'); SZ_ERROR_NO_ARCHIVE: raise EAbLZMAException.Create('LZMA "No Archive" Error.'); else raise EAbLZMAException.CreateFmt('Unknown LZMA error (%d)', [AResultCode]); end; end; { Helper Routines ========================================================== } procedure LzmaDec_Construct(var p: CLzmaDec); cdecl; begin p.dic := nil; p.probs := nil; end; { -------------------------------------------------------------------------- } function SzAlloc(p: Pointer; size: size_t): Pointer; cdecl; begin Result := GetMemory(size); end; { -------------------------------------------------------------------------- } procedure SzFree(p, address: Pointer); cdecl; begin FreeMemory(address); end; var DelphiMMInterface: ISzAlloc = (Alloc: SzAlloc; Free: SzFree); { CSeq*Stream implementation =============================================== } type CSeqInStream = packed record Intf: ISeqInStream; Stream: TStream; end; CSeqOutStream = packed record Intf: ISeqOutStream; Stream: TStream; end; { -------------------------------------------------------------------------- } function ISeqInStream_Read(p: Pointer; var buf; var size: size_t): SRes; cdecl; begin try size := CSeqInStream(p^).Stream.Read(buf, size); Result := SZ_OK; except Result := SZ_ERROR_DATA; end; end; { -------------------------------------------------------------------------- } function ISeqOutStream_Write(p: Pointer; const buf; size: size_t): size_t; cdecl; begin try Result := CSeqOutStream(p^).Stream.Write(buf, size); except Result := 0; end; end; { Raw LZMA decompression =================================================== } { Decompress an Lzma compressed stream. Based on LzmaUtil.c::Decode2 } function LzmaDecode2(var aState: CLzmaDec; aOutStream, aInStream: TStream; aUncompressedSize: Int64 = -1): SRes; const IN_BUF_SIZE = 1 shl 16; OUT_BUF_SIZE = 1 shl 16; var LHasSize: Boolean; LInBuf: array [0..IN_BUF_SIZE - 1] of Byte; LOutBuf: array [0..OUT_BUF_SIZE - 1] of Byte; LInPos, LInSize, LOutPos: size_t; LInProcessed, LOutProcessed: size_t; LFinishMode: ELzmaFinishMode; LStatus: ELzmaStatus; begin Result := 0; LHasSize := aUncompressedSize <> -1; LInPos := 0; LInSize := 0; LOutPos := 0; LzmaDec_Init(aState); while True do begin if LInPos = LInSize then begin LInSize := aInStream.Read(LInBuf, IN_BUF_SIZE); LInPos := 0; if LInSize = 0 then Break; end else begin LInProcessed := LInSize - LInPos; LOutProcessed := OUT_BUF_SIZE - LOutPos; LFinishMode := LZMA_FINISH_ANY; if LHasSize and (LOutProcessed > aUncompressedSize) then begin LOutProcessed := size_t(aUncompressedSize); LFinishMode := LZMA_FINISH_END; end; Result := LzmaDec_DecodeToBuf(aState, @LOutBuf[LOutPos], LOutProcessed, @LInBuf[LInPos], LInProcessed, LFinishMode, LStatus); Inc(LInPos, LInProcessed); Inc(LOutPos, LOutProcessed); Dec(aUncompressedSize, LOutProcessed); if (aOutStream <> nil) and (aOutStream.Write(LOutBuf, LOutPos) <> LOutPos) then begin Result := SZ_ERROR_WRITE; Exit; end; LOutPos := 0; if (Result <> SZ_OK) or (LHasSize and (aUncompressedSize = 0)) then Exit; if (LInProcessed = 0) and (LOutProcessed = 0) then begin if LHasSize or (LStatus <> LZMA_STATUS_FINISHED_WITH_MARK) then Result := SZ_ERROR_DATA; Exit; end; end; end; end; { -------------------------------------------------------------------------- } { Decompress an LZMA compressed stream. Pass AUncompressedSize = -1 if the uncompressed size is not known. } procedure LzmaDecodeStream(AProperties: PByte; APropSize: Integer; ASrc, ADes: TStream; AUncompressedSize: Int64); var LLZMADecState: CLzmaDec; begin LzmaDec_Construct(LLZMADecState); try LzmaCheck(LzmaDec_Allocate(LLZMADecState, AProperties, APropSize, @DelphiMMInterface)); LzmaCheck(LzmaDecode2(LLZMADecState, ADes, ASrc, AUncompressedSize)); finally LzmaDec_Free(LLZMADecState, @DelphiMMInterface); end; end; { Stream to stream compression and decompression =========================== } { Decompresses streams compressed with the LZMA SDK's LzmaUtil.exe. Based on LzmaUtil.c::Decode } procedure LzmaDecodeStream(ASourceStream, ATargetStream: TStream); var LUncompressedSize: Int64; // Header: 5 bytes of LZMA properties and 8 bytes of uncompressed size LHeader: TLZMAHeader; begin // Read and parse header ASourceStream.ReadBuffer(LHeader, SizeOf(LHeader)); LUncompressedSize := LHeader.UncompressedSize; LzmaDecodeStream(PByte(@LHeader.PropertyData), LZMA_PROPS_SIZE, ASourceStream, ATargetStream, LUncompressedSize); end; { -------------------------------------------------------------------------- } { Compresses a stream so it's compatible with the LZMA SDK's LzmaUtil.exe. Based on LzmaUtil.c::Encode } procedure LzmaEncodeStream(ASourceStream, ATargetStream: TStream; ASourceSize: Int64); var LEncHandle: CLzmaEncHandle; LEncProps: CLzmaEncProps; LHeader: TLZMAHeader; LPropDataSize: size_t; LInStreamRec: CSeqInStream; LOutStreamRec: CSeqOutStream; begin LInStreamRec.Intf.Read := ISeqInStream_Read; LInStreamRec.Stream := ASourceStream; LOutStreamRec.Intf.Write := ISeqOutStream_Write; LOutStreamRec.Stream := ATargetStream; LEncHandle := LzmaEnc_Create(@DelphiMMInterface); if LEncHandle = nil then LzmaCheck(SZ_ERROR_MEM); try LzmaEncProps_Init(LEncProps); LzmaCheck(LzmaEnc_SetProps(LEncHandle, LEncProps)); LPropDataSize := LZMA_PROPS_SIZE; LzmaCheck(LzmaEnc_WriteProperties(LEncHandle, PByte(@LHeader.PropertyData), LPropDataSize)); LHeader.UncompressedSize := ASourceSize; ATargetStream.WriteBuffer(LHeader, SizeOf(LHeader)); LzmaCheck(LzmaEnc_Encode(LEncHandle, @LOutStreamRec.Intf, @LInStreamRec.Intf, nil, @DelphiMMInterface, @DelphiMMInterface)); finally LzmaEnc_Destroy(LEncHandle, @DelphiMMInterface, @DelphiMMInterface); end; end; { In-memory compression and decompression ================================== } { Given a pointer to the compressed data, this will return the size of the decompressed data. } function LzmaGetUncompressedSize(APCompressedData: Pointer; ACompressedSize: Integer): Integer; begin if ACompressedSize <= SizeOf(TLZMAHeader) then raise EAbLZMAException.Create('The LZMA compressed data is invalid (not enough bytes)'); Result := PLZMAHeader(APCompressedData).UncompressedSize; end; { -------------------------------------------------------------------------- } { Decompresses the LZMA compressed data at APCompressedData to the buffer pointed to by APUncompressedData. The buffer at APUncompressedData should be large enough to hold the number of bytes as returned by LzGetDecompressedSize. } procedure LzmaDecodeBuffer(APCompressedData: Pointer; ACompressedSize: Integer; APUncompressedData: Pointer); var LPropertyData: TLZMAPropertyData; LUncompressedSize: Int64; LInputByteCount, LOutputByteCount: size_t; LStatus: ELzmaStatus; begin if ACompressedSize <= SizeOf(TLZMAHeader) then raise EAbLZMAException.Create('The LZMA compressed data is invalid (not enough bytes)'); // Read the header from the compressed data. LPropertyData := PLZMAHeader(APCompressedData).PropertyData; LUncompressedSize := PLZMAHeader(APCompressedData).UncompressedSize; Inc(PAnsiChar(APCompressedData), SizeOf(TLZMAHeader)); Dec(ACompressedSize, SizeOf(TLZMAHeader)); // Decompress from the input to the output buffer. This will change the byte // count variables to the actual number of bytes consumed/written. LInputByteCount := ACompressedSize; LOutputByteCount := LUncompressedSize; LzmaCheck(LzmaDecode(APUncompressedData, LOutputByteCount, APCompressedData, LInputByteCount, PByte(@LPropertyData), LZMA_PROPS_SIZE, LZMA_FINISH_END, LStatus, @DelphiMMInterface)); // Check that the input buffer was fully consumed and the output buffer was filled up. if (LOutputByteCount <> LUncompressedSize) or (LInputByteCount <> ACompressedSize) then raise EAbLZMAException.Create('LZMA decompression data error'); end; { -------------------------------------------------------------------------- } { Compresses the data at APUncompressedData to the buffer at APCompressedData, and returns the number of bytes written. If ACompressedDataBufferCapacity is less than the number of bytes required to store the entire compressed stream, or any other error occurs, then an exception is raised. (A safe number for ACompressedDataBufferCapacity is slightly more than AUncompressedDataBufferSize.) Leave ACompressionLevel and ADictionarySize at -1 in order to use the default values (5 and 16MB respectively). } function LzmaEncodeBuffer(APUncompressedData: Pointer; AUncompressedSize: Integer; APCompressedData: Pointer; ACompressedDataBufferCapacity, ACompressionLevel, ADictionarySize: Integer): Integer; var LEncProps: CLzmaEncProps; LPropsSize: size_t; LPOutBuf: PByte; LOutputBytes: size_t; begin if ACompressedDataBufferCapacity <= SizeOf(TLZMAHeader) then raise EAbLZMAException.Create('LZMA output buffer too small'); // Set the uncompressed size in the header PLZMAHeader(APCompressedData).UncompressedSize := AUncompressedSize; // Set the properties LzmaEncProps_Init(LEncProps); if ACompressionLevel >= 0 then LEncProps.level := ACompressionLevel; if ADictionarySize >= 0 then LEncProps.dictSize := ADictionarySize; LPOutBuf := PByte(PtrUInt(APCompressedData) + SizeOf(TLZMAHeader)); LOutputBytes := ACompressedDataBufferCapacity - SizeOf(TLZMAHeader); LPropsSize := LZMA_PROPS_SIZE; LzmaCheck(LzmaEncode(LPOutBuf, LOutputBytes, APUncompressedData, AUncompressedSize, LEncProps, APCompressedData, LPropsSize, 0, nil, @DelphiMMInterface, @DelphiMMInterface)); Result := LOutputBytes + SizeOf(TLZMAHeader); end; initialization // The LZMA routines are multithreaded and use the Delphi memory manager. IsMultiThread := True; end.