kpzipobj.pas

一个delphi中压缩的组件VCLZip

   { GoodTimeStamp 4/21/98  2.11 }
  Flast_mod_file_date_time := GoodTimeStamp(crec^.last_mod_file_date_time);
  Fcrc32 := crec^.crc32;
  Fcompressed_size := crec^.compressed_size;
  Funcompressed_size := crec^.uncompressed_size;
  Ffilename_length := crec^.filename_length;
  FCextra_field_length := crec^.extra_field_length;
  Ffile_comment_length := crec^.file_comment_length;
  Fdisk_number_start := crec^.disk_number_start;
  Finternal_file_attributes := crec^.internal_file_attributes;
  Fexternal_file_attributes := crec^.external_file_attributes;
  Frelative_offset := crec^.relative_offset;
  Fcentral_offset := 0;
  filename := ExtractFilename(FName);
  directory := ExtractFilePath(FName);
  Ffilecomment := nil;
  FMatchFlag := False;
  FSelected := False;
end;

procedure TZipHeaderInfo.SetFromLocal(lrec: localPtr; FName: string);
begin
  Fversion_made_by := 0;
  Fversion_needed_to_extract := lrec^.version_needed_to_extract;
  Fgeneral_purpose_bit_flag := lrec^.general_purpose_bit_flag;
  Fcompression_method := lrec^.compression_method;
   { GoodTimeStamp 4/21/98  2.11 }
  Flast_mod_file_date_time := GoodTimeStamp(lrec^.last_mod_file_date_time);
  Fcrc32 := lrec^.crc32;
  Fcompressed_size := lrec^.compressed_size;
  Funcompressed_size := lrec^.uncompressed_size;
  Ffilename_length := lrec^.filename_length;
  FLextra_field_length := lrec^.extra_field_length;
  Ffile_comment_length := 0;
  Fdisk_number_start := 0;
  Finternal_file_attributes := 0;
  Fexternal_file_attributes := 0;
  Frelative_offset := 0;
  Fcentral_offset := 0;
  if FName <> '' then
    begin
      filename := ExtractFilename(FName);
      directory := ExtractFilePath(FName);
    end
  else
    begin
      filename := '';
      directory := '';
    end;
  Ffilecomment := nil;
  FMatchFlag := False;
  FSelected := False;
end;

procedure TZipHeaderInfo.Clear;
begin
  { Set up default values }
  Fversion_made_by := 20;
  Fversion_needed_to_extract := 20;
  Fgeneral_purpose_bit_flag := 0;
  Fcompression_method := 8;
  Flast_mod_file_date_time := 0;
  Fcrc32 := $FFFFFFFF; ;
  Fcompressed_size := 0;
  Funcompressed_size := 0;
  Ffilename_length := 0;
  FCextra_field_length := 0;
  FLextra_field_length := 0;
  Ffile_comment_length := 0;
  Fdisk_number_start := 0;
  Finternal_file_attributes := 1;
  Fexternal_file_attributes := 32;
  Frelative_offset := 0;
  Fcentral_offset := 0;
  Ffilename := '';
  Fdirectory := '';
  Ffilecomment := nil;
  FMatchFlag := False;
  FFileIsOK := 0;
  FSelected := False;
  FOEMConvert := False;
end;

procedure TZipHeaderInfo.ToOEM( var fname: String );    { 2/17/02  2.22+ }
begin
  if (OEMConvert) then
   begin
{$IFDEF WIN32}
      CharToOem(@fname[1], @fname[1]);
{$ELSE}
      AnsiToOem(StringAsPChar(fname), StringAsPChar(fname));
{$ENDIF}
   end;
end;

procedure TZipHeaderInfo.FromOEM( var fname: String );  { 2/17/02  2.22+ }
begin
  if (OEMConvert) then
   begin
{$IFDEF WIN32}
        OemToChar(@fname[1], @fname[1]);
{$ELSE}
        OemToAnsi(StringAsPChar(fname), StringAsPChar(fname));
{$ENDIF}
   end;
