vclunzip.pas

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

      if DestDir <> '?' then
      begin
         { Following Changed from OpenZip which was being bypassed. 03/15/01  2.21+ }
         ReadZip;
         OpenZip;  { Make sure it's open because ReadZip closes it again }
         Result := UnzipFiles(theZipFile);
         CloseZip;
      end;
   finally
      SetBusy(OldBusy);
      CancelOperation := False;
   end;
end;

function TVCLUnZip.UnZipSelected: Integer;
begin
   UnZippingSelected := True;
   Result := UnZip;
   UnZippingSelected := False;
end;

procedure TVCLUnZip.ClearSelected;
var
   i                     : Integer;
begin
   for i := 0 to Count - 1 do
      Selected[i] := False;
   FNumSelected := 0;
end;

function TVCLUnZip.SetBusy( value: Boolean ): Boolean;
begin
  Result := FBusy;
  FBusy := value;
end;

function TVCLUnZip.SetOperationMode( value: TOperationMode ): TOperationMode;
begin
  Result := FOperationMode;
  FOperationMode := value;
end;

function TVCLUnZip.UnZipToStream(theStream: TkpStream; FName: string): Integer;
var
  OldBusy: Boolean;
begin
   Result := 0;
   if (Trim(FName) = '') or (theStream = nil) then
      exit;
   OldBusy := SetBusy(True);
   ZipStream := theStream;
   CancelOperation := False;
   StreamZipping := True;
   OpenZip;
   FilesList.Clear;
   FilesList.Add(FName);
   try
      Result := UnzipFiles(theZipFile);
   finally
      StreamZipping := False;
      CloseZip;
      SetBusy(OldBusy);
      CancelOperation := False;
   end;
end;

{$IFNDEF INT64STREAMS}
function TVCLUnZip.UnZipToStream(theStream: TMemoryStream; FName: string): Integer; 
var
   InternalStream:tkpHugeMemoryStream;
   OldBusy: Boolean;
begin
   Result := 0;
   if (Trim(FName) = '') or (theStream = nil) then
      exit;
   OldBusy := SetBusy(True);
   InternalStream:=tkpHugeMemoryStream.Create;
   try
     result:=UnzipToStream(InternalStream,FName);
     TheStream.Position:=0;
     InternalStream.Position:=0;
     internalStream.SaveToStream(theStream);
   finally
     InternalStream.Free;
     SetBusy(OldBusy);
   end;
end;

function TVCLUnZip.UnZipToStreamByIndex(theStream: TStream; Index: Integer): Integer;
var
  InternalStream: TkpHugeMemoryStream;
  OldBusy: Boolean;
begin
   Result := 0;
   if (theStream = nil) then
      exit;
   OldBusy := SetBusy(True);
   InternalStream:=tkpHugeMemoryStream.Create;
   try
     result:=UnzipToStreamByIndex(InternalStream,Index);
     TheStream.Position:=0;
     InternalStream.Position:=0;
     internalStream.SaveToStream(theStream);
   finally
     InternalStream.Free;
     SetBusy(OldBusy);
   end;
end;
{$ENDIF}

function TVCLUnZip.UnZipToStreamByIndex(theStream: TkpStream; Index: Integer): Integer;
var
  OldBusy: Boolean;
begin
   Result := 0;
   if (theStream = nil) then
      exit;
   OldBusy := SetBusy(True);
   ZipStream := theStream;
   CancelOperation := False;
   StreamZipping := True;
   OpenZip;
   FilesList.Clear;
   try
      Selected[Index] := True;
      UnZippingSelected := True;
      Result := UnzipFiles(theZipFile);
   finally
      StreamZipping := False;
      CloseZip;
      SetBusy(OldBusy);
      CancelOperation := False;
      UnZippingSelected := False;
   end;
end;

function TVCLUnZip.UnZipToBuffer(var Buffer: PChar; FName: string): Integer;
var
  OldBusy: Boolean;
begin
   Result := 0;
   if (Trim(FName) = '') then
      exit;
   OldBusy := SetBusy(True);
   MemZipping := True;
   OpenZip;                                             { 12/4/98  2.17P+ }
   FilesList.Clear;
   FilesList.Add(FName);
   if (Buffer = nil) then
      MemBuffer := nil
   else
      MemBuffer := Buffer;
   try
      Result := UnzipFiles(theZipFile);
      if (Buffer = nil) then
         Buffer := MemBuffer;
   finally
      MemZipping := False;
      CloseZip;
      SetBusy(OldBusy);
      CancelOperation := False;
      MemBuffer := nil;
   end;
end;

function TVCLUnZip.UnZipToBufferByIndex(var Buffer: PChar; Index: Integer): Integer;
var
  OldBusy: Boolean;
begin
   OldBusy := SetBusy(True);
   MemZipping := True;
   OpenZip;                                             { 12/4/98  2.17P+ }
   FilesList.Clear;
   if (Buffer = nil) then
      MemBuffer := nil
   else
      MemBuffer := Buffer;
   try
      if Index > -1 then
         Selected[Index] := True;
      if not DoAll then
         UnZippingSelected := True;
      Result := UnzipFiles(theZipFile);
      if (Buffer = nil) then
         Buffer := MemBuffer;
   finally
      MemZipping := False;
      CloseZip;
      SetBusy(OldBusy);
      CancelOperation := False;
      MemBuffer := nil;
      UnZippingSelected := False;
   end;
end;

procedure TVCLUnZip.OpenZip;
{$IFDEF KPDEMO}
var
   tmpMStr2              : string;
   {$ENDIF}
begin
   {$IFDEF KPDEMO}
   if not (csDesigning in ComponentState) then
   begin
      if not DelphiIsRunning then
      begin
         tmpMStr := LoadStr(IDS_NOTREGISTERED);
         tmpMStr2 := LoadStr(IDS_WARNING);
         //MessageBox(0, StringAsPChar(tmpMStr), StringAsPChar(tmpMStr2), mb_OK);
         DoHandleMessage(IDS_NOTREGISTERED,StringAsPChar(tmpMStr), StringAsPChar(tmpMStr2), mb_OK);
         Abort;
      end;
   end;
   {$ENDIF}
   if theZipFile = nil then
      theZipFile := TLFNFileStream.CreateFile(FZipName, fmOpenRead or fmShareDenyWrite,
         FFlushFilesOnClose, BufferedStreamSize);
   if files = nil then
      GetFileInfo(theZipFile)
   else
      if (not ArchiveIsStream) and
         (FileDateToDateTime(FileGetDate(TLFNFileStream(theZipFile).Handle)) <> filesDate) then
         GetFileInfo(theZipFile);
end;

procedure TVCLUnZip.CloseZip;
begin
   { Policy is to never free ArchiveStream, that's up to the application
     Application should set ArchiveStream := nil and close it's own reference
     to the stream
     01/21/02  2.22+   }
   if (not FKeepZipOpen) and (not ArchiveIsStream) then
   begin
      theZipFile.Free;
      theZipFile := nil;
   end;
end;

procedure TVCLUnZip.AskForNewDisk(NewDisk: Integer);
begin
   SwapDisk(NewDisk);
end;

function TVCLUnZip.SwapDisk(NewDisk: Integer): TkpStream;
{ NewDisk is the disk number that the user sees. Starts with 1 }
var
   tmpZipName            : string;
   spType                : TSplitPartType;
   
   function CurrentDiskLabel(NewDisk: Integer): Boolean;
   var
      VolName            : string[11];
      Disk               : string;
   begin
      {Need to check disk label here}
      if MultiMode = mmSpan then
      begin
         Disk := UpperCase(LeftStr(FZipName, 3));
         VolName := GetVolumeLabel(Disk);
         if RightStr(VolName, 3) = Format('%3.3d', [NewDisk]) then
            Result := True
         else
            Result := False;
      end
      else
         Result := True;
   end;

begin
   theZipFile.Free;
   theZipFile := nil; {1/27/98 to avoid GPF when Freeing file in CloseZip. v2.00+}
   tmpZipName := FZipName;
   if (MultiMode = mmBlocks) then
   begin
    if (FOperationMode = omUnZip) and (NewDisk = NumDisks) then
      spType := spLast
    else if (NewDisk = 1) then
      spType := spFirst
    else
      spType := spMiddle;
    tmpZipName := FZipNameNoExtension;
    DoFileNameForSplitPart(tmpZipName, NewDisk, spType);
   end
   else
   repeat
      repeat
         DoGetNextDisk(NewDisk, tmpZipName);
      until (not CheckDiskLabels) or (tmpZipName = '') or (CurrentDiskLabel(NewDisk));
      if tmpZipName = '' then
         raise EUserCanceled.Create('User canceled loading new disk.');
   until FileExists(tmpZipName); {1/29/98 To avoid problem if file doesn't exist}
   theZipFile := TLFNFileStream.CreateFile(tmpZipName, fmOpenRead or fmShareDenyNone, False, BufferedStreamSize);
   CurrentDisk := NewDisk - 1;                          { CurrentDisk starts with 0 }
   filesDate := FileDateToDateTime(FileGetDate(TLFNFileStream(theZipFile).Handle));
   FZipName := tmpZipName;
   Result := theZipFile;
end;

procedure TVCLUnZip.NewDiskEvent(Sender: TObject; var S: TkpStream);
begin
   SwapDisk(CurrentDisk + 2);
   S := theZipFile;
end;

function TVCLUnZip.CreateNewZipHeader: TZipHeaderInfo;
begin
  Result := TZipHeaderInfo.Create;
  Result.OEMConvert := FOEMConvert;
end;

procedure TVCLUnZip.ClearZip;
var
   SaveKeepZipOpen       : Boolean;
begin
   SaveKeepZipOpen := FKeepZipOpen;
   FKeepZipOpen := False;
   CloseZip;
   FKeepZipOpen := SaveKeepZipOpen;
   if (sortfiles <> nil) and (sortfiles <> files) then
      sortfiles.Free;
   files.Free;
   files := nil;
   sortfiles := nil;
   ecrec.Clear;
   ZipIsBad := False;
   filesDate := 0;
   FNumDisks := 1;
   MultiMode := mmNone;
   if not ArchiveIsStream then
      FZipName := '';
end;

procedure TVCLUnZip.ReadZip;
var
   TryAgain              : Boolean;
   RememberKeepZipOpen   : Boolean;
   OldBusy               : Boolean;
   OldOperationMode      : TOperationMode;
begin
   CancelOperation := False;
   FImproperZip := False;
   OldBusy := SetBusy(True);
   OldOperationMode := SetOperationMode(omUnZip);
   try
    repeat
      TryAgain := False;
      try
         OpenZip;
      except
         on EIncompleteZip do
         begin
            { zip file must be closed in this case  1/25/00 2.20+  }
            RememberKeepZipOpen := KeepZipOpen;
            KeepZipOpen := False;
            CloseZip;
            KeepZipOpen := RememberKeepZipOpen;
            if Assigned(FOnIncompleteZip) then
               tryagain := True;
         end;
      else
         begin
            ClearZip;
            raise; { raise the exception so the application knows }
         end;
      end;
    until (TryAgain = False);
   finally
     CloseZip;
     SetOperationMode(OldOperationMode);
     SetBusy(OldBusy);
   end;
end;

procedure TVCLUnZip.GetFileInfo(infoFile: TkpStream);
var
   finfo                 : TZipHeaderInfo;

   function ReadZipHardWay: Boolean;
   var
      sig                : Byte;
      AmtRead            : BIGINT;
      CancelCheck        : LongInt;
      VerNeeded          : WORD;
   begin
      Result := False;
      if ZipIsBad then  { We've already called this procedure }
        exit;
      ZipIsBad := True;
      FImproperZip := True;
      CancelCheck := 0;
      if files <> nil then
      begin
         files.Free;
         files := nil;
         sortfiles := nil; { to avoid GPF in ClearZip if badzipfile 10/4/01  2.22+ }
      en