kpzipobj.pas

一个delphi中压缩的组件VCLZip

procedure TEndCentral.Clear;
begin
  with Fecrec do
    begin
      ID := ENDSIG;
      this_disk := 0;
      start_central_disk := 0;
      num_entries_this_disk := 0;
      num_entries := 0;
      size_central := 0;
      offset_central := 0;
      zip_comment_length := 0;
    end;
  if (FZipComment <> nil) then
    StrDispose(FZipComment);
  FZipComment := nil;
  FZipCommentPos := 0;
  FModified := False;
end;

procedure TEndCentral.SaveToStream(S: TStream);
begin
  S.Write(Fecrec, SizeOf(Fecrec));
  if (Fecrec.zip_comment_length > 0) and (FZipComment <> nil) then
    S.Write(FZipComment^, StrLen(FZipComment));
end;

function TEndCentral.ReadFromStream(S: TStream): Boolean;
var
  tmpBuff: PChar;
  tmpBuffsize: LongInt;
  peoc: end_of_centralPtr;
  j: LongInt;
  AmtRead: LongInt;
const
{$IFDEF WIN32} { 5/23/99 2.18+ }
  TBUFFSIZE = 65535 + SizeOf(end_of_central);
{$ELSE}
  TBUFFSIZE = $FFF8;
{$ENDIF}
begin
  Result := False;
  if S.Size < sizeof(end_of_central) then
    begin
      if S.Size = 0 then { 7/31/99 2.18+ }
        Result := True; { handle 0 length files }
      exit; { 1/28/98 v2.00+}
    end;
  tmpBuffsize := kpmin(S.Size, TBUFFSIZE);
  S.Seek(-tmpBuffsize, soFromEnd);
  GetMem(tmpBuff, tmpBuffsize);
  try
    AmtRead := S.Read(tmpBuff^, tmpBuffsize);
    if AmtRead <> tmpBuffsize then
      exit;
    j := tmpBuffsize - (sizeof(end_of_central));
    peoc := nil;
    while (j >= 0) and (peoc = nil) do
      begin
        while (j >= 0) and (Byte(tmpBuff[j]) <> END4) do
          Dec(j);
        if (j < 0) then
          break;
        peoc := end_of_centralPtr(@tmpBuff[j]); { added typecast 5/18/98  2.13 }
        if peoc^.ID <> ENDSIG then
          begin
            Dec(j);
            peoc := nil;
          end;
      end;
    if peoc = nil then
      exit;
    with Fecrec do
      begin
        this_disk := peoc^.this_disk;
        start_central_disk := peoc^.start_central_disk;
        num_entries_this_disk := peoc^.num_entries_this_disk;
        num_entries := peoc^.num_entries;
        size_central := peoc^.size_central;
        offset_central := peoc^.offset_central;
        zip_comment_length := peoc^.zip_comment_length;
     {FZipHasComment := ecrec.zip_comment_length > 0;}
     {ZipCommentPos := S.Size -  Fecrec.zip_comment_length;}{ 06/03/00 2.21b2+ }
        ZipCommentPos := S.Size - tmpBuffsize + j + sizeof(end_of_central);
      end;
    Result := True;
  finally
    FreeMem(tmpBuff, tmpBuffsize);
  end;
end;

function TEndCentral.GetZipHasComment: Boolean;
begin
  Result := (zip_comment_length > 0);
end;

procedure TEndCentral.SetNewZipComment(NewComment: string);
begin
  if FZipComment <> nil then
    StrDispose(FZipComment);
  FZipComment := StrToPChar(NewComment);
  Fecrec.zip_comment_length := Length(NewComment);
end;

function TEndCentral.GetZipComment(S: TStream): PChar;
begin
  if Fecrec.zip_comment_length = 0 then
    Result := nil
  else
    if FZipComment <> nil then
      Result := FZipComment
    else
      with Fecrec do
        begin
          S.Seek(FZipCommentPos, soFromBeginning);
          Result := StrAlloc(zip_comment_length + 1);
          S.Read(Result^, zip_comment_length);
          Result[zip_comment_length] := #0;
        end;
end;

function TEndCentral.GetEndCentralSize: LongInt;
begin
  Result := SizeOf(end_of_central) + Fecrec.zip_comment_length;
end;

{*****************  TSortedZip Methods *******************}

constructor TSortedZip.Create(WithDuplicates: TDuplicates);
begin
  inherited Create(WithDuplicates);
  SortMode := ByNone;
end;

function TSortedZip.Compare(Key1, Key2: Pointer): Integer;
var
  K1: TZipHeaderInfo absolute Key1;
  K2: TZipHeaderInfo absolute Key2;
  tmpDateTime1, tmpDateTime2: TDateTime;
  tmpSize: LongInt;
