lzma.pas

源代码

destructor TLZMACompressor.Destroy;
begin
  FWorkerThread.Free;
  if Assigned(FLZMAHandle) then
    LZMA_End(FLZMAHandle);
  FProgressInfo.Free;
  FOutStream.Free;
  FInStream.Free;
  inherited;
end;

procedure TLZMACompressor.FlushBuffer;
begin
  if FAvailOut < SizeOf(FBuffer) then begin
    WriteProc(FBuffer, SizeOf(FBuffer) - FAvailOut);
    FNextOut := @FBuffer;
    FAvailOut := SizeOf(FBuffer);
  end;
end;

procedure TLZMACompressor.Compress(const Buffer; Count: Longint);
begin
  FNextIn := @Buffer;
  FAvailIn := Count;
  while FAvailIn > 0 do begin
    FWorkerThread.SwitchToWorker;
    if FEncodeFinished then begin
      if FEncodeResult = E_OUTOFMEMORY then
        OutOfMemoryError;
      LZMAInternalError(Format('Compress: LZMA_Encode failed with code 0x%.8x',
        [FEncodeResult]));
    end;
    if FAvailOut = 0 then
      FlushBuffer;
  end;
end;

procedure TLZMACompressor.Finish;
begin
  FNextIn := nil;
  FAvailIn := 0;
  repeat
    FWorkerThread.SwitchToWorker;
    FlushBuffer;
  until FEncodeFinished;
  case FEncodeResult of
    S_OK: ;
    E_OUTOFMEMORY: OutOfMemoryError;
  else
    LZMAInternalError(Format('Finish: LZMA_Encode failed with code 0x%.8x',
      [FEncodeResult]));
  end;
end;

procedure TLZMACompressor.WorkerThreadProc;
{ Worker thread main procedure }
begin
  FEncodeResult := LZMA_Encode(FLZMAHandle, FInStream, FOutStream, FProgressInfo);
  FEncodeFinished := True;
  if not FWorkerThread.FTerminateThread then
    FWorkerThread.ReturnToMain;
end;

function TLZMACompressor.FillBuffer(const FillBuf2: Boolean;
  Buf1: Pointer; Size1: Cardinal; var Buf2: Pointer; var Size2: Cardinal;
  var ProcessedSize: Cardinal): HRESULT;
{ Called from worker thread }
var
  Bytes: Cardinal;
begin
  if Assigned(@ProcessedSize) then
    ProcessedSize := 0;
  if FWorkerThread.FTerminateThread then begin
    { In case this method gets called again after a previous call already
      returned E_ABORT, return E_ABORT again. (This is known to happen with
      the LZMA decoder; not sure about the encoder.) }
    Result := E_ABORT;
    Exit;
  end;
  while Size1 > 0 do begin
    if Size2 = 0 then begin
      { Return control to the main thread so that Buf2 may be refilled }
      FWorkerThread.ReturnToMain;
      if FWorkerThread.FTerminateThread then begin
        Result := E_ABORT;
        Exit;
      end;
      if Size2 = 0 then
        Break;
    end;

    if Size1 <= Size2 then
      Bytes := Size1
    else
      Bytes := Size2;
    if FillBuf2 then
      Move(Buf1^, Buf2^, Bytes)
    else
      Move(Buf2^, Buf1^, Bytes);

    Inc(Cardinal(Buf1), Bytes);
    Dec(Size1, Bytes);
    Inc(Cardinal(Buf2), Bytes);
    Dec(Size2, Bytes);
    if Assigned(@ProcessedSize) then
      Inc(ProcessedSize, Bytes);
  end;
  Result := S_OK;
end;

function TLZMACompressor.Read(var Data; Size: Cardinal;
  var ProcessedSize: Cardinal): HRESULT;
{ Called from worker thread }
begin
  Result := FillBuffer(False, @Data, Size, FNextIn, FAvailIn, ProcessedSize);
