vclunzip.pas

一个delphi中压缩的组件VCLZip

   ZipIsBad := False;
   theZipFile := nil;
   files := nil;
   sortfiles := nil;
   FIncompleteZipMode := izAssumeMulti;
   ecrec := TEndCentral.Create;
   CancelOperation := False;
   FKeepZipOpen := False;
   FDoProcessMessages := True;
   FCheckDiskLabels := True;
   StreamZipping := False;
   MemZipping := False;
   MemBuffer := nil;
   MemLen := 0;
   ArchiveIsStream := False;
   Fixing := False;
   FNumDisks := 1;
   CurrentDisk := 0;
   FRetainAttributes := True;
   FBusy := False;
   FTestMode := False;
   FThisVersion := kpThisVersion;
   FReplaceReadOnly := False;                           { 03/09/99  2.17+ }
   FNumSelected := 0;
   FBufferLength := 0;
   FImproperZip := False;
   FBufferedStreamSize := DEF_BUFSTREAMSIZE;
   FEncryptBeforeCompress := False;
   FOEMConvert := True;                                 { 2/17/02 2.22+ }
   if not (csDesigning in ComponentState) then          { added this line 03/09/99 2.17+ }
      FOnGetNextDisk := DefaultGetNextDisk;
   {$IFDEF KPDEMO}
   if not (csDesigning in ComponentState) then
   begin
      DR := DelphiIsRunning;
      if not DelphiIsRunning then
      begin
         {$IFDEF NO_RES}
         MessageBox(0,
            'This unregistered verion of VCLZip will only run while the Delphi IDE is running',
            'Warning', mb_OK);
         {$ELSE}
         tmpMStr := LoadStr(IDS_NOTREGISTERED);
         tmpMStr2 := LoadStr(IDS_WARNING);
         MessageBox(0, StringAsPChar(tmpMStr), StringAsPChar(tmpMStr2), mb_OK);
         {$ENDIF}
         Abort;
      end;
   end;
   {$ENDIF}
end;

destructor TVCLUnZip.Destroy;
begin
   ClearZip;
   if (file_info <> nil) then
      file_info.Free;
   if (ecrec <> nil) then
      ecrec.Free;
   { Moved folowing down two lines 7/10/98  2.13 }
   { Due to a user's reporting that it stopped him from getting "Invalid Pointer Operation"
   { errors.  I was unable to duplicate the problem but the move is safe enough  }
   if (FFilesList <> nil) then
      FFilesList.Free;
   inherited Destroy;
end;

procedure TVCLUnZip.Loaded;
begin
   inherited Loaded;
   FThisVersion := kpThisVersion; { Moved here from constructor 4/22/98 2.11 }
   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);
      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;
   end
   else
      inherited Assign(Source);
end;

procedure TVCLUnZip.SetZipName(ZName: string);
var
   tempZipName           : string;
   Canceled              : Boolean;
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
         {$IFDEF NO_RES}
         OpenZipDlg.Title := 'Open a Zip File';
         OpenZipDlg.Filter := 'Zip Files (*.ZIP)|*.zip|SFX Files (*.EXE)|*.exe|' +
            'Jar Files (*.JAR)|*.jar|All Files (*.*)|*.*';
         {$ELSE}
         OpenZipDlg.Title := LoadStr(IDS_OPENZIP);
         OpenZipDlg.Filter := LoadStr(IDS_ZIPNAMEFILTER);
         {$ENDIF}
         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;
      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
      {$IFDEF NO_RES}
      raise EUserCanceled.Create('User canceled setting zip file name.');
   {$ELSE}
      raise EUserCanceled.Create(LoadStr(IDS_CANCELZIPNAME));
   {$ENDIF}
end;

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

procedure TVCLUnZip.SetArchiveStream(theStream: TStream);
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
         {$IFDEF NO_RES}
         raise EUserCanceled.Create('User canceled Set Desination Directory');
      {$ELSE}
         raise EUserCanceled.Create(LoadStr(IDS_CANCELDESTDIR));
      {$ENDIF}
   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 := '';
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
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
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
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
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
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
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
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
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
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
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
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
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
      {$IFDEF NO_RES}
      raise EListError.CreateFmt('Index %d is out of range', [Index]);
   {$ELSE}
      raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
   {$ENDIF}
end;

function TVCLUnZip.GetCompressedSize(Index: Integer): LongInt;
var
   finfo                 : TZipHeaderInfo;
begin
   if (Index > -1) and (Index < Count) then
   begin
      finfo := sortfiles.Items[Index] as TZipHeaderInfo;
      Result := finfo.compressed_size;
   end
   else
      {$IFDEF NO_RES}