kpzipobj.pas

delphi实现 webservice的例子.有服务端和客户段 利用xml交互.

    if (Fdisk_number_start = $FFFF) then
      Inc(Result, SizeOf(LongWord));
  end;

  procedure TZipHeaderInfo.WriteZip64Extra(S:TkpStream; ht: THeaderType);
  var
    size: Word;
    Zip64Tag: Word;
    tmpCmprssd: Int64;
  begin
    Zip64Tag := $001;
    S.Write(Zip64Tag, SizeOf(Word));
    size := Zip64ExtraSize(ht);
    S.Write(Size, SizeOf(Word));

    if (Funcompressed_size = $FFFFFFFF) then
      S.Write(FZip64_Extended^.uncompressed_size, SizeOf(Int64));
    if (Fcompressed_size = $FFFFFFFF) or ((ht = htLocal) and (Funcompressed_size = $FFFFFFFF)) then
    begin
      if (Fcompressed_size = $FFFFFFFF) then
        S.Write(FZip64_Extended^.compressed_size, SizeOf(Int64))
      else
      begin
        tmpCmprssd := Int64(Fcompressed_size);
        S.Write(tmpCmprssd, SizeOf(Int64));
      end;
    end;
    if (Frelative_offset = $FFFFFFFF) then
      S.Write(FZip64_Extended^.Relative_Offset, SizeOf(Int64));
    if (Fdisk_number_start = $FFFF) then
      S.Write(FZip64_Extended^.DiskStart, SizeOf(LongWord));
  end;

procedure TZipHeaderInfo.SaveCentralToStream(S: TkpStream; TempFile: TkpStream; UsingTemp: Boolean);

  // Writes original extra fields except for Zip64 which
  // is written separately.
  procedure WriteExtraFields;
  const
    ZIP64_TAG = $0001;
  var
    extraBuffer: array of Byte;
    Index: Integer;
    Tag, Size: Word;

  begin
    TempFile.Seek(FOriginalExtraOffset, soBeginning);
    SetLength(extraBuffer, FOriginalCExtra_field_length);
    TempFile.Read(extraBuffer[0], FOriginalCExtra_field_length);
    Index := 0;
    while (Index < FOriginalCExtra_field_length) do
    begin
      Tag := WordPtr(@extraBuffer[Index])^;
      Inc(Index, 2);
      Size := WordPtr(@extraBuffer[Index])^;
      Inc(Index, 2);
      case Tag of
        ZIP64_TAG:
          begin
            // Don't write out zip64 extra field here.  Just because there was one, doesn't
            // mean there still should be.
            Inc(Index, Size);
          end;
      else
        begin
          S.Write(extraBuffer[Index - 4], Size + 4);
          Inc(Index, Size);
        end;
      end;
    end;
  end;

var
  fname: string;
  SIG: LongInt;
  z64ESize: Integer;
begin
  SIG := CENTSIG;
  S.Write(SIG, SizeOf(LongInt));
  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 }
  end;
  S.Write(Fversion_made_by, SizeOf(Fversion_made_by));
  z64ESize := Zip64ExtraSize(htCentral);
  if (z64ESize = 0) then
    Fversion_needed_to_extract := 20
  else
    Fversion_needed_to_extract := 45;
  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));
  FCextra_field_length := FOriginalCExtra_field_length - FOriginalZip64_Extra_length;
  if (z64ESize > 0) then
    Inc(FCextra_field_length, z64ESize + 4);
  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 Length(fname) > 0 then
  begin
    S.Write(fname[1], Ffilename_length);
  end;
  if ((z64ESize = 0) and (FZip64_Extended <> nil)) then
  begin // zip64 extended field may no longer be needed
    FreeMem(FZip64_Extended, SizeOf(zip64_Extra_Field));
    FZip64_Extended := nil;
  end;
  if (FOriginalCExtra_field_length > 0) then
    WriteExtraFields;
  if (z64ESize > 0) then
    WriteZip64Extra(S,htCentral);
  if (Ffile_comment_length > 0) and (Ffilecomment <> nil) then
    S.Write(Ffilecomment^, Ffile_comment_length);
end;

procedure TZipHeaderInfo.SaveLocalToStream(S: TkpStream);
var
  fname: string;
  SIG: LongInt;
  z64ESize: Integer;
  xfl: Word;
  cs: Cardinal;
