vclunzip.pas

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

      FFilesList.Free;
   if (FRelativePathList <> nil) then
      FRelativePathList.Free;
   inherited Destroy;
end;

procedure TVCLUnZip.Loaded;
begin
   inherited Loaded;
   FThisVersion := kpThisVersion; { Moved here from constructor 4/22/98 2.11 }
   FThisBuild := kpThisBuild;
   if (file_info <> nil) then     { 4/22/02  2.23+ }
     file_info.OEMConvert := FOEMConvert;
end;

procedure TVCLUnZip.Assign(Source: TPersistent);        { 6/27/99 2.18+ }
begin
   if source is TVCLUnZip then
   begin
      FZipName := TVCLUnZip(Source).GetZipName;
      FDestDir := TVCLUnZip(Source).GetDestDir;
      FRootDir := TVCLUnZip(Source).FRootDir;
      FSortMode := TVCLUnZip(Source).SortMode;
      FRecreateDir := TVCLUnZip(Source).RecreateDirs;
      FOverwriteMode := TVCLUnZip(Source).OverwriteMode;
      FFilesList.Assign(TVCLUnZip(Source).FilesList);
      FRelativePathList.Assign(TVCLUnZip(Source).RelativePathList);
      FDoAll := TVCLUnZip(Source).DoAll;
      FIncompleteZipMode := TVCLUnZip(Source).IncompleteZipMode;
      FKeepZipOpen := TVCLUnZip(Source).KeepZipOpen;
      FDoProcessMessages := TVCLUnZip(Source).DoProcessMessages;
      FRetainAttributes := TVCLUnZip(Source).RetainAttributes;
      FReplaceReadOnly := TVCLUnZip(Source).ReplaceReadOnly;

      FOnStartUnZipInfo := TVCLUnZip(Source).OnStartUnzipInfo;
      FOnFilePercentDone := TVCLUnZip(Source).OnFilePercentDone;
      FOnTotalPercentDone := TVCLUnZip(Source).OnTotalPercentDone;
      FOnStartUnZip := TVCLUnZip(Source).OnStartUnZip;
      FOnEndUnZip := TVCLUnZip(Source).OnEndUnZip;
      FOnPromptForOverwrite := TVCLUnZip(Source).OnPromptForOverwrite;
      FOnSkippingFile := TVCLUnZip(Source).OnSkippingFile;
      FOnBadPassword := TVCLUnZip(Source).OnBadPassword;
      FOnBadCRC := TVCLUnZip(Source).OnBadCRC;
      FOnInCompleteZip := TVCLUnZip(Source).OnInCompleteZip;
      FOnGetNextDisk := TVCLUnZip(Source).OnGetNextDisk;
      FOnUnzipComplete := TVCLUnzip(Source).OnUnZipComplete;
      FOnGetNextBuffer := TVCLUnzip(Source).OnGetNextBuffer;
      FOnFileNameForSplitPart :=  TVCLUnzip(Source).OnFileNameForSplitPart;
   end
   else
      inherited Assign(Source);
end;

procedure TVCLUnZip.SetZipName(ZName: string);
var
   tempZipName           : string;
   Canceled              : Boolean;
   fnamepos                  : integer;
begin
   if (csDesigning in ComponentState) then
   begin                                                { 4/20/98 2.11 }
      FZipName := ZName;
      exit;
   end;
   if AnsiCompareText(ZName, FZipName) = 0 then
      exit;
   Canceled := False;
   {$IFNDEF KPSMALL}
   if (ZName <> '') and (ZName[Length(ZName)] = '?') then
   begin
      OpenZipDlg := TOpenDialog.Create(Application);
      try
         OpenZipDlg.Title := LoadStr(IDS_OPENZIP);
         OpenZipDlg.Filter := LoadStr(IDS_ZIPNAMEFILTER);
         if DirExists(ExtractFilePath(ZName)) then
            OpenZipDlg.InitialDir := ExtractFilePath(ZName)
         else
            OpenZipDlg.InitialDir := 'C:\';
         if OpenZipDlg.Execute then
            tempZipName := OpenZipDlg.Filename
         else
            Canceled := True;
      finally
         OpenZipDlg.Free;
      end;
   end
   else
      {$ENDIF}
      tempZipName := ZName;

   if not Canceled then
   begin
      FZipName := tempZipName;
      // Get filename without extension
      tempZipName := ExtractFileName(FZipName);
      fnamepos := Pos(tempZipName,FZipName)-1;
      fnamepos := fnamepos + Pos('.',Copy(FZipName,fnamepos,Length(FZipName)-fnamepos))-1;
      FZipNameNoExtension := LeftStr(FZipName,fnamepos-1);
      if (sortfiles <> nil) and (FSortMode <> ByNone) then
         sortfiles.Free;
      sortfiles := nil;
      files.Free;
      files := nil;
      filesDate := 0;
      ecrec.Clear;
      theZipFile.Free;
      theZipFile := nil;
      ZipIsBad := False;
      ArchiveIsStream := False;
   end
   else
      raise EUserCanceled.Create(LoadStr(IDS_CANCELZIPNAME));
