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

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

.

Другое по теме:

• Как скопировать все файлы вместе с подкаталогами
• Копирование файлов
• Удалить файл в корзину? Запросто!