end;

procedure TZipHeaderInfo.SaveCentralToStream(S: TStream);
var
  fname: string;
  SIG: LongInt;
begin
  SIG := CENTSIG;
  S.Write(SIG, SizeOf(LongInt));
  S.Write(Fversion_made_by, SizeOf(Fversion_made_by));
  S.Write(Fversion_needed_to_extract, SizeOf(Fversion_needed_to_extract));
  S.Write(Fgeneral_purpose_bit_flag, SizeOf(Fgeneral_purpose_bit_flag));
  S.Write(Fcompression_method, SizeOf(Fcompression_method));
  S.Write(Flast_mod_file_date_time, SizeOf(Flast_mod_file_date_time));
  S.Write(Fcrc32, SizeOf(Fcrc32));
  S.Write(Fcompressed_size, SizeOf(Fcompressed_size));
  S.Write(Funcompressed_size, SizeOf(Funcompressed_size));
  S.Write(Ffilename_length, SizeOf(Ffilename_length));
  S.Write(FCextra_field_length, SizeOf(FCextra_field_length));
  S.Write(Ffile_comment_length, SizeOf(Ffile_comment_length));
  S.Write(Fdisk_number_start, SizeOf(Fdisk_number_start));
  S.Write(Finternal_file_attributes, SizeOf(Finternal_file_attributes));
  S.Write(Fexternal_file_attributes, SizeOf(Fexternal_file_attributes));
  S.Write(Frelative_offset, SizeOf(Frelative_offset));
  if Ffilename_length > 0 then
    begin
      { Added Copy's because when only Fdirectory existed, changes to fname affected Fdirectory
        8/20/01   2.22+  }
      fname := Copy(Fdirectory,1,Length(Fdirectory)) + Copy(Ffilename,1,Length(Ffilename));
      DOSToUnixFilename(StringAsPChar(fname));
      ToOEM(fname);  { 2/17/02 2/17/02 }
      S.Write(fname[1], Ffilename_length);
    end;
  if (Ffile_comment_length > 0) and (Ffilecomment <> nil) then
    S.Write(Ffilecomment^, Ffile_comment_length);
end;

procedure TZipHeaderInfo.SaveLocalToStream(S: TStream);
var
  fname: string;
  SIG: LongInt;
begin
  SIG := LOCSIG;
  Frelative_offset := S.Position; {2/1/98 Needed for mulitpart archives}
  S.Write(SIG, SizeOf(LongInt));
  S.Write(Fversion_needed_to_extract, SizeOf(Fversion_needed_to_extract));
  S.Write(Fgeneral_purpose_bit_flag, SizeOf(Fgeneral_purpose_bit_flag));
  S.Write(Fcompression_method, SizeOf(Fcompression_method));
  S.Write(Flast_mod_file_date_time, SizeOf(Flast_mod_file_date_time));
  S.Write(Fcrc32, SizeOf(Fcrc32));
  S.Write(Fcompressed_size, SizeOf(Fcompressed_size));
  S.Write(Funcompressed_size, SizeOf(Funcompressed_size));
  S.Write(Ffilename_length, SizeOf(Ffilename_length));
  S.Write(FLextra_field_length, SizeOf(FLextra_field_length));
  if Ffilename_length > 0 then
    begin
      { Added Copy's because when only Fdirectory existed, changes to fname affected Fdirectory
        8/20/01   2.22+  }
      fname := Copy(Fdirectory,1,Length(Fdirectory)) + Copy(Ffilename,1,Length(Ffilename));
      DOSToUnixFilename(StringAsPChar(fname));
      ToOEM(fname);  { 2/17/02 2/17/02 }
      S.Write(fname[1], Ffilename_length);
    end;
end;

function TZipHeaderInfo.ReadCentralFromStream(var S: TStream; NewDiskEvent:
  TNewDiskEvent): Boolean;
var
  fname: string;
  AmtRead: LongInt;
  crec: central_file_header;
  save_offset: LongInt;
  CSIG: LongInt;
