extract.pas

源代码

unit Extract;

{
  Inno Setup
  Copyright (C) 1997-2004 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  TFileExtractor class

  $jrsoftware: issrc/Projects/Extract.pas,v 1.20 2004/08/01 00:00:49 jr Exp $
}

interface

uses
  Windows, SysUtils, Int64Em, FileClass, Compress, Struct, ArcFour;

type
  TExtractorProgressProc = procedure(Bytes: Cardinal);

  TFileExtractor = class
  private
    FDecompressor: array[Boolean] of TCustomDecompressor;
    FSourceF: TFile;
    FOpenedSlice, FChunkFirstSlice, FChunkLastSlice: Integer;
    FChunkStartOffset: Longint;
    FChunkBytesLeft, FChunkDecompressedBytesRead: Integer64;
    FNeedReset: Boolean;
    FChunkCompressed, FChunkEncrypted: Boolean;
    FCryptContext: TArcFourContext;
    FCryptKey: String;
    procedure DecompressBytes(var Buffer; Count: Cardinal);
    class function FindSliceFilename(const ASlice: Integer): String;
    procedure OpenSlice(const ASlice: Integer);
    function ReadProc(var Buf; Count: Longint): Longint;
  public
    constructor Create(ADecompressorClass: TCustomDecompressorClass);
    destructor Destroy; override;
    procedure DecompressFile(const FL: TSetupFileLocationEntry; const DestF: TFile;
      const ProgressProc: TExtractorProgressProc; const VerifyChecksum: Boolean);
    procedure SeekTo(const FL: TSetupFileLocationEntry;
      const ProgressProc: TExtractorProgressProc);
    property CryptKey: String write FCryptKey;
  end;

function FileExtractor: TFileExtractor;
procedure FreeFileExtractor;

implementation

uses
  PathFunc, CmnFunc2, Main, Msgs, MsgIDs, zlib, bzlib, LZMA, CallOptimizer,
  MD5, NewDisk;

var
  FFileExtractor: TFileExtractor;

function FileExtractor: TFileExtractor;
const
  DecompClasses: array[TSetupCompressMethod] of TCustomDecompressorClass =
    (TStoredDecompressor, TZDecompressor, TBZDecompressor, TLZMADecompressor);
begin
  if FFileExtractor = nil then
    FFileExtractor := TFileExtractor.Create(DecompClasses[SetupHeader.CompressMethod]);
  Result := FFileExtractor;
end;

procedure FreeFileExtractor;
begin
  FreeAndNil(FFileExtractor);
end;

procedure SourceIsCorrupted;
begin
  raise Exception.Create(SetupMessages[msgSourceIsCorrupted]);
end;

{ TFileExtractor }

constructor TFileExtractor.Create(ADecompressorClass: TCustomDecompressorClass);
begin
  inherited Create;
  FOpenedSlice := -1;
  FChunkFirstSlice := -1;
  { Create one 'decompressor' for use with uncompressed chunks, and another
    for use with compressed chunks }
  FDecompressor[False] := TStoredDecompressor.Create(ReadProc);
  FDecompressor[True] := ADecompressorClass.Create(ReadProc);
end;

destructor TFileExtractor.Destroy;
begin
  FSourceF.Free;
  FDecompressor[True].Free;
  FDecompressor[False].Free;
  inherited;
end;

var
  LastSourceDir: String;

class function TFileExtractor.FindSliceFilename(const ASlice: Integer): String;
var
  Major, Minor: Integer;
  Prefix, F1, F2, Path: String;
