Subversion Repositories autosfx

Unit ZipFix;

//---------------------------------------------------------------------

// Component:        TZipFix

// Author:           Angus Johnson

// Version:          1.1

// Delphi:           Versions 3 - 5.

// C++ Builder:      Versions 1, 3 and 4 (5 Untested).

// Date:             30 May 2000

// Copyright:        © 1999-2000 Angus Johnson

// Email:            ajohnson@rpi.net.au

// Distribution:     Freeware.

//

// Component to repair a Zip archive when the archive's

// directory structure has been damaged.

// It will *not* fix damaged zipped data nor will it

// solve 'forgotten' passwords.

// If some zipped data has been damaged, the remaining undamaged

// data can be rebuilt into a new archive.

// Multi-disk archives can also be repaired if the disks are first

// concatenated (maintaining order) into a single InStream.

// Can also extract a zip archive which has been embedded

// in another file (eg a self-extracting zip archive).

//

// 21-06-2000 Added ZipFix.res RCV

//---------------------------------------------------------------------

(*

 Copyright (C) 2009, 2010  by Russell J. Peters, Roger Aelbrecht,

      Eric W. Engler and Chris Vleghert.

   This file is part of TZipMaster Version 1.9.

    TZipMaster is free software: you can redistribute it and/or modify

    it under the terms of the GNU Lesser General Public License as published by

    the Free Software Foundation, either version 3 of the License, or

    (at your option) any later version.

    TZipMaster is distributed in the hope that it will be useful,

    but WITHOUT ANY WARRANTY; without even the implied warranty of

    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public License

    along with TZipMaster.  If not, see <http://www.gnu.org/licenses/>.

    contact: problems@delphizip.org (include ZipMaster in the subject).

    updates: http://www.delphizip.org

    DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip

*)

// Acknowledgements for suggestions can be found within code.

{$IfDef VER110}

   {$ObjExportAll On}

   {$DEFINE CBUILDER3}

{$EndIf}

{$IfDef VER125}

   {$ObjExportAll On}

   {$DEFINE CBUILDER4}

{$EndIf}

{$IfDef VER130}

 {$IfDef BCB}

   {$ObjExportAll On}

   {$DEFINE CBUILDER5}

 {$EndIf}

{$EndIf}

Interface

uses

  Windows, Messages, SysUtils, Classes;