begin
  CSIG := CENTSIG;
{$IFDEF KPDEMO}
  DR := DRun;
{$ENDIF}
  Result := False;
  save_offset := S.Seek(0, soFromCurrent);
  AmtRead := S.Read(crec, SizeOf(central_file_header));
  if (AmtRead = 0) or
    ((AmtRead <> SizeOf(central_file_header)) and (crec.Signature.Sig = CSIG)) then
    if Assigned(NewDiskEvent) then
      begin
        NewDiskEvent(Self, S);
        Inc(AmtRead, S.Read(crec, SizeOf(central_file_header) - AmtRead));
      end;
  if (AmtRead <> SizeOf(central_file_header)) or (crec.Signature.Sig <> CSIG) then
    begin
      S.Seek(save_offset, soFromBeginning);
      exit;
    end;
  if crec.filename_length > 0 then
    begin
      SetLength(fname, crec.filename_length);
      AmtRead := S.Read(fname[1], crec.filename_length);
      if AmtRead <> crec.filename_length then
        begin
          S.Seek(save_offset, soFromBeginning);
          exit;
        end;
      UnixToDOSFilename(StringAsPChar(fname));
      If (crec.version_made_by AND $FF00) = 0 then  { 09/24/00  2.21b3+ }
      FromOEM(fname);  { 2/17/02 2/17/02 }
    end;
{$IFDEF KPDEMO}
  if not DR then
    fname := 'xxx';
{$ENDIF}
  { Commented out the following since it should not be skipping past the extra field
    incase they are needed for something }
  {S.Seek(crec.extra_field_length + crec.file_comment_length, soFromCurrent);}
  SetFromCentral(@crec, fname);
  Fcentral_offset := save_offset;
  Result := True;
end;

function TZipHeaderInfo.ReadLocalFromStream(S: TStream): Boolean;
var
  fname: string;
  lrec: local_file_header;
  save_offset: LongInt;
  AmtRead: LongInt;
begin
  Result := False;
  save_offset := S.Seek(0, soFromCurrent);
  AmtRead := S.Read(lrec, SizeOf(local_file_header));
  if (AmtRead <> SizeOf(local_file_header)) or (lrec.Signature.Sig <> LOCSIG) then
    begin
      S.Seek(save_offset, soFromBeginning);
      exit;
    end;
  if lrec.filename_length > 0 then
    begin
      SetLength(fname, lrec.filename_length);
      AmtRead := S.Read(fname[1], lrec.filename_length);
      if AmtRead <> lrec.filename_length then
        begin
          S.Seek(save_offset, soFromBeginning);
          exit;
        end;
      UnixToDOSFilename(StringAsPChar(fname));
      FromOEM(fname);  { 2/17/02 2/17/02 }
    end;
  SetFromLocal(@lrec, fname);
  Frelative_offset := save_offset;
  Result := True;
end;

function TZipHeaderInfo.GetHasComment: Boolean;
begin
  Result := Ffile_comment_length > 0;
end;

procedure TZipHeaderInfo.SetFileComment(FComment: PChar);
begin
  if Ffilecomment <> nil then
    StrDispose(Ffilecomment);
  if FComment <> nil then
    begin
      FfileComment := StrAlloc(StrLen(FComment) + 1);
      StrCopy(FfileComment, FComment);
      Ffile_comment_length := StrLen(FComment);
    end
  else
    begin
      FfileComment := nil;
      Ffile_comment_length := 0;
    end;
end;

procedure TZipHeaderInfo.SetNewFileComment(NewComment: string);
begin
  {changed StrToPChar to StringAsPChar  7/16/98  2.14}
  SetFileComment(StringAsPChar(NewComment));
end;

function TZipHeaderInfo.Getfilecomment(S: TStream): PChar;
var
  crec: central_file_header;