end;

function TVCLUnZip.GetZipName: string;
begin
   Result := FZipName;
end;

procedure TVCLUnZip.SetArchiveStream(theStream: TkpStream);
begin
   if theStream = nil then
      theZipFile := nil;
   ClearZip;
   theZipFile := theStream;
   if theZipFile <> nil then
   begin
      FKeepZipOpen := True;
      ArchiveIsStream := True;
   end
   else
      ArchiveIsStream := False;
end;

procedure TVCLUnZip.SetDestDir(DDir: string);
{$IFNDEF KPSMALL}
var
   theDir                : string;
   {$ENDIF}
begin
   {$IFNDEF KPSMALL}
   if DDir = '?' then
   begin
      theDir := FDestDir;
      if not DirExists(theDir + '\') then
         GetDirectory(0, theDir);
      {$IFNDEF WIN32}
      {$IFNDEF NOLONGNAMES}
      if OSVersion > 3 then
         theDir := LFN_ConvertLFName(theDir, SHORTEN);
      {$ENDIF}
      {$ENDIF}
      if SelectDirectory(theDir, [sdAllowCreate, sdPerformCreate, sdPrompt], 0) then
         FDestDir := theDir
      else
         raise EUserCanceled.Create(LoadStr(IDS_CANCELDESTDIR));
   end
   else
      {$ENDIF}
      FDestDir := DDir;

   if (FDestDir <> '') and (FDestDir[Length(FDestDir)] = '\') then { Remove slash }
      SetLength(FDestDir, Length(FDestDir) - 1);
end;

function TVCLUnZip.GetDestDir: string;
begin
   Result := FDestDir;
end;

procedure TVCLUnZip.SetRootDir(Value: string);
begin
   if Length(Value) > 0 then
   begin
      if RightStr(Value, 1) <> '\' then
         FRootDir := Value + '\'
      else
         FRootDir := Value;
   end
   else
      FRootDir := '';
   FRelativePathList.Clear;
   FRelativePathList.Add(FRootDir);
end;

function TVCLUnZip.StripRelativePath( var path: String ): String;
var
  i: Integer;
begin
  for i := 0 to FRelativePathList.Count-1 do
   begin
      if (AnsiCompareText(LeftStr(path,Length(FRelativePathList[i])),FRelativePathList[i]) = 0) then
       begin
        Delete(path,1,Length(RelativePathList[i]));
        break;
       end;
   end;
   Result := path;
end;

procedure TVCLUnZip.SetFilesList(Value: TStrings);
begin
   FFilesList.Assign(Value);
end;

{ List Properties }

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

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

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

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

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

function TVCLUnZip.GetDateTime(Index: Integer): TDateTime;
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      try
         Result := FileDateToDateTime(finfo.last_mod_file_date_time)
      except
         Result := Now;
      end;
   end
   else
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
end;

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

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

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

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

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

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

function TVCLUnZip.GetZipHasComment: Boolean;
begin
   Result := ecrec.zip_comment_length > 0;
end;

function TVCLUnZip.GetFileComment(Index: Integer): string;
var
   finfo                 : TZipHeaderInfo;
   crec                  : central_file_header;
   CommentLength         : LongInt;
   RememberModified      : Boolean;
   RememberPosition      : BIGINT;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      with finfo do
      begin
         if HasComment then
         begin
            RememberPosition := 0;
            if finfo.filecomment = nil then
            try
               OpenZip;
               RememberPosition := theZipFile.Position;
               theZipFile.Seek(central_offset, soBeginning);
               theZipFile.Read(crec, SizeOf(central_file_header));
               with crec do
               begin