begin
  case FSortMode of
    ByName:
      Result := CompareText(K1.directory + K1.filename, K2.directory + K2.filename);
    ByFileName:
      Result := CompareText(K1.filename, K2.filename);
    ByDirectoryName:
      Result := CompareText(K1.Directory, K2.directory);
    ByDate:
      begin
        try
          tmpDateTime1 := FileDateToDateTime(K1.last_mod_file_date_time);
        except
          tmpDateTime1 := 0;
        end;
        try
          tmpDateTime2 := FileDateToDateTime(K2.last_mod_file_date_time);
        except
          tmpDateTime2 := 0;
        end;
        if (tmpDateTime2 > tmpDateTime1) then
          Result := 1
        else
          Result := -1;
      end;
    ByCompressedSize:
      begin
        tmpSize := K2.compressed_size - K1.compressed_size;
        if (tmpSize > 0) then
          Result := 1
        else
          Result := -1;
      end;
    ByUnCompressedSize:
      begin
        tmpSize := K2.uncompressed_size - K1.uncompressed_size;
        if (tmpSize > 0) then
          Result := 1
        else
          Result := -1;
      end;
    ByRate:
      Result := CRate(K2.uncompressed_size, K2.compressed_size) -
        CRate(K1.uncompressed_size, K1.compressed_size);
    ByNone:
      begin
        Result := K1.disk_number_start - K2.disk_number_start;
        if Result = 0 then { modified 3/8/98 for 2.03 }
          begin { this fixed the duplicate object bug }
            if K1.relative_offset > K2.relative_offset then
              Result := 1
            else
              if K1.relative_offset = K2.relative_offset then
                Result := 0
              else
                Result := -1;
          end;
      end;
  else
    Result := -1;
  end;
{
 If Result = 0 then
  Result := -1;
}
end;

{$IFDEF KPDEMO}

