⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 ziptv为delphi控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
(*
  There is a conditional define available in this demo source.  To use Borlands
  TListView control remove the dot in the $define line later in this module...
  the line will be: {.$DEFINE USE_LISTVIEW}.  With the dot removed, the
  TListView is used, with it present... the TZipView control (faster) is used.

  Right click on the list of found positions to view the position of a text
  file.

  All files extracted by this demo are deleted upon exit from the application.
  Directories created (subdirs of the temp directory) are not removed.  It is
  the responsibility of the developer to track and remove these directories.

  *Properties for TZipSearch are assigned in the search button's OnClick event.




  NOTES:
	v6.4.3: TztvSearchTypes:
   	removed stProtected & stMultiVolume members from the set.

      old defination:
      	TztvSearchTypes = (stDecompress, stNonArchive, stProtected, stMultiVolume);

      new defination:
      	TztvSearchTypes = (stDecompress, stNonArchive);

		The functionality these two members provided is still available.
      	stProtected   -> assignment of OnGetPassword serves the same purpose
         stMultiVolume -> assignment of OnNextVolume  serves the same purpose

  *)
Unit Unit1;

Interface

{$I compiler.inc}
{$IFDEF DEL6_OR_HIGHER}
{$WARN UNIT_PLATFORM OFF}
{$ENDIF}

Uses
   Windows,
   Messages,
   SysUtils,
   Classes,
   Graphics,
   Controls,
   Forms,
   Dialogs,
   Menus,
   StdCtrls,
   Buttons,
   ExtCtrls,
   ComCtrls,
   FileCtrl,

   ztvBase,
   ztvGbls,
   ztvZipSearch,
   ztvUnGZip,
   ztvUnTar,
   ztvUnCab,
   ztvUnZoo,
   ztvUnZip,
   ztvUnLha,
   ztvUnBh,
   ztvUnArj,
   ztvUnArc,
   ztvUnAce2,
   ztvUnRar,
   ztvUnJar,
   ztvZipView,
   Err_Msgs,
   ztvZipTV,
   ztvRegister,
   ztvZip,
   ztvFileIo;

Type
   TForm1 = Class(TForm)
      PopupMenu1: TPopupMenu;
      MainMenu1: TMainMenu;
      ActivityLog: TMenuItem;
      Exit1: TMenuItem;
      File1: TMenuItem;
      Open1: TMenuItem;
      View1: TMenuItem;
      View2: TMenuItem;
      mnuDisplayElapsedTime1: TMenuItem;

      btnCancel: TButton;
      btnExclude: TButton;
      btnOK: TButton;
      btnOpen: TBitBtn;
      CheckBox1: TCheckBox;
      CheckBox2: TCheckBox;
      CheckBox3: TCheckBox;
      CheckBox4: TCheckBox;
      Edit1: TEdit;
      Edit2: TEdit;
      Edit3: TEdit;
      Edit4: TEdit;
      Edit5: TEdit;
      Edit6: TEdit;
      Edit7: TEdit;
      Label1: TLabel;                   (* Search For *)
      Label2: TLabel;                   (* FileSpec *)
      Label3: TLabel;                   (* ArchiveFile *)
      Label4: TLabel;
      Label5: TLabel;
      Label6: TLabel;
      Label7: TLabel;
      Panel1: TPanel;
      Panel2: TPanel;
      Panel3: TPanel;
      ComboBox1: TComboBox;             (* SearchMode property selection *)
      ListView1: TListView;
      OpenDialog1: TOpenDialog;
      RadioGroup1: TRadioGroup;
      ZipSearch1: TZipSearch;
      ZipTV1: TZipTV;
      ZipView1: TZipView;
    ProgressBar1: TProgressBar;

      (* Form\menu\button related procedures *)
      Procedure FormActivate(Sender: TObject);
      Procedure FormCreate(Sender: TObject);
      Procedure FormDestroy(Sender: TObject);
      Procedure Open1Click(Sender: TObject);
      Procedure View1Click(Sender: TObject);
      Procedure ViewFile(method: Byte);
      Procedure btnOpenClick(Sender: TObject); (* cancel *)
      Procedure btnOKClick(Sender: TObject);
      Procedure btnExcludeClick(Sender: TObject);
      Procedure btnCancelClick(Sender: TObject);
      Procedure ActivityLogClick(Sender: TObject);
      Procedure mnuDisplayElapsedTime1Click(Sender: TObject);

      (* Edit control procedures *)
      Procedure Edit2Change(Sender: TObject);
      Procedure Edit4Change(Sender: TObject);
      Procedure Edit5Change(Sender: TObject);

      Procedure ZipView1Click(Sender: TObject; Row, Col: Integer);
      Procedure ListView1Click(Sender: TObject);
      Function ExtractForViewing: Boolean;

      (* ZipSearch events *)
      Procedure ZipSearch1Activate(Sender: TObject);
      Procedure ZipSearch1Deactivate(Sender: TObject);
      Procedure ZipSearch1ElapsedTime(Sender: TObject; ElapsedTime: Single);
      Procedure ZipSearch1Error(Sender: TObject; FileName, ExtendedMsg,
      	VolumeID: String; ECode: Integer);
      Procedure ZipSearch1SearchBegin(Sender: TObject; FileName: String;
      	Count: Integer; Var SearchThisFile: Boolean);
      Procedure ZipSearch1SearchEnd(Sender: TObject; Matches: Integer);
      Procedure ZipSearch1Finish(Sender: TObject; files, Matches, Bytes: Integer);
      Procedure ZipSearch1GetZipFirstDisk(Sender: TObject; Var Cancel: Boolean);
      Procedure ZipSearch1GetZipNextDisk(Sender: TObject; VolumeName: String;
         Var Cancel: Boolean);
      Procedure ZipSearch1GetZipLastDisk(Sender: TObject; Var Cancel: Boolean);
      Procedure ZipSearch1Match(Sender: TObject; FileName: String; Offset: Integer);
      Procedure ZipSearch1MatchInFile(Sender: TObject; SearchFile: String);
      Procedure ZipSearch1ExcludeFile(Sender: TObject; FileName: String);
      Procedure ZipSearch1ChangeSearchFile(Sender: TObject; FileName: String);
      Procedure ZipSearch1ChangeDir(Sender: TObject; Dir: String);
    	Procedure ZipSearch1Progress(Sender: TObject; ByFile, ByArchive: Byte);
      Procedure ZipSearch1GetPassword(Sender: TObject; FileName: String;
      	Var Password: String; Var TryAgain: Boolean);
      Procedure ZipSearch1NextVolume(Sender: TObject; Var VolumeName: String;
         VolumeID: Integer; FExists: Boolean; Var Cancel: Boolean);
   Private
   Public
   End;

