main.pas

ziptv为delphi控件

            Begin
               If Not (htCentral In HeaderTypeState) Then
               Begin
                  WithFileSize := LocalZipHeader.zc.UnpackedSize;
                  WithFileDate := ztvConvertDate(LocalZipHeader.zc.FileDate);
               End
               Else
               Begin
                  WithFileSize := CentralZipHeader.zc.UnpackedSize;
                  WithFileDate := ztvConvertDate(CentralZipHeader.zc.FileDate);
               End;
            End;
         atZoo:
            Begin
               WithFileSize := ZooDirHeader.UnpackedSize;
               WithFileDate := ztvConvertDate(ZooDirHeader.FileDate);
            End;
      End;

   With frmOverwrite {unit3} Do
   Begin
      Edit1.Text := FileName;           //set the frmOverwrite.Edit1 control text
      Label8.Caption := FileName;
      Label9.Caption := IntToStr(ReplaceFileSize) + ' bytes, ' +
         DateTimeToStr(ReplaceFileDate);
      Label10.Caption := ExtractFilename(FileName);
      Label11.Caption := IntToStr(WithFileSize) + ' bytes, ' +
         DateTimeToStr(WithFileDate);
      FormResult := ShowModal();        //show the frmOverwrite form
      NewFileName := Edit1.Text;        //assign the NewFilename parameter
   End;

   Case FormResult Of
      mrNo: OverwriteMode := omSkip;
      mrYes: OverwriteMode := omOverwrite;
      mrCancel: TZipCommon(Sender).Cancel := True;
   End;

   TZipCommon(Sender).ConfirmOverwrites := Not frmOverwrite.CheckBox1.Checked;
End;
//-------------------------------------------------------------
(* OnBegin Event -
 All decompression components share this event.
  Triggered prior to extracting individual files. *)

Procedure TfrmMain.UnZIP1Begin(Sender: TObject; FName: String; Count: Integer; Var
   Extract: Boolean);
Begin
   StatusBar1.SimpleText := 'Extracting: ' +
      MinimizeName(FName, StatusBar1.Canvas, StatusBar1.Width);
   StatusBar1.Update();
End;
//-------------------------------------------------------------
(* OnEnd Event -
 All decompression components share this event
  Triggered after extracting individual files. *)

Procedure TfrmMain.UnZIP1End(Sender: TObject; FileName: String; CRC_PASS: Boolean);
Begin
   If Not CRC_PASS Then
      ZipTV1Error(Sender, FileName, '', '0', E_CRCERROR);
