Delphi World - Поиск в отдельном потоке фразы в файлах
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Поиск в отдельном потоке фразы в файлах

Автор: 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 World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования