?? main.pas
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -