Subversion Repositories autosfx

unit ZMCenDir19;

(*

  ZMCenDir19.pas - handles external interface to directory entries

  TZipMaster19 VCL by Chris Vleghert and Eric W. Engler

  v1.9

  Copyright (C) 2009  Russell Peters

  This library 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 2.1 of the License, or (at your option) any later version.

  This library 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 (licence.txt) for more details.

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

  License along with this library; if not, write to the Free Software

  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

  contact: problems AT delphizip DOT org

  updates: http://www.delphizip.org

  modified 2010-06-20

---------------------------------------------------------------------------*)

interface

uses

  Classes, ZipMstr19, ZMStructs19, ZMCompat19,

  ZMZipFile19, ZMIRec19, ZMCore19;

type

  TZCentralValues = (zcvDirty, zcvEmpty, zcvError, zcvBadStruct, zcvBusy);

  TZCentralStatus = set of TZCentralValues;

type

  TZMCenDir = class;

  // class to handle external directory access requests

  TZMCentralEntry = class(TZMDirEntry)

  private

    fCheck: Cardinal;

    fDir:   TZMCenDir;

    fIdx:   Cardinal;

  protected

    function Fetch(var rec: TZMIRec): Boolean;

    function GetCompressedSize: Int64; override;

    function GetCompressionMethod: Word; override;

    function GetCRC32: Cardinal; override;

    function GetDateTime: Cardinal; override;

    function GetEncoded: TZMEncodingOpts; override;

    function GetEncrypted: Boolean; override;

    function GetExtFileAttrib: Longword; override;

    function GetExtraData(Tag: Word): TZMRawBytes; override;

    function GetExtraField: TZMRawBytes; override;

    function GetExtraFieldLength: Word; override;

    function GetFileComment: TZMString; override;

    function GetFileCommentLen: Word; override;

    function GetFileName: TZMString; override;

    function GetFileNameLength: Word; override;

    function GetFlag: Word; override;

    function GetHeaderName: TZMRawBytes; override;

    function GetIntFileAttrib: Word; override;

    function GetRelOffLocalHdr: Int64; override;

    function GetStartOnDisk: Word; override;

    function GetStatusBits: Cardinal; override;

    function GetUncompressedSize: Int64; override;

    function GetVersionMadeBy: Word; override;

    function GetVersionNeeded: Word; override;

    property Check: Cardinal Read fCheck Write fCheck;

    property Idx: Cardinal Read fIdx Write fIdx;

  public

    constructor Create(Dir: TZMCenDir; idx: Integer; Check: Cardinal);

  end;

  TZMCenDir = class

  private

    fCount:         Integer;

    fCurrent:       TZMZipFile;

    fDirOnlyCount:  Integer;

    fEntries:       TList;

    fIgnoreDirOnly: Boolean;

    fLoadNo:        Integer;

    fStatus:        TZCentralStatus;

    fVerbose:       Boolean;

    fWorker:        TZMCore;

    procedure ClearEntries; //virtual;

    function GetCurrent: TZMZipFile;

    function GetEOCOffset: Int64;

    function GetMultiDisk: Boolean;

    function GetSFXOffset: Cardinal;

    function GetSOCOffset: Int64;

    function GetTotalDisks: Integer;

    function GetZipComment: Ansistring;

    function GetZipFileSize: Int64;

    procedure SetCurrent(const Value: TZMZipFile);

    procedure SetIgnoreDirOnly(Value: Boolean);

    procedure SetStatus(const Value: TZCentralStatus);

    procedure SetZipComment(const Value: Ansistring);

  protected

    function AddRecord(idx: Integer): Boolean;

    function GetDirEntry(Idx: Integer): TZMCentralEntry;

    procedure Invalidate;

    function Map: Integer;

    procedure SetCapacity(MaxEntries: Integer);

    property Worker: TZMCore Read fWorker;

  public

    constructor Create(Core: TZMCore);

    destructor Destroy; override;

    procedure Clear;

    // returns pointer to internal record

    function Entry(chk, idx: Cardinal): TZMIRec;

    function Find(const fspec: TZMString; var idx: Integer): TZMCentralEntry;

    function IndexOf(const FName: TZMString): Integer;

    function ReleaseZip: TZMZipFile;

    procedure ZipChange(Sender: TObject; idx: Integer; chng: TZCChanges);

    property Count: Integer Read fCount Write fCount;

    property Current: TZMZipFile Read GetCurrent Write SetCurrent;

    // DirEntry uses 'external' filtered index

    property DirEntry[Idx: Integer]: TZMCentralEntry read GetDirEntry; default;

    property DirOnlyCount: Integer Read fDirOnlyCount Write fDirOnlyCount;

    property EOCOffset: Int64 Read GetEOCOffset;

    property IgnoreDirOnly: Boolean Read fIgnoreDirOnly Write SetIgnoreDirOnly;

    property LoadNo: Integer Read fLoadNo Write fLoadNo;

    property MultiDisk: Boolean Read GetMultiDisk;

    property SFXOffset: Cardinal Read GetSFXOffset;

    property SOCOffset: Int64 Read GetSOCOffset;

    property Status: TZCentralStatus Read fStatus Write SetStatus;

    property TotalDisks: Integer Read GetTotalDisks;

    property Verbose: Boolean Read fVerbose Write fVerbose;

    property ZipComment: Ansistring Read GetZipComment Write SetZipComment;

    property ZipFileSize: Int64 Read GetZipFileSize;

  end;