end;

function TLZMACompressor.Write(const Data; Size: Cardinal;
  var ProcessedSize: Cardinal): HRESULT;
{ Called from worker thread }
begin
  Result := FillBuffer(True, @Data, Size, FNextOut, FAvailOut, ProcessedSize);
end;

function TLZMACompressor.ProgressMade(const TotalBytesProcessed: Integer64): HRESULT;
{ Called from worker thread }
var
  T: DWORD;
begin
  FWorkerThread.FTotalBytes := TotalBytesProcessed;
  if FWorkerThread.FTerminateThread then begin
    { In case this method gets called after a previous call already returned
      E_ABORT, return E_ABORT again. May not be necessary. }
    Result := E_ABORT;
    Exit;
  end;
  T := GetTickCount;
  if T - FLastProgressTick >= 250 then begin
    FLastProgressTick := T;
    FWorkerThread.FCallProgressProc := True;
    FWorkerThread.ReturnToMain;
    if FWorkerThread.FTerminateThread then begin
      Result := E_ABORT;
      Exit;
    end;
  end;
  Result := S_OK;
end;

{ TLZMADecompressor }

{$L LzmaDecode\LzmaDecode.obj}

type
  TLzmaInCallback = record
    Read: function(obj: Pointer; var buffer: Pointer; var bufferSize: Cardinal): Integer;
  end;

const
  LZMA_RESULT_OK = 0;
  LZMA_RESULT_DATA_ERROR = 1;
  LZMA_RESULT_NOT_ENOUGH_MEM = 2;

function LzmaGetInternalSize(lc, lp: Integer): Cardinal; external;
function LzmaDecoderInit(buffer: Pointer; bufferSize: Cardinal;
  lc, lp, pb: Integer; var dictionary; dictionarySize: Cardinal;
  var inCallback: TLzmaInCallback): Integer; external;
function LzmaDecode(buffer: Pointer; var outStream; outSize: Cardinal;
  var outSizeProcessed: Cardinal): Integer; external;

function ReadFunc(obj: Pointer; var buffer: Pointer; var bufferSize: Cardinal): Integer;
begin
  TLZMADecompressorCallbackData(obj^).Instance.DoRead(buffer, bufferSize);
  { Don't bother returning any sort of failure code, because if DoRead failed,
    it would've raised an exception }
  Result := LZMA_RESULT_OK;
end;

destructor TLZMADecompressor.Destroy;
begin
  DestroyHeap;
  inherited;
end;

procedure TLZMADecompressor.DestroyHeap;
begin
  FLzmaInternalData := nil;
  FHeapSize := 0;
  if Assigned(FHeapBase) then begin
    VirtualFree(FHeapBase, 0, MEM_RELEASE);
    FHeapBase := nil;
  end;
end;

procedure TLZMADecompressor.DoRead(var Buffer: Pointer; var BufferSize: Cardinal);
begin
  Buffer := @FBuffer;
  BufferSize := 0;
  if not FReachedEnd then begin
    BufferSize := ReadProc(FBuffer, SizeOf(FBuffer));
    if BufferSize = 0 then
      FReachedEnd := True;  { not really necessary, but for consistency }
  end;
end;

procedure TLZMADecompressor.ProcessHeader;
var
  Props: Byte;
  DictionarySize: Longint;
  lc, lp, pb: Integer;
  InternalSize, NewHeapSize: Cardinal;
  InternalData, Dictionary: Pointer;
  Code: Integer;
begin
  { Read header fields }
  if ReadProc(Props, SizeOf(Props)) <> SizeOf(Props) then
    LZMADataError(1);
  if ReadProc(DictionarySize, SizeOf(DictionarySize)) <> SizeOf(DictionarySize) then
    LZMADataError(2);
  if (DictionarySize < 0) or (DictionarySize > 32 shl 20) then
    { sanity check: we only use dictionary sizes <= 32 MB }
    LZMADataError(7);

  { Crack Props }
  if Props >= (9 * 5 * 5) then
    LZMADataError(3);
  pb := 0;
  while Props >= (9 * 5) do begin
    Inc(pb);
    Dec(Props, (9 * 5));
  end;
  lp := 0;
  while Props >= 9 do begin
    Inc(lp);
    Dec(Props, 9);
  end;
  lc := Props;

  { Figure out how much memory we need and allocate it }
  InternalSize := LzmaGetInternalSize(lc, lp);
  if InternalSize and 3 <> 0 then
    InternalSize := (InternalSize or 3) + 1;  { round up to DWORD boundary }
  NewHeapSize := InternalSize + Cardinal(DictionarySize);
  if FHeapSize <> NewHeapSize then begin
    DestroyHeap;
    FHeapBase := VirtualAlloc(nil, NewHeapSize, MEM_COMMIT, PAGE_READWRITE);
    if FHeapBase = nil then
      OutOfMemoryError;
    FHeapSize := NewHeapSize;
  end;
  InternalData := FHeapBase;
  Dictionary := Pointer(Cardinal(InternalData) + InternalSize);

  { Now initialize }
  TLzmaInCallback(FCallbackData.Callback).Read := ReadFunc;
  FCallbackData.Instance := Self;
  Code := LzmaDecoderInit(InternalData, InternalSize, lc, lp, pb,
    Dictionary^, DictionarySize, TLzmaInCallback(FCallbackData.Callback));
  case Code of
    LZMA_RESULT_OK: ;
    LZMA_RESULT_DATA_ERROR: LZMADataError(4);
  else
    LZMAInternalError(Format('LzmaDecoderInit failed (%d)', [Code]));
  end;
  FLzmaInternalData := InternalData;
end;

procedure TLZMADecompressor.DecompressInto(var Buffer; Count: Longint);
var
  Code: Integer;
  OutProcessed: Cardinal;
begin
  if FLzmaInternalData = nil then
    ProcessHeader;
  Code := LzmaDecode(FLzmaInternalData, Buffer, Count, OutProcessed);
  case Code of
    LZMA_RESULT_OK: ;
    LZMA_RESULT_DATA_ERROR: LZMADataError(5);
  else
    LZMAInternalError(Format('LzmaDecode failed (%d)', [Code]));
  end;
  if OutProcessed <> Cardinal(Count) then
    LZMADataError(6);
end;

procedure TLZMADecompressor.Reset;
begin
  FLzmaInternalData := nil;
  FReachedEnd := False;
end;

{ I7zUnknown }

function I7zUnknown.QueryInterface(const iid; var obj): HRESULT;
begin
  Pointer(obj) := nil;
  Result := E_NOINTERFACE;
end;

function I7zUnknown.AddRef: Longint;
begin
  Result := 1;
end;

function I7zUnknown.Release: Longint;
begin
  Result := 1;
end;

{ TLZMAInStream }

function TLZMAInStream.Read(var data; size: Cardinal;
  var processedSize: Cardinal): HRESULT;
begin
  Result := FReadProc(data, size, processedSize);
end;

function TLZMAInStream.ReadPart(var data; size: Cardinal;
  var processedSize: Cardinal): HRESULT;
begin
  Result := FReadProc(data, size, processedSize);
end;

{ TLZMAOutStream }

function TLZMAOutStream.Write(const data; size: Cardinal;
  var processedSize: Cardinal): HRESULT;
begin
  Result := FWriteProc(data, size, processedSize);
end;

function TLZMAOutStream.WritePart(const data; size: Cardinal;
  var processedSize: Cardinal): HRESULT;
begin
  Result := FWriteProc(data, size, processedSize);
end;

{ TLZMAProgressInfo }

function TLZMAProgressInfo.SetRatioInfo(const inSize, outSize: Integer64): HRESULT;
begin
  Result := FProgressProc(inSize);
end;

end.