function DRun: Boolean;
const
  A1: array[0..12] of char = 'TApplication'#0;
  A2: array[0..15] of char = 'TAlignPalette'#0;
  {A3: array[0..18] of char = 'TPropertyInspector'#0;}
  A4: array[0..11] of char = 'TAppBuilder'#0;
{$IFDEF WIN32}
{$IFDEF VER130}
     {$IFDEF ISBCB5}
     T1                    : array[0..15] of char = 'C++Builder 5'#0;
     {$ENDIF}
     {$IFDEF ISDELPHI5}
     T1                    : array[0..15] of char = 'Delphi 5'#0;
     {$ENDIF}
{$ENDIF}
{$IFDEF VER140}
     {$IFDEF ISDELPHI6}
     T1                    : array[0..15] of char = 'Delphi 6'#0;
     {$ENDIF}
     {$IFDEF ISBCB6}
     T1                    : array[0..15] of char = 'C++Builder 6'#0;
     {$ENDIF}
{$ENDIF}
{$IFDEF VER150}
  T1: array[0..15] of char = 'Delphi 7'#0;
{$ENDIF}
{$IFDEF VER120}
  T1: array[0..15] of char = 'Delphi 4'#0;
{$ENDIF}
{$IFDEF VER100}
  T1: array[0..15] of char = 'Delphi 3'#0;
{$ENDIF}
{$IFDEF VER90}
  T1: array[0..15] of char = 'Delphi 2.0'#0;
{$ENDIF}
{$IFDEF VER93}
  T1: array[0..15] of char = 'C++Builder'#0;
{$ENDIF}
{$IFDEF VER110}
  T1: array[0..15] of char = 'C++Builder'#0;
{$ENDIF}
{$IFDEF VER125}
  T1: array[0..15] of char = 'C++Builder 4'#0;
{$ENDIF}
{$ELSE}
  T1: array[0..15] of char = 'Delphi'#0;
{$ENDIF}
begin
  Result := (FindWindow(A1, T1) <> 0) and
    (FindWindow(A2, nil) <> 0) and
            {(FindWindow(A3,nil)<>0) and}
  (FindWindow(A4, nil) <> 0);
end;
{$ENDIF}

procedure setZipSignatures(csig, lsig, esig: LongInt);
begin
  if csig = 0 then
    CENTSIG := DEF_CENTSIG
  else
    CENTSIG := csig;
  if lsig = 0 then
    LOCSIG := DEF_LOCSIG
  else
    LOCSIG := lsig;
  if esig = 0 then
    ENDSIG := DEF_ENDSIG
  else
    ENDSIG := esig;
{
  DEF_CENTSIG = $02014b50;
  DEF_LOCSIG = $04034b50;
  DEF_ENDSIG = $06054b50;
}
  LOC4 := LOBYTE(LOWORD(LOCSIG)); { $50;  Last byte of LOCSIG }
  LOC3 := HIBYTE(LOWORD(LOCSIG)); { $4b;  3rd byte of LOCSIG }
  LOC2 := LOBYTE(HIWORD(LOCSIG)); { $03;  2nd byte of LOCSIG }
  LOC1 := HIBYTE(HIWORD(LOCSIG)); { $04;  1st byte of LOCSIG }
  END4 := LOBYTE(LOWORD(ENDSIG)); { $50;  Last byte of ENDSIG }
end;

(*************************************************)
initialization
(*************************************************)
  setZipSignatures(0, 0, 0);

{ $Id: kpZipObj.pas,v 1.1 2001-08-12 17:30:40-04 kp Exp kp $ }

{ $Log: kpZipObj.pas,v $
{ Revision 1.1  2001-08-12 17:30:40-04  kp
{ Initial revision
{
{ Revision 1.28  2000-12-16 16:50:07-05  kp
{ 2.21 Final Release 12/12/00
{
{ Revision 1.27  2000-06-04 15:59:56-04  kp
{ - Fixed typo in creation of LOC header values.
{ - Changed so FileZipCommentPos is based on end of record instead of end of file.
{ - Reformatted code
{
{ Revision 1.26  2000-05-21 18:44:50-04  kp
{ - Moved declaration of signature globals to here.
{ - Modified setZipSignatures to set default values when passed 0's as values.
{
{ Revision 1.25  2000-05-13 17:07:48-04  kp
{ - Added setZipSignatures procedure
{ - Added code to initialize signatures to default values in Initialization section
{
{ Revision 1.24  1999-11-09 19:41:40-05  kp
{ - Modified to correctly handle extra fields in headers
{ - Removed check for Object Inspector Window in IDE Check
{
{ Revision 1.23  1999-10-24 09:32:11-04  kp
{ - Changed ReadCentralFromStream so the stream passed in is a var parameter.
{
{ Revision 1.22  1999-10-17 12:00:50-04  kp
{ - Changed min and max to kpmin and kpmax
{
{ Revision 1.21  1999-09-16 20:07:56-04  kp
{ - Moved defines to KPDEFS.INC
{
{ Revision 1.20  1999-09-14 21:33:46-04  kp
{ - Added D5 compatibility conditionals
{
{ Revision 1.19  1999-08-25 19:04:01-04  kp
{ - Fixes for D1
{
{ Revision 1.18  1999-08-25 18:00:47-04  kp
{ - Can now open a zero length file as an empty archive.
{
{ Revision 1.17  1999-07-06 19:58:51-04  kp
{ - Added Selected to assign and initialization methods
{
{ Revision 1.16  1999-07-05 11:25:06-04  kp
{ <>
{
{ Revision 1.15  1999-06-27 13:56:10-04  kp
{ - Added the Selected property to the TZipHeaderInfo class
{
{ Revision 1.14  1999-06-06 19:56:57-04  kp
{ - Slight fix for the new sig consts
{
{ Revision 1.13  1999-06-02 10:26:29-04  kp
{ - Added constants for header signatures
{
{ Revision 1.12  1999-06-01 21:53:58-04  kp
{ - Added to the size of the buffer for looking for the end of central record for 32bit.
{
{ Revision 1.11  1999-04-24 21:16:15-04  kp
{ - Fixed small problem with IDE check in BCB4
{
{ Revision 1.10  1999-03-30 19:43:22-05  kp
{ - Modified so that defining MAKESMALL will create a much smaller component.
{
{ Revision 1.9  1999-03-22 17:30:20-05  kp
{ - moved kplib to USES list in implementation
{
{ Revision 1.8  1999-03-22 17:21:16-05  kp
{ - Moved comments to bottom
{
{ Revision 1.7  1999-03-20 11:46:42-05  kp
{ - Fixed problem where setting ZipComment to '' caused an access violation
{
{ Revision 1.6  1999-03-14 21:33:05-05  kp
{ - Made some mods for BCB4
{
{ Revision 1.5  1999-02-17 17:24:36-05  kp
{ Moved AssignTo methods to public instead of private for TZipHeaderInfo and TEndCentral
{
{ Revision 1.4  1999-02-08 21:42:50-05  kp
{ Version 2.17
{
{ Revision 1.3  1999-01-25 19:12:59-05  kp
{ Modifed compiler directives
{ }

{   7/9/98 6:47:20 PM
{ Version 2.13
{
{ 1) New property ResetArchiveBitOnZip causes each file's
{ archive bit to be turned  off after being zipped.
{
{ 2) New Property SkipIfArchiveBitNotSet causes files
{ who's archive bit is not set to be skipped during zipping
{ operations.
{
{ 3) A few modifications were made to allow more
{ compatibility with BCB 1.
{
{ 4) Modified how directory information is used when
{ comparing filenames to be unzipped.  Now it is always
{ used.
}
{
{  Mon 27 Apr 1998   17:30:52
{ Added call to new GoodTimeStamp.
}
{
{ Tue 10 Mar 1998   20:36:37
{ Modified the Compare procedure for the ByNone sort
{ because in Delphi 1 the integer wasn't big enough to
{ handle the difference operation which caused "duplicate
{ object" errors.
}

end.