implementation

uses SysUtils, ZMMatch19;

 {

type

  TZCChanges = (zccNone, zccBegin, zccCount, zccAdd, zccEdit, zccDelete, zccEnd);

  TZCChangeEvent = procedure(Sender: TObject; idx: integer; change: TZCChanges) of object;

  }

{TZMCenDir}

constructor TZMCenDir.Create(Core: TZMCore);

begin

  inherited Create;

  fWorker := Core;

  fEntries := TList.Create;

  fCount  := 0;

  fLoadNo := 0;

  fDirOnlyCount := 0;

end;

destructor TZMCenDir.Destroy;

begin

  ClearEntries;

  FreeAndNil(fEntries);

  FreeAndNil(fCurrent);

  inherited Destroy;

end;

function TZMCenDir.AddRecord(idx: Integer): Boolean;

var

  rec: TZMIRec;

  x: TZMCentralEntry;

begin

  Result := False;

  rec := fCurrent.Items[idx];

  if IgnoreDirOnly and rec.TestStatusBit(zsbDirOnly) then

    Inc(fDirOnlyCount)

  else

  begin

    x := fEntries.Items[fCount];

    x.Idx := idx;

    x.Check := fCurrent.CheckNo;

    Inc(fCount);

    Result := True;

  end;

end;

procedure TZMCenDir.Clear;

begin

  ClearEntries;

  FreeAndNil(fCurrent);

end;

procedure TZMCenDir.ClearEntries;

var

  i: Integer;

  tmp: TObject;

begin

  fCount := 0;

  fDirOnlyCount := 0;

  for i := 0 to pred(fEntries.Count) do

  begin

    tmp := fEntries.Items[i];

    if tmp <> nil then

    begin

      fEntries.Items[i] := nil;

      tmp.Free;

    end;

  end;

  fEntries.Clear;

end;

// return a pointer to an internal Entry

function TZMCenDir.Entry(chk, idx: Cardinal): TZMIRec;

begin

  if assigned(Current) then

    Result := fCurrent.Entry(chk, idx)

  else

    Result := nil;

end;

(*? TZMCentralDir.Find

 Find specified external filespec after idx (<0 - from beginning)

 returns pointer to Directory entry (nil - not found)

 sets idx to index of found entry (-1 not found)

*)

function TZMCenDir.Find(const fspec: TZMString; var idx: Integer): TZMCentralEntry;

var

  c: Integer;

begin

  if idx < 0 then

    idx := -1;

  c := pred(Count);

  while idx < c do

  begin

    Inc(idx);

    Result := DirEntry[idx];

    if Worker.FNMatch(fspec, Result.FileName) then

      exit;

  end;

  idx := -1;

  Result := nil;

end;

function TZMCenDir.GetCurrent: TZMZipFile;

begin

  if assigned(fCurrent) then

  begin

    if (fCurrent.info and zfi_Invalid) <> 0 then

      Current := TZMZipFile.Create(Worker); // force reload

  end

  else

    Current := TZMZipFile.Create(Worker);

  Result := fCurrent;

end;

function TZMCenDir.GetDirEntry(Idx: Integer): TZMCentralEntry;