type

  TOnFileFoundEvent = procedure (Sender: TObject;

    const Filename: string; FileInfoIsOK: boolean) of object;

  TZipFix = class(TComponent)

  private

    fBuffer: pchar;

    fBufferSize: integer;

    fFileList: TList;

    fOutStream: TStream;

    fOnFileFound: TOnFileFoundEvent;

    fJumpValue: array[#0..#255] of integer; //used to find Local Header records

    fJumpValue2: array[#0..#255] of integer; //used to find DataDescriptor records

    procedure InitializeArrays;

    procedure GetLocalHeaderInfo;

    procedure DoZipFix;

  public

    procedure Execute(InStream: TMemoryStream; OutStream: TStream); {$IFDEF VER130} overload;

    procedure Execute(const InFilename, OutFilename: string); overload; {$ENDIF}

  published

    //30 May 2000 - OnFileFound event moved to published

    property OnFileFound: TOnFileFoundEvent read fOnFileFound write fOnFileFound;

  end;

  procedure Register;

Implementation

{$R ZipFix.Res}

type

//---------------------------------------------------------------------

//Record structures used in Zip files...

//---------------------------------------------------------------------

  TLocalHeader = packed record

    HeaderSig          : Cardinal; // $04034b50 (4)

    VersionNeed        : Word;

    Flag               : Word;

    ComprMethod        : Word;

    FileTime           : Word;

    FileDate           : Word;

    CRC32              : Cardinal;

    ComprSize          : Cardinal;

    UnComprSize        : Cardinal;

    FileNameLen        : Word;

    ExtraLen           : Word;

  end;

  TDataDescriptor = packed record  //Exists only if bit 3 of LocalHeader.Flag is set.

    DescriptorSig      : Cardinal; //field not defined in PKWare's docs but used by WinZip

    CRC32              : Cardinal;

    ComprSize          : Cardinal;

    UnComprSize        : Cardinal;

  end;

(*

  CentralDirectory =

    array [1..N] of TCentralFileHeader;

    TEndOfCentralHeader;

*)

  //array of TCentralFileHeaders constitute the Central Header directory...

  TCentralFileHeader = packed record  // fixed part size = 42 bytes

    HeaderSig          : Cardinal; // $02014b50 { 'PK'#1#2 } (4)

    MadeByVersion      : Byte;    //(1)

    HostVersionNo      : Byte;    //(1)

    Version            : Word;    //(2) version needed to extract(2)

    Flag               : Word;    //(2)

    CompressionMethod  : Word;    //(2)

    FileDate           : Integer; //modification date & time (4)

    CRC32              : Integer; //(4)

    CompressedSize     : Integer; //(4)

    UncompressedSize   : Integer; //(4)

    FileNameLength     : Word;    //(2)

    ExtraFieldLength   : Word;    //(2)

    FileCommentLen     : Word;    //(2)

    StartOnDisk        : Word;    //disk # on which file starts (2)

    IntFileAttrib      : Word;    //internal file attributes ie: Text/Binary(2)

    ExtFileAttrib      : Cardinal;//external file attributes(4)

    RelOffLocalHdr     : Cardinal;//relative offset of local file header(4)

    //FileName         variable size

    //ExtraField       variable size

    //FileComment      variable size

  end;

  TEndOfCentralHeader = packed record  //Fixed part size = 22 bytes

    HeaderSig          : Cardinal; //$06054B50 (4)

    ThisDiskNo         : Word;     //This disk's number (zero based) (2)

    CentralDiskNo      : Word;     //Disk number on which central dir starts (2)

    ThisDiskEntries    : Word;     //Number of central dir entries on this disk (2)

    TotalEntries       : Word;     //Total entries in central dir (2)

    CentralSize        : Cardinal; //Size of central directory (4)

    CentralOffset      : Cardinal; //offset of central dir on CentralDiskNo (4)

    ZipCommentLen      : Word;     //(2)

    // ZipComment       variable size

  end;

//---------------------------------------------------------------------

//Record structure used internally by the TZipFix 

//---------------------------------------------------------------------

  pFileInfo = ^TFileInfo;

  TFileInfo = packed record //first 42 bytes identical to the Central Header File record

    MadeByVersion      : Byte;    //(1)

    HostVersionNo      : Byte;    //(1)

    Version            : Word;    //(2)

    Flag               : Word;    //(2)

    CompressionMethod  : Word;    //(2)

    FileDate           : Integer; //modification datetime (4)

    CRC32              : Integer; //(4)

    CompressedSize     : Integer; //(4)

    UncompressedSize   : Integer; //(4)

    FileNameLength     : Word;    //(2)

    ExtraFieldLength   : Word;    //(2)

    FileCommentLen     : Word;    //(2)

    StartOnDisk        : Word;    //disk # on which file starts (2)

    IntFileAttrib      : Word;    //internal file attributes ie: Text/Binary(2)

    ExtFileAttrib      : Cardinal;//external file attributes(4)

    RelOffLocalHdr     : Cardinal;//relative offset of local file header(4)

    //42 bytes above plus...

    Filename: string;

    //ExtraField: string;

    //Comment: string;

  end;

const

  MULTIPLE_DISK_SIG      = $08074b50; // 'PK'#7#8

  DATA_DESCRIPT_SIG      = MULTIPLE_DISK_SIG; //!!

  LOCAL_HEADERSIG        = $04034b50; // 'PK'#3#4

  CENTRAL_HEADERSIG      = $02014b50; // 'PK'#1#2

  EOC_HEADERSIG          = $06054b50; // 'PK'#5#6

  MAX_FILENAME_LEN       = 80;

procedure Register;

begin

  RegisterComponents('Samples', [TZipFix]);

end;

//------------------------------------------------------------------------------

// TZipFix Methods

//------------------------------------------------------------------------------

//fill fFileList with records containing info from the Local Headers

procedure TZipFix.GetLocalHeaderInfo;

var

  fileInfo: pFileInfo;

  CurrentPos: integer;

  i, HeaderStartPos: integer;

  DataStart,DataEnd: integer;

label

  LocalHeaderError;

  //-------------------------------

  //positions CurrentPos at start of LocalHeaderSig...

  function FindNextHeader: boolean;

  var

    n,HeaderSig: integer;

  begin

    result := false;

    while CurrentPos < fBufferSize do

    begin

      n := fJumpValue[fBuffer[CurrentPos]];

      if n = 0 then //looking for 'PK'#3#4, a #4 found at least...

      begin

        dec(CurrentPos,3);

        move(fBuffer[CurrentPos],HeaderSig,4);

        if (HeaderSig = LOCAL_HEADERSIG) and

          (CurrentPos + Sizeof(TLocalHeader) < fBufferSize) then

        begin

          result := true;

          exit;

        end

        else

          inc(CurrentPos,7);

      end

      else

        inc(CurrentPos,n);

    end;

  end;

  //-------------------------------

  //positions fCurrentPos at start of DataDescriptorSig...

  function FindDataDescriptor: boolean;

  var

    n,HeaderSig: integer;

  begin

    result := false;

    while CurrentPos < fBufferSize do

    begin

      n := fJumpValue2[fBuffer[CurrentPos]];

      if n = 0 then //looking for 'PK'#7#8, a #8 found at least...

      begin

        dec(CurrentPos,3);

        move(fBuffer[CurrentPos],HeaderSig,4);

        if (HeaderSig = DATA_DESCRIPT_SIG) and

          (CurrentPos + Sizeof(TDataDescriptor) < fBufferSize) then

        begin

          result := true;

          exit;

        end

        else

          inc(CurrentPos,7);

      end

      else

        inc(CurrentPos,n);

    end;

  end;

//-------------------------------

begin

  //prepare for boyer-moore-horspool searches...

  //this will be more than 3 times faster than a brute-force search

  if fJumpValue[#0] = 0 then InitializeArrays;

  CurrentPos := 3;

  //get all local header info...

  while FindNextHeader do

  begin

    HeaderStartPos := CurrentPos;

    new(fileInfo);

    with fileInfo^ do

    begin

      //ignore the following values, so zero initialize them.

      //we could try and match them to the dud central directory records

      //but i'm not sure it's worth the trouble.

      MadeByVersion := $0;

      HostVersionNo := $0;

      IntFileAttrib := $0;

      ExtFileAttrib := $0;

      StartOnDisk   := $0;

      FileCommentLen := $0;

      //copy - Version, Flag, CompressionMethod, FileDate, CRC32,

      //  CompressedSize, UncompressedSize, FileNameLength, ExtraFieldLength

      move(fBuffer[HeaderStartPos+4],Version,Sizeof(TLocalHeader)-4);

      //save current Local Header offset which will be updated later...

      RelOffLocalHdr := HeaderStartPos;

      if (fileInfo.FileNameLength < 1) or

          (FileNameLength > MAX_FILENAME_LEN) then

        goto LocalHeaderError;

      inc(CurrentPos, Sizeof(TLocalHeader));

      setlength(Filename,FileNameLength);

      move(fBuffer[CurrentPos],Filename[1],FileNameLength);

      //and do an extra check to make sure the name is valid...

      for i := 1 to FileNameLength do

        if Filename[i] < #32 then

        begin

          Filename := '';

          goto LocalHeaderError;

        end;

      inc(CurrentPos, FileNameLength + ExtraFieldLength);

      if (Flag and $8) = $8 then

      begin

        //a bit of a bummer but a TDataDescriptor record is used

        //so we don't yet know the size of the data block.

        //it's a little bit slower but it still works...

        DataStart:= CurrentPos;

        if not FindDataDescriptor then goto LocalHeaderError;

        DataEnd:= CurrentPos;

        //now update: CRC32, CompressedSize, UncompressedSize

        move(fBuffer[CurrentPos+4],CRC32,12);

        inc(CurrentPos, sizeof(TDataDescriptor)); //get ready for next LocalHeader

        if (CompressedSize <> DataEnd - DataStart) then

          goto LocalHeaderError;

      end

      else

        inc(CurrentPos,CompressedSize);

    end; //with fileInfo^ 

    //check for corrupted CompressedSize - suggested by Ramon Speets

    if (CurrentPos > fBufferSize) or

       (fileInfo.CompressedSize > fileInfo.UncompressedSize) then

      goto LocalHeaderError;

    fFileList.add(fileInfo);

    if assigned(fOnFileFound) then fOnFileFound(self,fileInfo.filename,true);

    continue; //avoid LocalHeaderError below

LocalHeaderError:

    if assigned(fOnFileFound) then fOnFileFound(self,fileInfo.filename,false);

    dispose(fileInfo);

    CurrentPos := HeaderStartPos + 4; //ie: skip over this dud record

  end; //while FindNextHeader

end;

//------------------------------------------------------------------------------

procedure TZipFix.InitializeArrays;

var

  i: char;

begin

  for i := #0 to #255 do fJumpValue[i] := 4;

  fJumpValue['P'] := 3;

  fJumpValue['K'] := 2;

  fJumpValue[#3] := 1;

  fJumpValue[#4] := 0;

  for i := #0 to #255 do fJumpValue2[i] := 4;

  fJumpValue2['P'] := 3;

  fJumpValue2['K'] := 2;

  fJumpValue2[#7] := 1;

  fJumpValue2[#8] := 0;

end;

//---------------------------------------------------------------------

procedure TZipFix.DoZipFix;

var

  i,CurrentPos, StartOfCentral: integer;

  Eoc: TEndOfCentralHeader;

  HeaderSig: Cardinal;

begin

  //fOutStream.position := 0; //not essential...

                              //could theoretically append an SFX stub.

  GetLocalHeaderInfo;

  if fFileList.count = 0 then exit; //no files can be restored :(

  //write all the local headers and data...

  for i := 0 to fFileList.count-1 do

    with pFileInfo(fFileList[i])^ do

    begin

      CurrentPos := RelOffLocalHdr;

      RelOffLocalHdr := fOutStream.Position; //now update RelOffLocalHdr

      fOutStream.write(fbuffer[CurrentPos],

        sizeof(TLocalHeader)+FileNameLength+ExtraFieldLength+CompressedSize);

      //i'm almost certain the Central Directory ExtraField is different

      //from the local ExtraField so zero this out for the Central Directory.

      ExtraFieldLength := 0;

    end;

  StartOfCentral := fOutStream.position;

  //recreate the central directory...

  HeaderSig := CENTRAL_HEADERSIG;

  for i := 0 to fFileList.count-1 do

    with pFileInfo(fFileList[i])^ do

    begin

      fOutStream.write(HeaderSig,sizeof(HeaderSig));

      //copy first 42 bytes starting at MadeByVersion...

      fOutStream.write(MadeByVersion,42);

      fOutStream.write(Filename[1],length(Filename));

    end;

  //finally write the EndOfCentral header...

  Eoc.HeaderSig := EOC_HEADERSIG;

  Eoc.ThisDiskNo := 0;

  Eoc.CentralDiskNo := 0;

  Eoc.ThisDiskEntries := fFileList.count;

  Eoc.TotalEntries := Eoc.ThisDiskEntries;

  Eoc.CentralSize := fOutStream.position - StartOfCentral;

  Eoc.CentralOffset := StartOfCentral;

  Eoc.ZipCommentLen := 0;

  fOutStream.write(Eoc,sizeof(Eoc));

end;

//---------------------------------------------------------------------

procedure TZipFix.Execute(InStream: TMemoryStream; OutStream: TStream);

var

  i: integer;

begin

  if (InStream = nil) or (OutStream = nil) then

    raise Exception.create('No input or no output stream has been defined');

  fBuffer := InStream.memory;

  fBufferSize := InStream.size;

  fOutStream := OutStream;

  fFileList:= TList.create;

  try

    DoZipFix; //do it here!!

  finally

    //cleanup...

    for i := 0 to fFileList.count -1 do

      dispose(pFileInfo(fFileList[i]));

    fFileList.free;

  end;

end;

//------------------------------------------------------------------------------

{$IFDEF VER130}

procedure TZipFix.Execute(const InFilename, OutFilename: string);

var

  InStream: TMemoryStream;

  OutStream: TFileStream;

begin

  OutStream:= TFileStream.create(OutFilename,fmCreate);

  InStream := TMemoryStream.create;

  try

    Instream.LoadFromFile(InFilename);

    Execute(InStream, OutStream);

  finally

    InStream.free;

    OutStream.free;

  end;

end;

//------------------------------------------------------------------------------

{$ENDIF}

End.