End;
//-------------------------------------------------------------
(* OnGetPassword event *)
(* All compression and decompression components share this event.
(* Triggered when an archive requires a password for encryption or
(* decryption.
(*
(* The default for the "PasswordAttempts property" is 3.  Using the default
(* for PasswordAttempts, this event will activate 3 times... giving the user
(* 3 guesses at a password before moving on to the next compressed file.
(*
(* This event is activated before a decompression component's OnBegin event. *)
(* If a valid password is not determined, the file will be bypassed as well  *)
(* as the OnBegin and OnEnd events.                                          *)
(*                                                                           *)
(* Default value for the TryAgain parameter = True                           *)

Procedure TfrmMain.UnZIP1GetPassword(Sender: TObject; FileName: String;
   Var Password: String; Var TryAgain: Boolean);
Begin

   (* InputQuery is a Delphi function *)
   If Not InputQuery(
      'Enter password...',
      LowerCase(ExtractFilename(FileName)), Password) Then
      TryAgain := False;

End;
//-------------------------------------------------------------
(* OnActivate event -
   -Shared by all compression components.
   -Triggered just prior adding, moving, deleting compressed files *)

Procedure TfrmMain.Zip1Activate(Sender: TObject);
Begin
   StatusBar1.SimplePanel := True;
   ProgressBar1.Position := 0;
   ProgressBar2.Position := 0;
   ProgressBar1.Visible := True;
   ProgressBar2.Visible := True;
   ApplicationBusy();
End;
//-------------------------------------------------------------
(* OnDeactivate event -
   -Shared by all compression components.
   -Triggered after all files matching the FileSpec property
    have been compressed. *)

Procedure TfrmMain.Zip1Deactivate(Sender: TObject);
Begin
   ApplicationWaiting();
   DisplayTotals(SELECTALL);
End;
//-------------------------------------------------------------
(* OnBegin event -
   Shared by all compression components on this form.
   Triggered just prior compressing individual files. *)

Procedure TfrmMain.Zip1Begin(Sender: TObject; FName: String; Count: Integer;
   Var Extract: Boolean);
Begin                                   (* CompBase is the parent class for all	*)
   (* compression components 						*)
   If TCompBASE(Sender).Switch <> swDelete Then
      StatusBar1.SimpleText := 'Compressing: ' +
         MinimizeName(FName, StatusBar1.Canvas, StatusBar1.Width)
   Else
      StatusBar1.SimpleText := 'Deleting: ' +
         MinimizeName(FName, StatusBar1.Canvas, StatusBar1.Width);
End;
//-------------------------------------------------------------
(* OnEnd event -
  Shared by all compression components.
   Triggered after compressing an individual file to an archive *)

Procedure TfrmMain.Zip1End(Sender: TObject; FN: String; CRC_PASS: Boolean);
Begin
   StatusBar1.SimpleText := '';
End;
//-------------------------------------------------------------
(* OnNonWriteableArchive event                                            *)
(*                                                                        *)
(* Shared by all compression components                                   *)
(*                                                                        *)
(* Triggered when ArchiveFile already exists and the files attribute      *)
(* is non-writeable (a file-attribute other than faNormal or faArchive).  *)
(*                                                                        *)
(* Parameter 'WriteToFile':                                               *)
(* 1. This parameter's default is false.  If not changed within this      *)
(*    event the active process is terminated.                             *)
(* 2. If this event is not assigned, the active process is terminated if  *)
(*    the existing file is determined to contain a non-writable attribute,*)
(*    this condition is routed through the OnError event.                 *)
(*                                                                        *)

Procedure TfrmMain.Zip1NonWriteableArchive(Sender: TObject;
   ArchiveFile: String; Var WriteToFile: Boolean);
Begin
   If MessageDlg(ArchiveFile + ' is ReadOnly, SysFile, or Hidden file...'#13#13 +
      'Write to this file?',
      mtConfirmation, [mbYes, mbNo], 0) = mrYes Then
      WriteToFile := True;
End;
//-------------------------------------------------------------
(* OnRecurseDir event -
  Shared by all compression components.
   Triggered when a directory has changed when directory recursion
   was chosen. *)

Procedure TfrmMain.Zip1RecurseDir(Sender: TObject; Directory: String);
Begin
   StatusBar1.SimpleText := 'Scanning dir: ' +
      MinimizeName(Directory, StatusBar1.Canvas, StatusBar1.Width);
End;
//-------------------------------------------------------------
(* OnRenameDupeFile event *)
(*                                                                       *)
(* Shared by most compression components (isn't available in single file *)
(* compression components).                                              *)
(*                                                                       *)
(* Activated when an matching file is found to already exist in the      *)
(* archive.  This file will match exactly the one existing in the        *)
(* archive (thus the "Dup" in OnRename"Dup"File).                        *)
(*                                                                       *)
(* IMPORTANT: Files matching only file-name, are processed through the   *)
(* OnReplaceFile event.  This allows the developer to compare file dates *)
(* to determine if an older file (than the existing one) is to be        *)
(* in the archive.                                                       *)
(*                                                                       *)
(* Used instead of the OnFileExists event in compressor components.  The *)
(* TZip component does include a OnFileExists event, but it's used for   *)
(* diskette spanning purposes only.                                      *)
(*                                                                       *)
(* This event is activated when attempting to add a file which already   *)
(* exists in the archive.  The OnReplaceFile is activated prior to this  *)
(* event.  If the OnReplaceFile event's "replace" parameter is true,     *)
(* this event will be bypassed.  The choice is to either replace or      *)
(* rename the existing file.                                             *)
(*                                                                       *)
(* FileName parameter:                                                   *)
(* 1. When this event is activated, this parameter contains the name of  *)
(*    of the file in que for compression, which contains a FileName that *)
(*    is found to already exist within the archive.                      *)
(*                                                                       *)
(* NewFileName parameter:                                                *)
(* 1. If the value is returned as a blank or the same value as the       *)
(*    "FileName parameter" the original FileName is assumed and          *)
(*    and compression of this file is bypassed since it already exists.  *)
(* 2. If the value is assigned a different FileName, but one that	also   *)
(*    exists in the archive, OnRenameDupeFile will repeatedly be called  *)
(*    until either the original FileName, a blank value, or a FileName   *)
(*    that doesn't already exist in the archive is returned.             *)
(* 3. If a unique value (a name other than the value of "FileName" is    *)
(*    returned, the file already existing in the archive is the one that *)
(*    is renamed.  The file currently in que for compression will retain *)
(*    the current name.                                                  *)
(*                                                                       *)

Procedure TfrmMain.Zip1RenameDupeFile(Sender: TObject; FileName: String;
   Var NewFileName: String; Var Rename: Boolean);
Begin
   Application.ProcessMessages;
   If InputQuery('OnRenameDupeFile event',
      'File exists... rename existing file as:',
      FileName) Then
      NewFileName := FileName
   Else
      Rename := False;
End;
//-------------------------------------------------------------
(* OnReplaceFile event *)
(* Shared by all compression components.                              *)
(* Triggered when an file was found to already exist in an archive.   *)
(*                                                                    *)
(* Prior to the activation of this event, a comparison is made to     *)
(* determine if the file in que for compression has changed from that *)
(* which already exists in the archive.  If the following comparisons *)
(* match, the file is determined to be unchanged and therefore        *)
(* removed from the que for compression:                              *)
(* 1. file attribute                                                  *)
(* 2. file size                                                       *)
(* 3. file date                                                       *)
(*                                                                    *)
(* "Replace" parameter:                                               *)
(* 1. The default is false.                                           *)
(*    If the value is not set to true within this event (or if this   *)
(*    event is not assigned, the file that exists in the archive      *)
(*    remains and the file in que (which has the same FileName) for   *)
(*    compression is bypassed.                                        *)
(* 2. If the value of this parameter is returned as true, the file    *)
(*    which already exists in the archive will be replaced by the     *)
(*    file in que for compression.                                    *)
(* 3. If the value of this parameter is returned as false, the        *)
(*    OnRenameExistingFile event will activate.  For more info on     *)
(*    event, see it's description & rules also in this demo.          *)
(*                                                                    *)

Procedure TfrmMain.Zip1ReplaceFile(Sender: TObject; FileName,
   NewFileName: String; Date, NewDate: TDateTime; FileSize,
   NewFileSize: Int64; Attr, NewAttr: Integer; Var Replace: Boolean);
Const
   CRL = #32#32#32;
Var
   Msg: AnsiString;
Begin

   (* In this demo, we use a simple dialog box.  It would be preferable to  *)
   (* display a form with additional reponse buttons which might include    *)
   (* 'Yes to all', 'No to all'.  See example in procedure UnZIP1FileExists *)
   (* in this demo.                                                         *)
   Msg :=
      'REPLACE:' + #13 +
      CRL + FileName + #13 +
      CRL + 'Size: ' + IntToStr(FileSize) + #13 +
      CRL + 'Date: ' + FormatDateTime('mm/dd/yy hh:mm am/pm', Date) + #13 +
      CRL + 'Attr: ' + TZipCommon(Sender).FileAttrToString(Attr, Byte('_')) +
      '  (' + IntToStr(Attr) + ')' + #13#13 +

   'WITH:' + #13 +
      CRL + NewFileName + #13 +
      CRL + 'Size: ' + IntToStr(NewFileSize) + #13 +
      CRL + 'Date: ' + FormatDateTime('mm/dd/yy hh:mm am/pm', NewDate) + #13 +
      CRL + 'Attr: ' + TZipCommon(Sender).FileAttrToString(NewAttr, Byte('_')) +
      '  (' + IntToStr(NewAttr) + ')';

   If MessageDlg(Msg, mtConfirmation, [mbYes, mbNo], 0) = mrYes Then
      Replace := True;

End;
//-------------------------------------------------------------
(* OnNextVolume event -
  Shared by TZipTV, TUnZip, TUnArj, TUnCab, TUnRar, and TUUDecode
   components.

   Triggered with each new volume, even if the volume was
   found to exist on the current disk and path.  Continous,
   uninterrupted processing can be achieved by checking the
   FExists (Boolean) parameter. *)

Procedure TfrmMain.ZipTV1NextVolume(Sender: TObject; Var VolumeName: String;
   VolumeID: Integer; FExists: Boolean; Var Cancel: Boolean);
Var
   NewFile, Prompt, Caption: String;
Begin
	Cancel := False;

   If Not FExists Then                  (* FExists = FileExists *)
   Begin
      Caption := ExtractFilename(VolumeName);
      Prompt := 'Volume ID: ' + IntToStr(VolumeID);
      NewFile := VolumeName;

      If Not InputQuery(Caption, Prompt, NewFile) Then
         Cancel := True
      Else
         VolumeName := NewFile;
   End;
End;
//-------------------------------------------------------------
(* OnActivate event - ZipTV1 *)

Procedure TfrmMain.ZipTV1Activate(Sender: TObject);
Var
   CmntStrm: TStream;
   frmComment: TfrmComment;
Begin
   // if archive contains a comment, display it
   With ZipTV1 Do
      Case ArcType Of

         atJar..atJarExe,
            atZip..atZipMV:

            Begin
               If (htEnding In HeaderTypeState) And
                  (EndZipHeader.CommentLen > 0) And
                  (ArchiveCommentPos > 0) And
                  (ArchiveCommentPos < FLOF) Then
               Begin
                  CmntStrm := TMemoryStream.Create();
                  Try
                     ZipTV1.inStream.Position := ArchiveCommentPos;

                     // convert a ZipTV TStream32 to Delphi compatible TStream,
                     // for use with Memo1.Lines.LoadFromStream
                     ztvStreams.ztvStreamToTStream(inStream, CmntStrm, inStream.Size -
                        ArchiveCommentPos);

                     frmComment := TfrmComment.Create(Self) {unit9};
                     Try
                        frmComment.Memo1.Lines.LoadFromStream(CmntStrm);
                        frmComment.ShowModal();
                        frmComment.Memo1.Lines.Clear();
                     Finally