begin
  Prefix := PathChangeExt(PathExtractName(SetupLdrOriginalFilename), '');
  Major := ASlice div SetupHeader.SlicesPerDisk + 1;
  Minor := ASlice mod SetupHeader.SlicesPerDisk;
  if SetupHeader.SlicesPerDisk = 1 then
    F1 := Format('%s-%d.bin', [Prefix, Major])
  else
    F1 := Format('%s-%d%s.bin', [Prefix, Major, Chr(Ord('a') + Minor)]);
  F2 := Format('..\DISK%d\', [Major]) + F1;
  if LastSourceDir <> '' then begin
    Result := AddBackslash(LastSourceDir) + F1;
    if NewFileExists(Result) then Exit;
  end;
  Result := AddBackslash(SourceDir) + F1;
  if NewFileExists(Result) then Exit;
  if LastSourceDir <> '' then begin
    Result := PathExpand(AddBackslash(LastSourceDir) + F2);
    if NewFileExists(Result) then Exit;
  end;
  Result := PathExpand(AddBackslash(SourceDir) + F2);
  if NewFileExists(Result) then Exit;
  Path := SourceDir;
  if SelectDisk(Major, F1, Path) then begin
    LastSourceDir := Path;
    Result := AddBackslash(Path) + F1;
  end
  else
    Abort;
end;

procedure TFileExtractor.OpenSlice(const ASlice: Integer);
var
  Filename: String;
  TestDiskSliceID: TDiskSliceID;
  DiskSliceHeader: TDiskSliceHeader;
begin
  if FOpenedSlice = ASlice then
    Exit;

  FOpenedSlice := -1;
  FreeAndNil(FSourceF);

  if SetupLdrOffset1 = 0 then
    Filename := FindSliceFilename(ASlice)
  else
    Filename := SetupLdrOriginalFilename;
  FSourceF := TFile.Create(Filename, fdOpenExisting, faRead, fsRead);
  if SetupLdrOffset1 = 0 then begin
    if FSourceF.Read(TestDiskSliceID, SizeOf(TestDiskSliceID)) <> SizeOf(TestDiskSliceID) then
      SourceIsCorrupted;
    if TestDiskSliceID <> DiskSliceID then
      SourceIsCorrupted;
    if FSourceF.Read(DiskSliceHeader, SizeOf(DiskSliceHeader)) <> SizeOf(DiskSliceHeader) then
      SourceIsCorrupted;
    if FSourceF.Size.Lo <> DiskSliceHeader.TotalSize then
      SourceIsCorrupted;
  end;
  FOpenedSlice := ASlice;
end;

procedure TFileExtractor.DecompressBytes(var Buffer; Count: Cardinal);
begin
  try
    FDecompressor[FChunkCompressed].DecompressInto(Buffer, Count);
  except
    { If DecompressInto raises an exception, force a decompressor reset &
      re-seek the next time SeekTo is called by setting FNeedReset to True.
      We don't want to get stuck in an endless loop with the decompressor
      in e.g. a data error state. Also, we have no way of knowing if
      DecompressInto successfully decompressed some of the requested bytes
      before the exception was raised. }
    FNeedReset := True;
    raise;
  end;
  Inc64(FChunkDecompressedBytesRead, Count);
end;

procedure TFileExtractor.SeekTo(const FL: TSetupFileLocationEntry;
  const ProgressProc: TExtractorProgressProc);

  procedure InitDecryption;
  var
    Salt: TSetupSalt;
    Context: TMD5Context;
    Hash: TMD5Digest;
  begin
    { Read the salt }
    if FSourceF.Read(Salt, SizeOf(Salt)) <> SizeOf(Salt) then
      SourceIsCorrupted;

    { Initialize the key, which is the MD5 hash of the salt plus FCryptKey }
    MD5Init(Context);
    MD5Update(Context, Salt, SizeOf(Salt));
    MD5Update(Context, Pointer(FCryptKey)^, Length(FCryptKey));
    Hash := MD5Final(Context);
    ArcFourInit(FCryptContext, Hash, SizeOf(Hash));

    { The compiler discards the first 1000 bytes for extra security,
      so we must as well }
    ArcFourDiscard(FCryptContext, 1000);
  end;

  procedure Discard(Count: Integer64);
  var
    Buf: array[0..65535] of Byte;
    BufSize: Cardinal;
  begin
    try
      while True do begin
        BufSize := SizeOf(Buf);
        if (Count.Hi = 0) and (Count.Lo < BufSize) then
          BufSize := Count.Lo;
        if BufSize = 0 then
          Break;
        DecompressBytes(Buf, BufSize);
        Dec64(Count, BufSize);
        if Assigned(ProgressProc) then
          ProgressProc(0);
      end;
    except
      on ECompressDataError do
        SourceIsCorrupted;
    end;
  end;

var
  TestCompID: TCompID;
  Diff: Integer64;
begin
  if (foChunkEncrypted in FL.Flags) and (FCryptKey = '') then
    InternalError('Cannot read an encrypted file before the key has been set');

  { Is the file in a different chunk than the current one?
    Or, is the file in a part of the current chunk that we've already passed?
    Or, did a previous decompression operation fail, necessitating a reset? }
  if (FChunkFirstSlice <> FL.FirstSlice) or
     (FChunkStartOffset <> FL.StartOffset) or
     (Compare64(FL.ChunkSuboffset, FChunkDecompressedBytesRead) < 0) or
     FNeedReset then begin
    FChunkFirstSlice := -1;
    FDecompressor[foChunkCompressed in FL.Flags].Reset;
    FNeedReset := False;

    OpenSlice(FL.FirstSlice);

    FSourceF.Seek(SetupLdrOffset1 + FL.StartOffset);
    if FSourceF.Read(TestCompID, SizeOf(TestCompID)) <> SizeOf(TestCompID) then
      SourceIsCorrupted;
    if Longint(TestCompID) <> Longint(ZLIBID) then
      SourceIsCorrupted;
    if foChunkEncrypted in FL.Flags then
      InitDecryption;

    FChunkFirstSlice := FL.FirstSlice;
    FChunkLastSlice := FL.LastSlice;
    FChunkStartOffset := FL.StartOffset;
    FChunkBytesLeft := FL.ChunkCompressedSize;
    FChunkDecompressedBytesRead.Hi := 0;
    FChunkDecompressedBytesRead.Lo := 0;
    FChunkCompressed := foChunkCompressed in FL.Flags;
    FChunkEncrypted := foChunkEncrypted in FL.Flags;
  end;

  { Need to seek forward in the chunk? }
  if Compare64(FL.ChunkSuboffset, FChunkDecompressedBytesRead) > 0 then begin
    Diff := FL.ChunkSuboffset;
    Dec6464(Diff, FChunkDecompressedBytesRead);
    Discard(Diff);
  end;
end;

function TFileExtractor.ReadProc(var Buf; Count: Longint): Longint;
var
  Buffer: Pointer;
  Left, Res: Cardinal;
begin
  Buffer := @Buf;
  Left := Count;
  if (FChunkBytesLeft.Hi = 0) and (FChunkBytesLeft.Lo < Left) then
    Left := FChunkBytesLeft.Lo;
  Result := Left;
  while Left <> 0 do begin
    Res := FSourceF.Read(Buffer^, Left);
    Dec64(FChunkBytesLeft, Res);

    { Decrypt the data after reading from the file }
    if FChunkEncrypted then
      ArcFourCrypt(FCryptContext, Buffer^, Buffer^, Res);

    if Left = Res then
      Break
    else begin
      Dec(Left, Res);
      Inc(Longint(Buffer), Res);
      { Go to next disk }
      if FOpenedSlice >= FChunkLastSlice then
        { Already on the last slice, so the file must be corrupted... }
        SourceIsCorrupted;
      OpenSlice(FOpenedSlice + 1);
    end;
  end;
end;

procedure TFileExtractor.DecompressFile(const FL: TSetupFileLocationEntry;
  const DestF: TFile; const ProgressProc: TExtractorProgressProc;
  const VerifyChecksum: Boolean);
var
  BytesLeft: Integer64;
  Context: TMD5Context;
  CallDecoder: TCallInstructionOptimizer;
  BufSize: Cardinal;
  Buf: array[0..65535] of Byte;
begin
  BytesLeft := FL.OriginalSize;

  { To avoid file system fragmentation, preallocate all of the bytes in the
    destination file }
  DestF.Seek64(BytesLeft);
  DestF.Truncate;
  DestF.Seek(0);

  MD5Init(Context);

  if foCallInstructionOptimized in FL.Flags then
    CallDecoder := TCallInstructionOptimizer.Create(False)
  else
    CallDecoder := nil;
  try
    try
      while True do begin
        BufSize := SizeOf(Buf);
        if (BytesLeft.Hi = 0) and (BytesLeft.Lo < BufSize) then
          BufSize := BytesLeft.Lo;
        if BufSize = 0 then
          Break;

        DecompressBytes(Buf, BufSize);
        if Assigned(CallDecoder) then
          CallDecoder.Code(Buf, BufSize);
        Dec64(BytesLeft, BufSize);
        MD5Update(Context, Buf, BufSize);
        DestF.WriteBuffer(Buf, BufSize);

        if Assigned(ProgressProc) then
          ProgressProc(BufSize);
      end;
    except
      on ECompressDataError do
        SourceIsCorrupted;
    end;
  finally
    CallDecoder.Free;
  end;

  if VerifyChecksum and not MD5DigestsEqual(MD5Final(Context), FL.MD5Sum) then
    SourceIsCorrupted;
end;

end.