kpzipobj.pas

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

{$ENDIF}

procedure setZipSignatures(csig, lsig, esig: LongInt);

implementation {//////////////////////////////////////////////////////////////////////}

uses KpLib;

{*****************  TZipHeaderInfo Methods *********************}

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

destructor TZipHeaderInfo.Destroy;
begin
  if (FFileComment <> nil) then
  begin
    StrDispose(FFileComment);
    FFileComment := nil;
  end;
  if (FZip64_Extended <> nil) then
    FreeMem(FZip64_Extended, sizeof(zip64_Extra_Field));
  inherited Destroy;
end;

procedure TZipHeaderInfo.AssignTo(Dest: TPersistent);
var
  finfo: TZipHeaderInfo;
begin
  if Dest is TZipHeaderInfo then
  begin
    finfo := TZipHeaderInfo(Dest);
    finfo.version_made_by := version_made_by;
    finfo.version_needed_to_extract := version_needed_to_extract;
    finfo.general_purpose_bit_flag := general_purpose_bit_flag;
    finfo.compression_method := compression_method;
    finfo.last_mod_file_date_time := last_mod_file_date_time;
    finfo.crc32 := crc32;
    finfo.compressed_size := compressed_size;
    finfo.uncompressed_size := uncompressed_size;
    finfo.filename_length := filename_length;
    finfo.Cextra_field_length := Cextra_field_length;
    finfo.Lextra_field_length := Lextra_field_length;
    finfo.file_comment_length := file_comment_length;
    finfo.disk_number_start := disk_number_start;
    finfo.internal_file_attributes := internal_file_attributes;
    finfo.external_file_attributes := external_file_attributes;
    finfo.relative_offset := relative_offset;
    finfo.central_offset := central_offset;
    finfo.filename := filename;
    finfo.directory := directory;
    if (file_comment_length > 0) and (filecomment <> nil) then
    begin
      if finfo.filecomment <> nil then
        StrDispose(finfo.filecomment);
      finfo.filecomment := StrAlloc(file_comment_length + 1);
      StrCopy(finfo.filecomment, filecomment);
    end;
    finfo.MatchFlag := MatchFlag;
    finfo.FileIsOK := FFileIsOK;
    finfo.FSelected := FSelected;
  end
  else
    inherited AssignTo(Dest);
end;

procedure TZipHeaderInfo.Assign(Source: TPersistent);
var
  finfo: TZipHeaderInfo;
begin
  if Source is TZipHeaderInfo then
  begin
    finfo := TZipHeaderInfo(Source);
    Fversion_made_by := finfo.version_made_by;
    Fversion_needed_to_extract := finfo.version_needed_to_extract;
    Fgeneral_purpose_bit_flag := finfo.general_purpose_bit_flag;
    Fcompression_method := finfo.compression_method;
    Flast_mod_file_date_time := finfo.last_mod_file_date_time;
    Fcrc32 := finfo.crc32;
    Fcompressed_size := finfo.fcompressed_size;
    Funcompressed_size := finfo.funcompressed_size;
    Ffilename_length := finfo.filename_length;
    FCextra_field_length := finfo.Cextra_field_length;
    FLextra_field_length := finfo.Lextra_field_length;
    Ffile_comment_length := finfo.file_comment_length;
    Fdisk_number_start := finfo.disk_number_start;
    Finternal_file_attributes := finfo.internal_file_attributes;
    Fexternal_file_attributes := finfo.external_file_attributes;
    Frelative_offset := finfo.frelative_offset;
    Fcentral_offset := finfo.fcentral_offset;
    filename := finfo.filename;
    directory := finfo.directory;
    if (finfo.FZip64_Extended <> nil) then
      FZip64_Extended_Instance^ := finfo.FZip64_Extended^;
    if (finfo.file_comment_length > 0) and (finfo.filecomment <> nil) then
    begin
      if Ffilecomment <> nil then
        StrDispose(Ffilecomment);
      Ffilecomment := StrAlloc(file_comment_length + 1);
      StrCopy(Ffilecomment, finfo.filecomment);
    end;
    MatchFlag := finfo.MatchFlag;
    FFileIsOK := finfo.FFileIsOK;
    FSelected := finfo.FSelected;
  end
  else
    inherited Assign(Source);
end;

constructor TZipHeaderInfo.InitWithCentral(crec: centralPtr; FName: string);
begin
  inherited Create;
  SetFromCentral(crec, FName);
end;

constructor TZipHeaderInfo.InitWithLocal(lrec: localPtr; FName: string);
begin
  inherited Create;
  SetFromLocal(lrec, FName);
end;

procedure TZipHeaderInfo.SetFromCentral(crec: centralPtr; FName: string);
begin
  Fversion_made_by := crec^.version_made_by;
  Fversion_needed_to_extract := crec^.version_needed_to_extract;
  Fgeneral_purpose_bit_flag := crec^.general_purpose_bit_flag;
  Fcompression_method := crec^.compression_method;
   { 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 := 45;
  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 := '';
  if (FZip64_Extended <> nil) then
  begin
    FreeMem(FZip64_Extended, sizeof(zip64_Extra_Field));
    FZip64_Extended := nil;
  end;
  Ffilecomment := nil;
  FMatchFlag := False;
  FFileIsOK := 0;
  FSelected := False;
  FOEMConvert := oemNever;
end;

function TZipHeaderInfo.GetRelativeOffset: BIGINT;
begin
  if (FRelative_offset <> $FFFFFFFF) then
    Result := Frelative_offset
  else
    Result := FZip64_Extended^.relative_offset;
end;

procedure TZipHeaderInfo.SetRelativeOffset(offset: BIGINT);
begin
  if (offset <= $FFFFFFFE) then
    FRelative_Offset := offset
  else
  begin
    FZip64_Extended_Instance^.Relative_Offset := offset;
    FRelative_Offset := $FFFFFFFF;
  end;
end;

function TZipHeaderInfo.GetCompressedSize: BIGINT;
begin
  if (Fcompressed_size = $FFFFFFFF) then
    Result := FZip64_Extended^.Compressed_Size
  else
    Result := Fcompressed_size;
end;

procedure TZipHeaderInfo.SetCompressedSize(size: BIGINT);
begin
  if (size <= $FFFFFFFE) then
    Fcompressed_size := size
  else
  begin
    FZip64_Extended_Instance^.Compressed_Size := size;
    Fcompressed_size := $FFFFFFFF;
  end;
end;

function TZipHeaderInfo.GetUnCompressedSize: BIGINT;
begin
  if (Funcompressed_size = $FFFFFFFF) then
    Result := FZip64_Extended^.UnCompressed_Size
  else
    Result := FUnCompressed_size;
end;

procedure TZipHeaderInfo.SetUnCompressedSize(size: BIGINT);
begin
  if (size <= $FFFFFFFE) then
    FUncompressed_size := size
  else
  begin
    FZip64_Extended_Instance^.Uncompressed_Size := size;
    FUncompressed_Size := $FFFFFFFF;
  end;
end;

function TZipHeaderInfo.GetDisk_number_start: LongWord;
begin
  if (Fdisk_number_start < $FFFF) then
    Result := Fdisk_number_start
  else
    Result := FZip64_Extended^.DiskStart;
end;

procedure TZipHeaderInfo.SetDisk_number_start(disk: LongWord);
begin
  if (disk <= $FFFFFFFE) then
    Fdisk_number_start := disk
  else
  begin
    FZip64_Extended_Instance^.DiskStart := disk;
    FUncompressed_Size := $FFFFFFFF;
  end;
end;

procedure TZipHeaderInfo.GetExtraFields(S: TkpStream);
type
  Int64Ptr = ^Int64;
  LongWordPtr = ^LongWord;
  WordPtr = ^Word;
const
  NTFS_TAG = $000A;
  ZIP64_TAG = $0001;
var
  extraBuffer: array of Byte;
  index: integer;
  Tag, Size: WORD;
begin
  SetLength(extraBuffer, FCextra_field_length);
  S.Read(extraBuffer[0], Cextra_field_length);
  Index := 0;
  while (Index < FCextra_field_length) do
  begin
    Tag := WordPtr(@extraBuffer[Index])^;
    Inc(Index, 2);
    Size := WordPtr(@extraBuffer[Index])^;
    Inc(Index, 2);
    case Tag of
      NTFS_TAG:
        Inc(Index, Size);
      ZIP64_TAG:
        begin
          FOriginalZip64_Extra_length := Size + 4; // Total Size
          if (Funcompressed_size = $FFFFFFFF) then
          begin
            FZip64_Extended_Instance^.uncompressed_size := Int64Ptr(@extraBuffer[Index])^;
            Inc(Index, SizeOf(Int64));
          end;
          if (Fcompressed_size = $FFFFFFFF) then
          begin
            FZip64_Extended_Instance^.compressed_size := Int64Ptr(@extraBuffer[Index])^;
            Inc(Index, SizeOf(Int64));
          end;
          if (Frelative_offset = $FFFFFFFF) then
          begin
            FZip64_Extended_Instance^.Relative_Offset := Int64Ptr(@extraBuffer[Index])^;
            Inc(Index, SizeOf(Int64));
          end;
          if (Fdisk_number_start = $FFFF) then
          begin
            FZip64_Extended_Instance^.DiskStart := LongWordPtr(@extraBuffer[Index])^;
            Inc(Index, SizeOf(LongWord));
          end;
        end;
    else
      Inc(Index, Size);
    end;
  end;
end;

function TZipHeaderInfo.GetNewZip64Extended: zip64_Extra_FieldPtr;
begin
  Result := AllocMem(SizeOf(zip64_Extra_Field));
  Result^.Tag := 1;
  Result^.Size := 0;
  Result^.Compressed_Size := 0;
  Result^.Uncompressed_Size := 0;
end;

function TZipHeaderInfo.FZip64_Extended_Instance: zip64_Extra_FieldPtr;
begin
  if (FZip64_Extended = nil) then
    FZip64_Extended := GetNewZip64Extended;
  Result := FZip64_Extended;
end;


procedure TZipHeaderInfo.ToOEM(var fname: string); { 2/17/02  2.22+ }
var
  Dest,Comp: String;
  OrgLen:    Integer;
begin
  // Convert only if OEMConvert is True and the Conversion
  // actually works.  If it doesn't work, then there must be
  // one or more characters outside the OEM character set, so
  // set the upper byte of ver_made_by to NTFS instead of DOS

  if (OEMConvert = oemNever) then
    // Don't convert
    exit;

  if (OEMConvert = oemAlways) then
  begin
    // This saves string creation
    CharToOem(@fname[1], @fname[1]);
    exit;
  end;

  // OEMConvert = oemFlexible
  OrgLen := Length(fname);
  SetLength(Dest,OrgLen);
  CharToOem(@fname[1], @Dest[1]);
  SetLength(Comp,OrgLen);
  OEMToChar(@Dest[1],@Comp[1]);
  if (AnsiSameStr(fname,Comp)) then
    // Allow conversion
    fname := Dest
  else
    // No convertion, set WinZip compatible flag
    Fversion_made_by := (Fversion_made_by and $00FF) or $0B00;

end;

procedure TZipHeaderInfo.FromOEM(var fname: string); { 2/17/02  2.22+ }
begin
  // Only convert if OEMConvert is oemAlways or high byte of ver_made_by
  // is DOS and not NTFS.
  if (OEMConvert = oemAlways) or ((OEMConvert = oemFlexible) and ((Fversion_made_by and $0B00) <> $0B00)) then
  begin
    OemToChar(@fname[1], @fname[1]);
  end;
end;

  function TZipHeaderInfo.Zip64ExtraSize(ht: THeaderType): Word;
  begin
    Result := 0;
    if (Funcompressed_size = $FFFFFFFF) then
      Inc(Result, SizeOf(Int64));
    if (Fcompressed_size = $FFFFFFFF) or ((ht = htLocal) and (Funcompressed_size = $FFFFFFFF)) then
      Inc(Result, SizeOf(Int64));
    if (Frelative_offset = $FFFFFFFF) then
      Inc(Result, SizeOf(Int64));