Chip 2002 March/Chip_2002-03_cd1.bin/zkuste/delphi/kompon/d5/cak/CAKINST.ZIP/ZipRepair.pas

Pascal/Delphi Source File | 2001-12-12 | 12.0 KB | 358 lines

unit ZipRepair;

//---------------------------------------------------------------------
// Module:        ZipRepair
// Author:        Angus Johnson
// Version:       0.1 beta
// Date:          15 October 1999
// Copyright:     ⌐ 1999 Angus Johnson
// Email:         [e-mail]
// Distribution:  Freeware, but please acknowledge authorship.
// (Designed to complement the excellent delphi freeware Zip utilities
// started by Eric Engler and continued by Chris Vleghert and found at -
// http://www.geocities.com/SiliconValley/Orchard/8607/)
//---------------------------------------------------------------------

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

//Completely (and rapidly) rebuilds a Zip file where the Central Directory
//and/or the End Of Central records have been corrupted. It will *not* fix
//corrupted data nor will it solve 'forgotten' passwords.
//note 1: Multi disk archives are not supported.
function RepairZip(const SourceFile, TargetFile: string): boolean;

implementation

type

  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;

  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;

(*
Central directory structure:
  [file header] . . .  end of central dir record
*)

  //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;

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

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

function min(a, b: integer): integer;
begin
  if a < b then Result := a
  else
    Result := b;
end;

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