begin

  if (Idx >= 0) and (Idx < Count) then

    Result := TZMCentralEntry(fEntries.Items[Idx])

  else

    Result := nil;

end;

function TZMCenDir.GetEOCOffset: Int64;

begin

  if assigned(Current) then

    Result := fCurrent.EOCOffset

  else

    Result := 0;

end;

function TZMCenDir.GetMultiDisk: Boolean;

begin

  if assigned(Current) then

    Result := fCurrent.MultiDisk

  else

    Result := False;

end;

function TZMCenDir.GetSFXOffset: Cardinal;

begin

  if assigned(Current) then

    Result := fCurrent.SFXOfs

  else

    Result := 0;

end;

function TZMCenDir.GetSOCOffset: Int64;

begin

  if assigned(Current) then

    Result := fCurrent.CentralOffset

  else

    Result := 0;

end;

function TZMCenDir.GetTotalDisks: Integer;

begin

  Result := 0;

  if assigned(Current) then

    Result := Current.TotalDisks;

end;

function TZMCenDir.GetZipComment: Ansistring;

begin

  if assigned(Current) then

    Result := fCurrent.ZipComment

  else

    Result := '';

end;

function TZMCenDir.GetZipFileSize: Int64;

begin

  Result := 0;

  if assigned(Current) then

    Result := Current.File_Size;

end;

(*? TZMCentralDir.IndexOf

 Find specified external filespec

  returns index of Directory entry (-1 - not found)

 Only checks unfiltered entries

*)

function TZMCenDir.IndexOf(const FName: TZMString): Integer;

begin

  for Result := 0 to pred(Count) do

    if Worker.FNMatch(FName, DirEntry[Result].FileName) then

      exit;

  Result := -1;

end;

procedure TZMCenDir.Invalidate;

var

  i: Integer;

  x: TZMCentralEntry;

begin

  fLoadNo := Worker.NextCheckNo;

  for i := 0 to fEntries.Count - 1 do

  begin

    x := fEntries.Items[i];

    x.Idx := i;

    x.Check := fLoadNo;

  end;

  fCount := 0;

end;

function TZMCenDir.Map: Integer;

var

  i:  Integer;

  x:  TZMCentralEntry;

  zc: Integer;

begin

  fDirOnlyCount := 0;

  if assigned(fCurrent) then

    zc := Current.Count

  else

    zc := 0;

  SetCapacity(zc);

  fCount := 0;

  if IgnoreDirOnly then

  begin

    for i := 0 to pred(zc) do

      AddRecord(i);

  end

  else

  begin

    for i := 0 to pred(zc) do

    begin

      x := fEntries.Items[i];

      x.Idx := i;

      x.Check := fLoadNo;

    end;

    fCount := zc;

  end;

  Result := 0;

end;

function TZMCenDir.ReleaseZip: TZMZipFile;

begin

  Result := fCurrent;

  fCurrent := nil;

  Worker.OnDirUpdate;

end;

procedure TZMCenDir.SetCapacity(MaxEntries: Integer);

var

  i: Integer;

begin

  if MaxEntries > fEntries.Count then

  begin

    fEntries.Capacity := MaxEntries;

    // populate the list

    for i := fEntries.Count to MaxEntries - 1 do

      fEntries.Add(TZMCentralEntry.Create(self, i, fLoadNo));

  end;

  Invalidate;

end;

procedure TZMCenDir.SetCurrent(const Value: TZMZipFile);

var

  cnt: Integer;

  i: Integer;

begin

  if fCurrent <> Value then

  begin

    Invalidate;       // don't free old - just mark useless

    FreeAndNil(fCurrent);

    fCurrent := Value;

    if assigned(Value) then

    begin

      fCurrent.OnChange := ZipChange;

      fLoadNo := fCurrent.CheckNo;

      cnt := fCurrent.Count;

      if cnt > 0 then

      begin

        // load entries

        SetCapacity(cnt);  // will set remap

        fCount := 0;

        for i := 0 to cnt - 1 do

          if AddRecord(i) then

            Worker.OnNewName(pred(fCount));

      end;

    end;

    Worker.OnDirUpdate;

  end;

end;

procedure TZMCenDir.SetIgnoreDirOnly(Value: Boolean);

begin

  if Value <> IgnoreDirOnly then

  begin

    fIgnoreDirOnly := Value;

    Map;

  end;