Var
   Form1: TForm1;

Implementation

{$R *.DFM}

{.$DEFINE USE_LISTVIEW}// use the TListView control instead of TZipView?

Uses
   Viewer,
   Unit2,
   Unit3;

Const
   (* Column Headers *)
   COLUMN_FILENAME = 0;
   COLUMN_POSITION = 1;
   COLUMN_ARCHIVE = 2;

Var
	Busy: Boolean;
   ExtractedFileList: TStringList;
   // Track a list of archives already displayed to prevent filling the memo
   // control with duplicate archive filenames.
   DumpArchiveList: TStringList;


//-------------------------------------------------------------
(* Fill form controls with ZipControl property values *)

Procedure TForm1.FormActivate(Sender: TObject);
Begin
	Busy := False;

{$ifdef debug_proj}
	// load form controls with predefined values
   Edit1.Text := 'd:\3\bh\*.bh';
   Edit2.Text := 'procedure';
   Edit3.Text := '*.*';
{$else}
	// load form controls with ZipSearch1 values (set via object inspector}
   Edit1.Text := ZipSearch1.ArchiveFile;
   Edit2.Text := ZipSearch1.SearchText;
   If ZipSearch1.FileSpec.Count > 0 Then
      Edit3.Text := ZipSearch1.FileSpec[0]
   Else
      Edit3.Text := '*.*';
{$endif debug_proj}


   ComboBox1.ItemIndex := Ord(ZipSearch1.SearchMode);
   RadioGroup1.ItemIndex := Ord(ZipSearch1.SearchFind);

   CheckBox1.Checked := (stDecompress In ZipSearch1.SearchType);
   CheckBox2.Checked := (stNonArchive In ZipSearch1.SearchType);
   CheckBox3.Checked := ZipSearch1.RecurseDirs;
   CheckBox4.Checked := ZipSearch1.CaseSensitive;

   Edit2Change(Sender);                 (* Enable/Disable OK button *)
End;

//-------------------------------------------------------------
(* OnSearchBegin event -
See notes in ztvZipSearch or the help file for usage.

The event param "SearchThisFile" default is true.  If the value of
SearchThisFile is false, the active file (Filename) will NOT be searched *)

Procedure TForm1.ZipSearch1SearchBegin(Sender: TObject; FileName: String; Count: Integer;
   Var SearchThisFile: Boolean);
Begin
   Edit7.Text := ShortName(Edit7.Handle, FileName);
End;
//-------------------------------------------------------------

(* OnSearchEnd event *)

Procedure TForm1.ZipSearch1SearchEnd(Sender: TObject; Matches: Integer);
Begin
   //Edit6.Text := '';
   ProgressBar1.Position := 0;
End;
//-------------------------------------------------------------
(*
	OnMatchInFile event - activates once for each compressed
 	file contained in an archive, passing the compressed filename
   prior searching it *)

Procedure TForm1.ZipSearch1MatchInFile(Sender: TObject; SearchFile: String);
Begin
   Edit6.Text := ShortName(Edit6.Handle, SearchFile);
