Поиск в отдельном потоке фразы в файлах

Delphi , Файловая система , Файлы

Автор: Xavier Pacheco

unit Main;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, SrchIni,
  SrchU, ComCtrls, AppEvnts;

type
  TMainForm = class(TForm)
    lbFiles: TListBox;
    StatusBar: TStatusBar;
    pnlControls: TPanel;
    PopupMenu: TPopupMenu;
    FontDialog: TFontDialog;
    pnlOptions: TPanel;
    gbParams: TGroupBox;
    LFileSpec: TLabel;
    LToken: TLabel;
    lPathName: TLabel;
    edtFileSpec: TEdit;
    edtToken: TEdit;
    btnPath: TButton;
    edtPathName: TEdit;
    gbOptions: TGroupBox;
    cbCaseSensitive: TCheckBox;
    cbFileNamesOnly: TCheckBox;
    cbRecurse: TCheckBox;
    cbRunFromAss: TCheckBox;
    pnlButtons: TPanel;
    btnSearch: TBitBtn;
    btnClose: TBitBtn;
    btnPrint: TBitBtn;
    btnPriority: TBitBtn;
    Font1: TMenuItem;
    Clear1: TMenuItem;
    Print1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    ApplicationEvents: TApplicationEvents;
    procedure btnSearchClick(Sender: TObject);
    procedure btnPathClick(Sender: TObject);
    procedure lbFilesDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure Font1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnPrintClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure lbFilesDblClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btnPriorityClick(Sender: TObject);
    procedure edtTokenChange(Sender: TObject);
    procedure Clear1Click(Sender: TObject);
    procedure ApplicationEventsHint(Sender: TObject);
  private
    procedure ReadIni;
    procedure WriteIni;
  public
    Running: Boolean;
    SearchPri: Integer;
    SearchThread: TSearchThread;
    procedure EnableSearchControls(Enable: Boolean);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses Printers, ShellAPI, StrUtils, FileCtrl, PriU;

procedure PrintStrings(Strings: TStrings);
{ This procedure prints all of the strings in the Strings parameter }
var
  Prn: TextFile;
  I: Integer;
begin
  if Strings.Count = 0 then // Are there strings?
    raise Exception.Create('No text to print!');
  AssignPrn(Prn); // assign Prn to printer
  try
    Rewrite(Prn); // open printer
    try
      for I := 0 to Strings.Count - 1 do // iterate over all strings
        WriteLn(Prn, Strings.Strings[I]); // write to printer
    finally
      CloseFile(Prn); // close printer
    end;
  except
    on EInOutError do
      MessageDlg('Error Printing text.', mtError, [mbOk], 0);
  end;
end;

procedure TMainForm.EnableSearchControls(Enable: Boolean);
{ Enables or disables certain controls so options can't be modified }
{ while search is executing. }
begin
  btnSearch.Enabled := Enable; // enable/disable proper controls
  cbRecurse.Enabled := Enable;
  cbFileNamesOnly.Enabled := Enable;
  cbCaseSensitive.Enabled := Enable;
  btnPath.Enabled := Enable;
  edtPathName.Enabled := Enable;
  edtFileSpec.Enabled := Enable;
  edtToken.Enabled := Enable;
  Running := not Enable; // set Running flag
  edtTokenChange(nil);
  with btnClose do
  begin
    if Enable then
    begin // set props of Close/Stop button
      Caption := '&Close';
      Hint := 'Close Application';
    end
    else
    begin
      Caption := '&Stop';
      Hint := 'Stop Searching';
    end;
  end;
end;

procedure TMainForm.btnSearchClick(Sender: TObject);
{ Called when Search button is clicked.  Invokes search thread. }
begin
  EnableSearchControls(False); // disable controls
  lbFiles.Clear; // clear listbox
  { start thread }
  SearchThread := TSearchThread.Create(cbCaseSensitive.Checked,
    cbFileNamesOnly.Checked, cbRecurse.Checked, edtToken.Text,
    edtPathName.Text, edtFileSpec.Text);
end;

procedure TMainForm.edtTokenChange(Sender: TObject);
begin
  btnSearch.Enabled := not Running and (edtToken.Text <> '');
end;

procedure TMainForm.btnPathClick(Sender: TObject);
{ Called when Path button is clicked.  Allows user to choose new path. }
var
  ShowDir: string;
begin
  ShowDir := edtPathName.Text;
  if SelectDirectory('Choose a search path...', '', ShowDir) then
    edtPathName.Text := ShowDir;
end;

procedure TMainForm.lbFilesDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
{ Called in order to owner draw listbox. }
var
  CurStr: string;
begin
  with lbFiles do
  begin
    CurStr := Items.Strings[Index];
    Canvas.FillRect(Rect); // clear out rect
    if not cbFileNamesOnly.Checked then // if not filename only...
      { if current line is filename... }
      if (Pos('File ', CurStr) = 1) and
        (CurStr[Length(CurStr)] = ':') then
        with Canvas.Font do
        begin
          Style := [fsUnderline]; // underline font
          Color := clRed; // paint red
        end
      else
        Rect.Left := Rect.Left + 15; // otherwise, indent
    DrawText(Canvas.Handle, PChar(CurStr), Length(CurStr), Rect,
      DT_SINGLELINE);
  end;
end;

procedure TMainForm.Font1Click(Sender: TObject);
{ Allows user to pick new font for listbox }
begin
  { Pick new listbox font }
  if FontDialog.Execute then
    lbFiles.Font := FontDialog.Font;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
{ OnDestroy event handler for form }
begin
  WriteIni;
end;

procedure TMainForm.FormCreate(Sender: TObject);
{ OnCreate event handler for form }
begin
  ReadIni; // read INI file
end;

procedure TMainForm.btnPrintClick(Sender: TObject);
{ Called when Print button is clicked. }
begin
  if MessageDlg('Send search results to printer?', mtConfirmation,
    [mbYes, mbNo], 0) = mrYes then
    PrintStrings(lbFiles.Items);
end;

procedure TMainForm.btnCloseClick(Sender: TObject);
{ Called to stop thread or close application }
begin
  // if thread is running then terminate thread
  if Running then
    SearchThread.Terminate
      // otherwise close app
  else
    Close;
end;

procedure TMainForm.lbFilesDblClick(Sender: TObject);
{ Called when user double-clicks in listbox. Invokes viewer for }
{ highlighted file. }
var
  ProgramStr, FileStr: string;
  RetVal: THandle;
begin
  { if user clicked on a file.. }
  if (Pos('File ', lbFiles.Items[lbFiles.ItemIndex]) = 1) then
  begin
    { load text editor from INI file.  Notepad is default. }
    ProgramStr := SrchIniFile.ReadString('Defaults', 'Editor', 'notepad');
    FileStr := lbFiles.Items[lbFiles.ItemIndex]; // Get selected file
    FileStr := Copy(FileStr, 6, Length(FileStr) - 5); // Remove prefix
    if FileStr[Length(FileStr)] = ':' then // Remove ":"
      DecStrLen(FileStr, 1);
    if cbRunFromAss.Checked then
      { Run file from shell association }
      RetVal := ShellExecute(Handle, 'open', PChar(FileStr), nil, nil,
        SW_SHOWNORMAL)
    else
      { View file using text editor }
      RetVal := ShellExecute(Handle, 'open', PChar(ProgramStr),
        PChar(FileStr), nil, SW_SHOWNORMAL);
    { Check for error }
    if RetVal < 32 then
      RaiseLastWin32Error;
  end;
end;

procedure TMainForm.FormResize(Sender: TObject);
{ OnResize event handler. Centers controls in form. }
begin
  { divide status bar into two panels with a 1/3 - 2/3 split }
  with StatusBar do
  begin
    Panels[0].Width := Width div 3;
    Panels[1].Width := Width * 2 div 3;
  end;
end;

procedure TMainForm.btnPriorityClick(Sender: TObject);
{ Show thread priority form }
begin
  ThreadPriWin.Show;
end;

procedure TMainForm.ReadIni;
{ Reads default values from Registry }
begin
  with SrchIniFile do
  begin
    edtPathName.Text := ReadString('Defaults', 'LastPath', 'C:\');
    edtFileSpec.Text := ReadString('Defaults', 'LastFileSpec', '*.*');
    edtToken.Text := ReadString('Defaults', 'LastToken', '');
    cbFileNamesOnly.Checked := ReadBool('Defaults', 'FNamesOnly', False);
    cbCaseSensitive.Checked := ReadBool('Defaults', 'CaseSens', False);
    cbRecurse.Checked := ReadBool('Defaults', 'Recurse', False);
    cbRunFromAss.Checked := ReadBool('Defaults', 'RunFromAss', False);
    Left := ReadInteger('Position', 'Left', Left);
    Top := ReadInteger('Position', 'Top', Top);
    Width := ReadInteger('Position', 'Width', Width);
    Height := ReadInteger('Position', 'Height', Height);
  end;
end;

procedure TMainForm.WriteIni;
{ writes current settings back to Registry }
begin
  with SrchIniFile do
  begin
    WriteString('Defaults', 'LastPath', edtPathName.Text);
    WriteString('Defaults', 'LastFileSpec', edtFileSpec.Text);
    WriteString('Defaults', 'LastToken', edtToken.Text);
    WriteBool('Defaults', 'CaseSens', cbCaseSensitive.Checked);
    WriteBool('Defaults', 'FNamesOnly', cbFileNamesOnly.Checked);
    WriteBool('Defaults', 'Recurse', cbRecurse.Checked);
    WriteBool('Defaults', 'RunFromAss', cbRunFromAss.Checked);
    WriteInteger('Position', 'Left', Left);
    WriteInteger('Position', 'Top', Top);
    WriteInteger('Position', 'Width', Width);
    WriteInteger('Position', 'Height', Height);
  end;
end;

procedure TMainForm.Clear1Click(Sender: TObject);
begin
  lbFiles.Items.Clear;
end;

procedure TMainForm.ApplicationEventsHint(Sender: TObject);
{ OnHint event handler for Application }
begin
  { Display application hints on status bar }
  StatusBar.Panels[0].Text := Application.Hint;
end;

end.

Статья Поиск в отдельном потоке фразы в файлах раздела Файловая система Файлы может быть полезна для разработчиков на Delphi и FreePascal.

Комментарии и вопросы

:: Главная :: Файлы ::