end;

procedure TZMCenDir.SetStatus(const Value: TZCentralStatus);

begin

  fStatus := Value;

end;

procedure TZMCenDir.SetZipComment(const Value: Ansistring);

begin

  //

end;

procedure TZMCenDir.ZipChange(Sender: TObject; idx: Integer; chng: TZCChanges);

begin

  case chng of

    //    zccNone: ;

    zccBegin:

      ClearEntries;

    zccCount:

      SetCapacity(idx);

    zccAdd:

      if AddRecord(idx) then

        Worker.OnNewName(pred(fCount));

//    zccEdit: ;

//    zccDelete: ;

    zccEnd:

      Worker.OnDirUpdate;

    zccCheckNo: // CheckNo changed because entries changed

      Invalidate;

  end;

end;

{ TZMCentralEntry }

constructor TZMCentralEntry.Create(Dir: TZMCenDir; idx: Integer; Check: Cardinal);

begin

  inherited Create;

  fDir := Dir;

  fIdx := idx;

  fCheck := Check;

end;

// return pointer to internal data

function TZMCentralEntry.Fetch(var rec: TZMIRec): Boolean;

begin

  Result := False;

  if assigned(fDir) then

  begin

    rec := fDir.Entry(Check, Idx);

    Result := assigned(rec);

  end;

end;

function TZMCentralEntry.GetCompressedSize: Int64;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.CompressedSize;

end;

function TZMCentralEntry.GetCompressionMethod: Word;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.ComprMethod;

end;

function TZMCentralEntry.GetCRC32: Cardinal;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.CRC32;

end;

function TZMCentralEntry.GetDateTime: Cardinal;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.ModifDateTime;

end;

function TZMCentralEntry.GetEncoded: TZMEncodingOpts;

var

  r: TZMIRec;

begin

  Result := zeoOEM;

  if Fetch(r) then

    Result := r.IsEncoded;

end;

function TZMCentralEntry.GetEncrypted: Boolean;

var

  r: TZMIRec;

begin

  Result := False;

  if Fetch(r) then

    Result := r.Encrypted;

end;

function TZMCentralEntry.GetExtFileAttrib: Longword;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.ExtFileAttrib;

end;

function TZMCentralEntry.GetExtraData(Tag: Word): TZMRawBytes;

var

  r: TZMIRec;

begin

  Result := '';

  if Fetch(r) then

    Result := r.ExtraData[Tag];

end;

function TZMCentralEntry.GetExtraField: TZMRawBytes;

var

  r: TZMIRec;

begin

  Result := '';

  if Fetch(r) then

    Result := r.ExtraField;

end;

function TZMCentralEntry.GetExtraFieldLength: Word;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.ExtraFieldLength;

end;

function TZMCentralEntry.GetFileComment: TZMString;

var

  r: TZMIRec;

begin

  Result := '';

  if Fetch(r) then

    Result := r.FileComment;

end;

function TZMCentralEntry.GetFileCommentLen: Word;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.FileCommentLen;

end;

function TZMCentralEntry.GetFileName: TZMString;

var

  r: TZMIRec;

begin

  Result := '';

  if Fetch(r) then

    Result := r.FileName;

end;

function TZMCentralEntry.GetFileNameLength: Word;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.FileNameLength;

end;

function TZMCentralEntry.GetFlag: Word;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.Flag;

end;

function TZMCentralEntry.GetHeaderName: TZMRawBytes;

var

  r: TZMIRec;

begin

  Result := '';

  if Fetch(r) then

    Result := r.HeaderName;

end;

function TZMCentralEntry.GetIntFileAttrib: Word;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.IntFileAttrib;

end;

function TZMCentralEntry.GetRelOffLocalHdr: Int64;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.RelOffLocal;

end;

function TZMCentralEntry.GetStartOnDisk: Word;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.DiskStart;

end;

function TZMCentralEntry.GetStatusBits: Cardinal;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.StatusBits;

end;

function TZMCentralEntry.GetUncompressedSize: Int64;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.UncompressedSize;

end;

function TZMCentralEntry.GetVersionMadeBy: Word;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.VersionMadeBy;

end;

function TZMCentralEntry.GetVersionNeeded: Word;

var

  r: TZMIRec;

begin

  Result := 0;

  if Fetch(r) then

    Result := r.VersionNeeded;

end;

end.