var
  JumpValue:  array[#0..#255] of integer; //used to find Local Header records
  JumpValue2: array[#0..#255] of integer; //used to find DataDescriptor records

procedure InitializeJumpValueArray; //bmh search for TLocalHeaders
var
  i: char;
begin
  for i := #0 to #255 do JumpValue[i] := 4;
  JumpValue['P'] := 3;
  JumpValue['K'] := 2;
  JumpValue[#3]  := 1;
  JumpValue[#4]  := 0;
end;

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

procedure InitializeJumpValue2Array; //bmh search for TDataDescriptors
var
  i: char;
begin
  for i := #0 to #255 do JumpValue2[i] := 4;
  JumpValue2['P'] := 3;
  JumpValue2['K'] := 2;
  JumpValue2[#7]  := 1;
  JumpValue2[#8]  := 0;
end;

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

procedure FindAllLocalHeaders(FileList: TList; Stream: TMemoryStream);
var
  fileInfo: pFileInfo;
  i, BuffPos, HeaderStartPos: integer;
  buffer:   PChar;
label
  LocalHeaderError;

  //-------------------------------
  function FindNextHeader: boolean; //moves BuffPos to start of next LocalHeader
  var
    n, HeaderSig: cardinal;
  begin
    Result := False;
    while BuffPos < Stream.Size do
    begin
      n := JumpValue[Buffer[BuffPos]];
      if n = 0 then //a #4 found at least...
      begin
        dec(BuffPos, 3);
        move(Buffer[BuffPos], HeaderSig, 4);
        if (HeaderSig = LOCAL_HEADERSIG) and
          (BuffPos + Sizeof(TLocalHeader) < Stream.Size) then
        begin
          Result := True;
          exit;
        end
        else
          inc(BuffPos, 7);
      end
      else
        inc(BuffPos, n);
    end;
  end;

  //-------------------------------
  function FindDataDescriptor: boolean; //moves BuffPos to start of DataDescriptor
  var
    n, HeaderSig: cardinal;
  begin
    Result := False;
    while BuffPos < Stream.Size do
    begin
      n := JumpValue2[Buffer[BuffPos]];
      if n = 0 then //a #8 found at least...
      begin
        dec(BuffPos, 3);
        move(Buffer[BuffPos], HeaderSig, 4);
        if (HeaderSig = DATA_DESCRIPT_SIG) and
          (BuffPos + Sizeof(TDataDescriptor) < Stream.Size) then
        begin
          Result := True;
          exit;
        end
        else
          inc(BuffPos, 7);
      end
      else
        inc(BuffPos, n);
    end;
  end;

//-------------------------------
begin
  buffer  := Stream.Memory;
  BuffPos := 3;
  //prepare for boyer-moore-horspool searches...
  if JumpValue[#0] = 0 then InitializeJumpValueArray;
  if JumpValue2[#0] = 0 then InitializeJumpValue2Array;

  //get all local header info...
  while FindNextHeader do
  begin
    HeaderStartPos := BuffPos;
    new(fileInfo);
    with fileInfo^ do
    begin
      //ignore these 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(Buffer[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_PATH) then
        goto LocalHeaderError;
      inc(BuffPos, Sizeof(TLocalHeader));
      setlength(Filename, FileNameLength);
      move(buffer[BuffPos], 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 goto LocalHeaderError;
      inc(BuffPos, FileNameLength);
      inc(BuffPos, ExtraFieldLength);
      if (Flag and $8) = $8 then
      begin
        //a bit of a bummer but a TDataDescriptor record is used
        //so we don't know the size of the data block.
        //it's a little bit slower but it still works...
        if not FindDataDescriptor then goto LocalHeaderError;
        //now update: CRC32, CompressedSize, UncompressedSize
        move(buffer[BuffPos + 4], CRC32, 12);
        inc(BuffPos, sizeof(TDataDescriptor)); //get ready for next LocalHeader
      end
      else
        inc(BuffPos, CompressedSize); //get ready for next LocalHeader
    end;
    FileList.add(fileInfo);
    continue; //avoid LocalHeaderError below

    LocalHeaderError:
      dispose(fileInfo);
    BuffPos := HeaderStartPos + 4; //ie: skip over this dud record
  end;
end;

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

function RepairZip(const SourceFile, TargetFile: string): boolean;
var
  i, StartOfCentral: integer;
  SrcStream: TMemoryStream;
  TrgStream: TFileStream;
  FileList:  TList;
  Eoc:       TEndOfCentralHeader;
  HeaderSig: cardinal;
begin
  FileList      := TList.Create;
  SrcStream     := TMemoryStream.Create;
  screen.cursor := crHourglass;
  try
    SrcStream.LoadFromFile(SourceFile);
    FindAllLocalHeaders(FileList, SrcStream);
    //ok we have enough information now to make a new Zip file
    TrgStream := TFileStream.Create(TargetFile, fmCreate);
    try
      //write all the local headers and data...
      for i := 0 to FileList.Count - 1 do
        with pFileInfo(FileList[i])^ do
        begin
          SrcStream.seek(RelOffLocalHdr, soFromBeginning); //use the old RelOffLocalHdr
          RelOffLocalHdr   := TrgStream.Position; //now update RelOffLocalHdr
          TrgStream.copyfrom(SrcStream,
            sizeof(TLocalHeader) + FileNameLength + ExtraFieldLength + CompressedSize);
          //i'm almost certain the Central Directory ExtraField is different
          //from the local ExtraField so zero this out.
          ExtraFieldLength := 0;
        end;
      StartOfCentral := TrgStream.position;
      //recreate the central directory...
      HeaderSig      := CENTRAL_HEADERSIG;
      for i := 0 to FileList.Count - 1 do
        with pFileInfo(FileList[i])^ do
        begin
          TrgStream.Write(HeaderSig, sizeof(HeaderSig));
          TrgStream.Write(MadeByVersion, 42); //copy first 42 bytes
          TrgStream.Write(Filename[1], length(Filename));
        end;
      //finally write the EndOfCentral header...
      Eoc.HeaderSig       := EOC_HEADERSIG;
      Eoc.ThisDiskNo      := 0;
      Eoc.CentralDiskNo   := 0;
      Eoc.ThisDiskEntries := FileList.Count;
      Eoc.TotalEntries    := Eoc.ThisDiskEntries;
      Eoc.CentralSize     := TrgStream.position - StartOfCentral;
      Eoc.CentralOffset   := StartOfCentral;
      Eoc.ZipCommentLen   := 0;
      TrgStream.Write(Eoc, sizeof(Eoc));
      Result := True;
    finally
      TrgStream.Free;
    end;
  finally
    screen.cursor := crDefault;
    SrcStream.Free;
    for i := 0 to FileList.Count - 1 do dispose(pFileInfo(FileList[i]));
    FileList.Free;
  end;
end;

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


end.