vclunzip.pas

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

                  theZipFile.Seek(filename_length + extra_field_length, soCurrent);
                  {$IFDEF WIN32}
                  CommentLength := file_comment_length;
                  {$ELSE}
                  CommentLength := kpmin(file_comment_length, 255);
                  {$ENDIF}
                  SetLength(Result, CommentLength);
                  theZipFile.Read(Result[1], CommentLength);
                  RememberModified := ecrec.Modified;
                  SetFileComment(Index, Result);        { Save it in central header }
                  ecrec.Modified := RememberModified;
               end;
            finally
               theZipFile.Seek(RememberPosition, soBeginning);
               If (MultiMode = mmNone) then
                 CloseZip;
            end
            else
               Result := StrPas(finfo.filecomment);
         end
         else
            Result := '';                               { No comment }
      end;
   end
   else
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
end;

procedure TVCLUnZip.ResetFileIsOK(Index: Integer);
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      finfo.FileIsOK := icUNDEFINED;
   end
   else
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
end;

function TVCLUnZip.CheckArchive: Boolean;
var
   tmpDoAll              : Boolean;
begin
   tmpDoAll := DoAll;
   DoAll := True;
   Result := ProcessIntegrityCheck(-1);
   DoAll := tmpDoAll;
end;

function TVCLUnZip.GetFileIsOK(Index: Integer): Boolean;
var
   tmpDoAll              : Boolean;
begin
   tmpDoAll := DoAll;
   DoAll := False;
   Result := ProcessIntegrityCheck(Index);
   DoAll := tmpDoAll;
end;

function TVCLUnZip.ProcessIntegrityCheck(Index: Integer): Boolean;
var
   n, r                  : Integer;
   s                     : PChar;
   saveRecreateDirs      : Boolean;
   saveDestDir           : string;
   finfo                 : TZipHeaderInfo;