begin
  Result := nil;
  if HasComment then
    begin
      S.Seek(central_offset, soFromBeginning);
      S.Read(crec, SizeOf(central_file_header));
      with crec do
        begin
          S.Seek(filename_length + Cextra_field_length, soFromCurrent);
          Result := StrAlloc(Ffile_comment_length + 1);
          S.Read(Result^, Ffile_comment_length);
          Result[Ffile_comment_length] := #0;
        end;
    end;
end;

function TZipHeaderInfo.GetIsEncrypted: Boolean;
begin
  Result := (general_purpose_bit_flag and 1) <> 0;
end;

function TZipHeaderInfo.GetHasDescriptor: Boolean;
begin
  Result := (general_purpose_bit_flag and 8) <> 0;
end;

function TZipHeaderInfo.GetLocalSize: Integer;
begin
  Result := SizeOf(local_file_header) + Ffilename_length + FLextra_field_length;
end;

function TZipHeaderInfo.GetCentralSize: Integer;
begin
  Result := SizeOf(central_file_header) + FFilename_length + FCextra_field_length +
    Ffile_comment_length;
end;

procedure TZipHeaderInfo.Setfilename(FName: string);
begin
  if FName <> Ffilename then
    begin
      Ffilename := FName;
      Ffilename_length := Length(Fdirectory) + Length(Ffilename);
    end;
end;

procedure TZipHeaderInfo.Setdirectory(Directory: string);
var
  tmpDirectory: string;
begin
  if (Directory <> '') and (RightStr(Directory, 1) <> '\') then
    tmpDirectory := Directory + '\'
  else
    tmpDirectory := Directory;
  if tmpDirectory <> Fdirectory then
    begin
      Fdirectory := tmpDirectory;
      Ffilename_length := Length(Fdirectory) + Length(Ffilename);
    end;
end;

procedure TZipHeaderInfo.SetDateTime(DateTime: TDateTime);
begin
  Flast_mod_file_date_time := DateTimeToFileDate(DateTime);
end;

{*****************  TEndCentral Methods *********************}

constructor TEndCentral.Create;
begin
  inherited Create;
  Clear;
end;

destructor TEndCentral.Destroy;
begin
  if (FZipComment <> nil) then
    StrDispose(FZipComment);
  inherited Destroy;
end;

procedure TEndCentral.AssignTo(Dest: TPersistent);
var
  finfo: TEndCentral;
begin
  if Dest is TEndCentral then
    begin
      finfo := TEndCentral(Dest);
      finfo.ecrec := Fecrec;
      if (Fecrec.zip_comment_length > 0) and (FZipComment <> nil) then
        begin
          if finfo.ZipComment <> nil then
            StrDispose(finfo.ZipComment);
          finfo.ZipComment := StrAlloc(StrLen(FZipComment) + 1);
          StrCopy(finfo.ZipComment, FZipComment);
          finfo.zip_comment_length := StrLen(finfo.ZipComment);
        end;
      finfo.ZipCommentPos := FZipCommentPos;
    end
  else
    inherited AssignTo(Dest);
end;

procedure TEndCentral.Assign(Source: TPersistent);
var
  finfo: TEndCentral;
begin
  if Source is TEndCentral then
    begin
      finfo := TEndCentral(Source);
      Fecrec := finfo.ecrec;
      if (finfo.zip_comment_length > 0) and (finfo.ZipComment <> nil) then
        begin
          if FZipComment <> nil then
            StrDispose(FZipComment);
          FZipComment := StrAlloc(StrLen(finfo.ZipComment) + 1);
          StrCopy(FZipComment, finfo.ZipComment);
          Fecrec.zip_comment_length := StrLen(FZipComment);
        end;
      FZipCommentPos := finfo.ZipCommentPos;
    end
  else
    inherited Assign(Source);
end;

procedure TEndCentral.SetFromEndCentral(crec: end_of_centralPtr);
begin
  Fecrec := crec^;
  FZipCommentPos := 0;
  if FZipComment <> nil then
    StrDispose(FZipComment);
  FZipComment := nil;
end;