begin
  SIG := LOCSIG;
  relative_offset := S.Position; {2/1/98 Needed for mulitpart archives}
  S.Write(SIG, SizeOf(LongInt));
  z64ESize := Zip64ExtraSize(htLocal);
  if (z64ESize = 0) then
    Fversion_needed_to_extract := 20
  else
    Fversion_needed_to_extract := 45;
  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));
  cs := FCompressed_size;
  if (Funcompressed_size = $FFFFFFFF) then
    cs := $FFFFFFFF;
  S.Write(cs, SizeOf(Fcompressed_size));
  S.Write(Funcompressed_size, SizeOf(Funcompressed_size));
  S.Write(Ffilename_length, SizeOf(Ffilename_length));
  xfl := FLextra_field_length;
  if (z64ESize > 0) then
    Inc(xfl, z64ESize+4);
  S.Write(xfl, 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;
  if (z64ESize > 0) then
    WriteZip64Extra(S,htLocal);
end;

function TZipHeaderInfo.WriteDataDescriptor(S: TkpStream): Boolean;
var
  dd64: data_descriptor_zip64;
begin
    if (Funcompressed_size = $FFFFFFFF) or
     (Fcompressed_size = $FFFFFFFF) then
     begin
      dd64.crc32 := Fcrc32;
      dd64.compressed_size := FZip64_Extended^.compressed_size;
      dd64.uncompressed_size := FZip64_Extended^.uncompressed_size;
      S.Write(dd64,SizeOf(dd64));
      Fgeneral_purpose_bit_flag := Fgeneral_purpose_bit_flag or 8;
      Result := True;
     end
    else
      Result := False;
end;

function TZipHeaderInfo.ReadCentralFromStream(var S: TkpStream; NewDiskEvent:
  TNewDiskEvent): Boolean;
var
  fname: string;
  AmtRead: LongInt;
  crec: central_file_header;
  save_offset: BIGINT;
  CSIG: LongInt;
begin
  CSIG := CENTSIG;
{$IFDEF KPDEMO}
  DR := DRun;
{$ENDIF}
  Result := False;
  save_offset := S.Seek(0, soCurrent);
  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, soBeginning);
    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, soBeginning);
      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, soCurrent);}
  SetFromCentral(@crec, fname);
  Fcentral_offset := save_offset;
  if (FCextra_field_length > 0) then
  begin
    FOriginalExtraOffset := S.Position;
    FOriginalCExtra_field_length := FCextra_field_length;
    GetExtraFields(S);
    S.Seek(FOriginalExtraOffset, soBeginning);
  end;
  Result := True;
end;


function TZipHeaderInfo.ReadLocalFromStream(S: TkpStream): Boolean;
var
  fname: string;
  lrec: local_file_header;
  save_offset: BIGINT;
  AmtRead: LongInt;
  z64: zip64_Extra_FieldPtr;
begin
  Result := False;
  save_offset := S.Seek(0, soCurrent);
  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, soBeginning);
    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, soBeginning);
      exit;
    end;
    UnixToDOSFilename(StringAsPChar(fname));
    FromOEM(fname); { 2/17/02 2/17/02 }
  end;
  SetFromLocal(@lrec, fname);
  Frelative_offset := save_offset;
  if (FLextra_field_length > 0) then
  begin
    save_offset := S.Seek(0, soCurrent);
    z64 := AllocMem(SizeOf(zip64_Extra_Field));
    AmtRead := S.Read(z64^, SizeOf(zip64_Extra_Field));
    if (AmtRead <> SizeOf(zip64_Extra_Field)) or (z64.Tag <> 1) then
    begin
      FreeMem(z64, SizeOf(zip64_Extra_Field));
    end
    else
      FZip64_Extended := z64;
    S.Seek(save_offset, soBeginning);
  end;
  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: TkpStream): PChar;
var
  crec: central_file_header;
begin
  Result := nil;
  if HasComment then
  begin
    S.Seek(central_offset, soBeginning);
    S.Read(crec, SizeOf(central_file_header));
    with crec do
    begin
      S.Seek(filename_length + Cextra_field_length, soCurrent);
      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);
  if (FZip64EOCL <> nil) then
    FreeMem(FZip64EOCL, SizeOf(zip64_end_of_central_locator));
  if (FZip64EOC <> nil) then
    FreeMem(FZip64EOC, SizeOf(zip64_end_of_central));
  inherited Destroy;
end;

procedure TEndCentral.AssignTo(Dest: TPersistent);
var
  finfo: TEndCentral;
begin
  if Dest is TEndCentral then
  begin
    finfo := TEndCentral(Dest);