begin
   r := icUNDEFINED;
   finfo := nil;
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      r := finfo.FileIsOK;
   end
   else
      if (Index <> -1) then
         raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);

   if (Index <> -1) and (r = icFILEOK) then
      Result := True
   else
      if (Index <> -1) and (r = icFILEBAD) then
         Result := False
      else                                              { r = icUNDEFINED }
      begin
         FTestMode := True;
         saveRecreateDirs := RecreateDirs;
         saveDestDir := DestDir;
         Result := False;
         if (Index <> -1) then
            finfo.FileIsOK := icFILEBAD;
         try
            RecreateDirs := True;
            DestDir := ''; { changed from 'c:\TestZip\' 2/14/99 2.17+ }
            s := PChar(1);                              { Just to be sure it's not nil }
            n := UnzipToBufferByIndex(s, Index);        { Dummy Buffer }
            if (n > 0) then
            begin
               Result := True;
               if (Index <> -1) then
                  finfo.FileIsOK := icFILEOK
               else
               begin
                  if DoAll then
                  begin
                     if (n < Count) then
                        Result := False;
                  end
                  else
                     if (n <> FNumSelected) then
                        Result := False;
               end;
            end;
         finally
            FTestMode := False;
            RecreateDirs := saveRecreateDirs;
            DestDir := saveDestDir;
         end;
      end;
end;

function TVCLUnZip.GetZipComment: string;
var
   CommentLength         : LongInt;
   RememberModified      : Boolean;
   RememberPosition      : BIGINT;
begin
   if ecrec.zip_comment_length = 0 then
      Result := ''
   else
      with ecrec do
      begin
         if ecrec.ZipComment = nil then
         begin
           OpenZip;
           RememberPosition := theZipFile.Position;
            try
               theZipFile.Seek(ZipCommentPos, soBeginning);
               {$IFDEF WIN32}
               CommentLength := zip_comment_length;
               {$ELSE}
               CommentLength := kpmin(zip_comment_length, 255);
               {$ENDIF}
               SetLength(Result, CommentLength);
               theZipFile.Read(Result[1], CommentLength);
               RememberModified := Modified;
               SetZipComment(Result);                   { Save it in ecrec }
               Modified := RememberModified;
            finally
               theZipFile.Seek(RememberPosition, soBeginning);
               If (MultiMode = mmNone) then
                 CloseZip;
            end;
         end
         else
            Result := PCharToStr(ecrec.ZipComment);
      end;
end;

procedure TVCLUnZip.SetZipComment(theComment: string);
begin
   if ((ecrec.ZipComment = nil) and (theComment <> '')) or
      (StrComp(ecrec.ZipComment, StringAsPChar(theComment)) <> 0) then
   begin
      ecrec.SetNewZipComment(theComment);
      ecrec.Modified := True;
   end;
end;

procedure TVCLUnZip.SetFileComment(Index: Integer; theComment: string);
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      if ((finfo.filecomment = nil) and (theComment <> '')) or
         (StrComp(finfo.filecomment, StringAsPChar(theComment)) <> 0) then
      begin
         if finfo.filecomment <> nil then
            finfo.filecomment := nil;
         if theComment = '' then
            finfo.filecomment := nil
         else
         begin
            { Changed StrToPChar to StringAsPChar  7/16/98  2.14 }
            finfo.filecomment := StringAsPChar(theComment);
         end;
         ecrec.Modified := True;
      end;
   end
   else
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
end;

{ 3/10/98  2.03}
{ These are overriden in VCLZip }

function TVCLUnZip.GetMultiMode: TMultiMode;
begin
   Result := FMultiMode;
end;

{ 3/10/98  2.03}

procedure TVCLUnZip.SetMultiMode(Value: TMultiMode);
begin
   FMultiMode := Value;
end;

function TVCLUnZip.GetDiskNo(Index: Integer): Integer;
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      Result := finfo.disk_number_start + 1;
   end
   else
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
end;

function TVCLUnZip.GetSelected(Index: Integer): Boolean;
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      Result := finfo.Selected;
   end
   else
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
end;

procedure TVCLUnZip.SetSelected(Index: Integer; Value: Boolean);
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      if (finfo.Selected <> Value) then
      begin
         finfo.Selected := Value;
         if (Value = True) then
            Inc(FNumSelected)
         else
            Dec(FNumSelected);
      end;
   end
   else
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
end;

procedure TVCLUnZip.GetDecryptHeaderPtr(Index: Integer; dhPtr: BytePtr);
var
   dhTemp                : DecryptHeaderType;
   i                     : Integer;
   {$IFNDEF ISDELPHI}
   finfo                 : TZipHeaderInfo;
   lrec                  : local_file_header;
   {$ENDIF}
begin
   if (Index < 0) or (Index >= Count) then
   begin
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
      exit;
   end;
   if (not IsEncrypted[Index]) then
   begin
      for i := 0 to 11 do
      begin
         dhPtr^ := 0;
         Inc(dhPtr);
      end;
      exit;
   end;
   {$IFDEF ISDELPHI}
   dhTemp := GetDecryptHeader(Index);
   for i := 0 to 11 do
   begin
      dhPtr^ := dhTemp[i];
      Inc(dhPtr);
   end;
   {$ELSE}
   finfo := sortfiles.Items[Index] as TZipHeaderInfo;
   with finfo do
   begin
      try
         OpenZip;
         theZipFile.Seek(relative_offset, soBeginning);
         theZipFile.Read(lrec, SizeOf(local_file_header));
         with lrec do
         begin
            theZipFile.Seek(filename_length, soCurrent);
            theZipFile.Read(dhTemp, SizeOf(DecryptHeaderType));
         end;
         for i := 0 to 11 do                            { added this loop 10/23/99  2.20b3+ }
         begin
            dhPtr^ := dhTemp[i];
            Inc(dhPtr);
         end;
      finally
        If (MultiMode = mmNone) then
           CloseZip;
      end;
   end;
   {$ENDIF}
end;

{$IFDEF ISDELPHI}

function TVCLUnZip.GetDecryptHeader(Index: Integer): DecryptHeaderType;
var
   finfo                 : TZipHeaderInfo;
   lrec                  : local_file_header;
   i                     : Integer;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
   end
   else
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   if (IsEncrypted[Index]) then
      with finfo do
      begin
         try
            OpenZip;
            theZipFile.Seek(relative_offset, soBeginning);
            theZipFile.Read(lrec, SizeOf(local_file_header));
            with lrec do
            begin
               theZipFile.Seek(filename_length, soCurrent);
               theZipFile.Read(Result, SizeOf(DecryptHeaderType));
            end;
         finally
           If (MultiMode = mmNone) then
              CloseZip;
         end
      end
   else
      for i := 0 to 11 do
         Result[i] := 0;
end;
{$ENDIF}

function TVCLUnZip.GetZipSize: BIGINT;
begin
   Result := 0;
   if FZipName <> '' then
   begin
      OpenZip;
      try
         Result := theZipFile.Size;
      finally
        If (MultiMode = mmNone) then
           CloseZip;
      end;
   end;
end;

function TVCLUnZip.GetIsZip64: Boolean;
begin
  Result := (ecrec.offset_central >= $FFFFFFFF) or (ecrec.num_entries >= $FFFF) or (sortfiles.isZip64);
end;

procedure TVCLUnZip.WriteNumDisks(NumberOfDisks: Integer);
begin
   FNumDisks := NumberOfDisks;
end;

{ Added these so that they could be overriden in VCLZip 3/11/98  2.03 }

function TVCLUnZip.GetCheckDiskLabels: Boolean;
begin
   Result := FCheckDiskLabels;
end;

procedure TVCLUnZip.SetCheckDiskLabels(Value: Boolean);
begin
   FCheckDiskLabels := Value;
end;

function TVCLUnZip.UnZip: Integer;
var
  OldBusy: Boolean;
begin
   OldBusy := SetBusy(True);
   CancelOperation := False;
   Result := 0;
   try