End;
//-------------------------------------------------------------
(* *** OnMatch event -- activated when a match is found *** *)

Procedure TForm1.ZipSearch1Match(Sender: TObject; FileName: String; Offset: Integer);
{$IFDEF USE_LISTVIEW}
Var
   ListItem: TListItem;
Begin
   ListItem := ListView1.Items.Add;
   ListItem.Caption := FileName;
   ListItem.SubItems.Add(IntToStr(Offset));
   ListItem.SubItems.Add(ZipSearch1.ArchiveFile);
{$ELSE}
Begin
   With ZipView1 Do
      Items.Add(FileName + Delimiter +
         IntToStr(Offset) + Delimiter +
         ZipSearch1.ArchiveFile);
{$ENDIF}
End;
//-------------------------------------------------------------

Procedure TForm1.ZipSearch1Activate(Sender: TObject);
Begin
{$IFDEF USE_LISTVIEW}
   ListView1.Items.BeginUpdate;
{$ELSE}
   ZipView1.Items.BeginUpdate;
{$ENDIF}
End;
//-------------------------------------------------------------

Procedure TForm1.ZipSearch1Deactivate(Sender: TObject);
Begin
{$IFDEF USE_LISTVIEW}
   ListView1.Items.EndUpdate;
{$ELSE}
   ZipView1.Items.EndUpdate;
{$ENDIF}
End;
//-------------------------------------------------------------
(* OnElaspedTime event - activated at the end of a search.  It passes
  the time the search took to search a 'single' archive *)

Procedure TForm1.ZipSearch1ElapsedTime(Sender: TObject; ElapsedTime: Single);
Var
   s: ShortString;
Begin
   If mnuDisplayElapsedTime1.Checked Then
   Begin
      s := Format('Seconds: %g', [ElapsedTime]);
      ShowMessage(s + #13#13'OnElapsedTime event');
   End;
End;
//-------------------------------------------------------------
(* OnFinish event - activates when search is finished.
  Files, Matches, & Bytes parameters are the total combined totals
  of all compressed files searhed *)

Procedure TForm1.ZipSearch1Finish(Sender: TObject; files, Matches, Bytes: Integer);
Begin
	// clear form controls
   Edit6.Text := '';
   Edit7.Text := '';
   ProgressBar1.Position := 0;

   DumpArchiveList.Clear();
   MessageDlg('Files: ' + IntToStr(files) + #13'Matches: ' + IntToStr(Matches) +
      #13'Bytes: ' + IntToStr(Bytes), mtInformation, [mbOK], 0)
End;
//-------------------------------------------------------------
(* OnNextVolume event ( for ARJ multi-volume archives *)

Procedure TForm1.ZipSearch1NextVolume(Sender: TObject; Var VolumeName: String;
   VolumeID: Integer; FExists: Boolean; Var Cancel: Boolean);
Begin
   Cancel := False;
   If Not FExists Then
   Begin
      If Not InputQuery('Enter new drv:\dir\file...', 'Filename: ' + VolumeName,
         VolumeName) Then
         Cancel := True;
   End
   Else
      Edit6.Text := VolumeName;
End;
//-------------------------------------------------------------
(* OnError event
   To activate error reporting, unrem the following ShowMessage call *)

Procedure TForm1.ZipSearch1Error(Sender: TObject; FileName, ExtendedMsg,
	VolumeID: String; ECode: Integer);
Begin
   Form3.Dump.Lines.Add('*' + VolumeID);
   Form3.Dump.Lines.Add(#9 + 'File: ' + FileName);
   Form3.Dump.Lines.Add(#9 + 'Msg: ' + ExtendedMsg);
   Form3.Dump.Lines.Add(#9 + 'Error# ' + IntToStr(ECode));
   Form3.Dump.Lines.Add(#9 + LoadStr(ECode));
End;
//-------------------------------------------------------------
(* OnGetPassword event... request password from user *)

Procedure TForm1.ZipSearch1GetPassword(Sender: TObject; FileName: String;
   Var Password: String; Var TryAgain: Boolean);
Begin
   If Not InputQuery(FileName, 'Enter password', Password) Then
      TryAgain := False;
End;

//-------------------------------------------------------------
(* Select Archive - Button *)

Procedure TForm1.btnOpenClick(Sender: TObject);
Begin
   Open1Click(Sender);
End;
//-------------------------------------------------------------
(* OK Button *)

Procedure TForm1.btnOKClick(Sender: TObject);
Begin
	If Busy Then Exit;
   
   btnOK.Enabled := False;
   Form3.Dump.Lines.Clear();
   Edit6.Text := '';
   Edit7.Text := '';
	Busy := True;

   Try

      If (Not CheckBox3.Checked) And (Not ztvFileExists(Edit1.Text)) Then
      Begin
         ShowMessage(Edit1.Text + ' not found.');
         Edit1.SetFocus;
         Exit;
      End;

      (* Set form controls *)

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -