多线程操作一例：查找 pas dfm 里的中文

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls,Contnrs,SyncObjs, ImgList,
  RzStatus, RzPanel;

type

  TFileLine = class
  private
    FLine:Integer;
    FContext:String;
  public
    { 功能:行号}
    property  Line:Integer read FLine write FLine;
    { 功能:内容}
    property  Context:String read FContext write FContext;
  end;

  TCNFile = class
  private
    FHashCN:Boolean;
    FContexts:TObjectList;
    FName:string;
    function GetCount:Integer;
    function GetContexts(const Index:integer):TFileLine;
  public
    destructor destroy;override;
    { 功能:含有中文}
    property  HashCN:Boolean read FHashCN write FHashCN;
    { 功能:文件名}
    property  Name:string read FName write FName;
    { 功能:添加}
    function  Add:TFileLine;
    { 功能:数量}
    property  Count:Integer read GetCount;
    { 功能:内容}
    property  Contexts[const Index:integer]:TFileLine read GetContexts;
  end;

  TFolder = class
  private
    FFiles:TObjectList;
    FFolders:TObjectList;
    FCS:TCriticalSection;
    FName:string;
    function GetCount:Integer;
    function GetFiles(const Index:integer):TCNFile;
    function GetFolderCount:Integer;
    function GetFolders(const Index:integer):TFolder;
  public
    constructor Create;
    destructor  Destroy;override;
    { 功能:文件夹名}
    property  Name:string read FName write FName;
    { 功能:添加}
    function  Add:TCNFile;
    function  AddFoler:TFolder;
    { 功能:数量}
    property  Count:Integer read GetCount;
    { 功能:内容}
    property  Files[const Index:integer]:TCNFile read GetFiles;
    { 功能:数量}
    property  FolderCount:Integer read GetFolderCount;
    { 功能:内容}
    property  Folders[const Index:integer]:TFolder read GetFolders;
  end;
//  PFileRec = ^TFileRec;
//  TFileRec = record
//    Data:TCNFile;
//  end;

  TFileMethod = procedure (const Folder:TFolder;const FileName:string) of object;

  TFileThread = class(TThread)
  private
    FFolder:TFolder;
    FFileName:String;
    FMethod:TFileMethod;
  protected
    procedure Execute;override;
  public
    { 功能:文件夹}
    property  Folder:TFolder read FFolder write FFolder;
    { 功能:文件}
    property  FileName:String read FFileName write FFileName;
    { 功能:方法}
    property  Method:TFileMethod read FMethod write FMethod;
  end;


  TForm1 = class(TForm)
    Panel1: TPanel;
    Splitter1: TSplitter;
    Memo1: TMemo;
    Label1: TLabel;
    edt_Path: TEdit;
    Button1: TButton;
    TreeView1: TTreeView;
    ImageList1: TImageList;
    GroupBox1: TGroupBox;
    cb_include: TCheckBox;
    cb_Svn: TCheckBox;
    cb_Dcu: TCheckBox;
    RzStatusBar1: TRzStatusBar;
    stProgress: TRzProgressStatus;
    cb_CN: TCheckBox;
    stText: TRzStatusPane;
    procedure Button1Click(Sender: TObject);
    procedure TreeView1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TreeView1DblClick(Sender: TObject);
    procedure edt_PathDblClick(Sender: TObject);
    procedure cb_CNClick(Sender: TObject);
    procedure stTextDblClick(Sender: TObject);
  private
    ThreadCount:Integer;
    FileCount:Integer;
    FLast:TTreeNode;
    FCS:TCriticalSection;
    Root:TFolder;
    procedure SearchProc(const Parent:TFolder;const Path:string);
    procedure DoFile(const Folder:TFolder;const FileName:string);
    procedure ThreadEnd(sender:TObject);
    procedure MakeTree;
    procedure WaitFor;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses
  BrowseForFolderU,ShellAPI;
{$R *.dfm}

{ TForm1 }

procedure TForm1.SearchProc(const Parent:TFolder;const Path:string);
  function GetFolderName:string;
  var
    i:Integer;
  begin
    i:=Length(ExtractFileDir(Path));
    Result:=Path;
    Delete(Result,1,i + 1);
  end;
var
  SearchRec: TSearchRec;
  iResult:Integer;
  extName:string;
  _Path:string;
  _Folder:TFolder;
  _FileThread:TFileThread;
begin
  if not DirectoryExists(Path) then Exit;
  _Path:=Path;
  if Path[Length(Path)] <> '\' then
    _Path:=Path + '\';
//  if Assigned(Parent) then
  _Folder:=Parent.AddFoler;
  _Folder.Name:=GetFolderName;
  iResult:=FindFirst(_Path + '*.*', faAnyFile, SearchRec);
  while iResult = 0 do
  begin
    if (SearchRec.Attr and faDirectory = faDirectory)  then
    begin
      if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
      begin
        if cb_Svn.Checked and SameText(SearchRec.Name,'.svn') then
        begin
          iResult:=FindNext(SearchRec);
          Continue;
        end;
        if cb_Dcu.Checked and SameText(SearchRec.Name,'.dcu') then
        begin
          iResult:=FindNext(SearchRec);
          Continue;
        end;
        if cb_include.Checked then
          SearchProc(_Folder,_Path + SearchRec.Name);
      end;
    end
    else
    begin
      extName:=ExtractFileExt(SearchRec.Name);
      if SameText(extName,'.pas') or SameText(extName,'.dfm') then
      begin
        Inc(FileCount);
        stProgress.PartsComplete:= FileCount ;
        stProgress.Update;
        _FileThread:=TFileThread.Create(True);
        _FileThread.Folder:=_Folder;
        _FileThread.FileName:=_Path + SearchRec.Name;
        _FileThread.Method:=DoFile;
        _FileThread.OnTerminate:=ThreadEnd;
        Inc(ThreadCount);
        _FileThread.Resume;
        _FileThread.WaitFor;
      end;
    end;
    iResult:=FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

procedure TForm1.DoFile(const Folder: TFolder; const FileName: string);
  function getCN(s:string):string;
  var
    i:Integer;
    tmp:string;
  begin
    Result:='''';
    i:=Pos('#',s);
    while i>0 do
    begin
      tmp:=Copy(s,1,i - 1);
      Delete(s,1,i);
      Result:=Result + WideChar(StrToInt(tmp));
      i:=Pos('#',s);
    end;
    Result:=Result + WideChar(StrToInt(s)) + '''';
  end;  
var
  _File:TextFile;
  Line:string;
  i:Integer;
  AFile:TCNFile;
  _Line:TFileLine;
  LineNum:Integer;
  s:string;
begin
  if not Assigned(Folder) then Exit;
  AssignFile(_File,FileName);
  AFile:=Folder.Add;
  AFile.Name:=FileName;
  LineNum:=0;
  try
    Reset(_File);
    while not Eof(_File) do
    begin
      Inc(LineNum);
      Readln(_File,Line);
      for i:=1 to Length(Line) do
      begin
        if (Ord(Line[i]) > 127) then
        begin
          AFile.HashCN:=True;
          _Line:=AFile.Add;
          _Line.Line:=LineNum;
          _Line.Context:=Line;
          Break;
        end
        else if (Line[i] = '#') then
        begin
          AFile.HashCN:=True;
          _Line:=AFile.Add;
          _Line.Line:=LineNum;
          s:=Copy(Line,i + 1,MaxInt);
          _Line.Context:=Copy(Line,1,i - 1) + getCN(s);
          Break;
        end;  
      end;  
    end;  
  finally
    CloseFile(_File);
  end;   
end;

procedure TForm1.MakeTree;
  procedure AddFile(const Node:TTreeNode;const Folder:TFolder);
  var
    i:Integer;
    _File:TCNFile;
    _Node:TTreeNode;
  begin
    for i:=0 to Folder.Count - 1 do
    begin
      _File:=TCNFile(Folder.Files[i]);
      if cb_CN.Checked then
        if not _File.HashCN then
          Continue;
      _Node:=TreeView1.Items.AddChild(Node,ExtractFileName(_File.Name));
      _Node.Data:=_File;
      if _File.HashCN then
      begin
        _Node.ImageIndex:=1;
        _Node.SelectedIndex:=1;
      end
      else
      begin
        _Node.ImageIndex:=2;
        _Node.SelectedIndex:=2;
      end;
    end;
  end;
  
  procedure AddFolder(const Parent:TTreeNode;const Folder:TFolder);
  var
    i:Integer;
    _Folder:TFolder;
    _Node:TTreeNode;
  begin
    _Node:=TreeView1.Items.AddChild(Parent,Folder.Name);
    _Node.ImageIndex:=0;
    _Node.SelectedIndex:=0;
//    _Node.Data:=Folder;
    AddFile(_Node,Folder);
    for i:=0 to Folder.FolderCount - 1 do
    begin
      _Folder:=TFolder(Folder.Folders[i]);
      AddFolder(_Node,_Folder);
    end;
    _Node.Expand(True);
  end;

begin
//  TreeView1.Items.BeginUpdate;
  AddFolder(nil,Root);
//  TreeView1.Items.EndUpdate;
end;

procedure TForm1.WaitFor;
begin
  Screen.Cursor:=crHourGlass;
//  Sleep(100);
  while ThreadCount > 0 do
  begin
    OutputDebugString(PChar('== ' + IntToStr(ThreadCount)));
    Sleep(10);
  end;
  stProgress.Percent:=0;
  MakeTree;
  Screen.Cursor:=crDefault;
end;

procedure TForm1.ThreadEnd(sender: TObject);
begin
  Dec(ThreadCount);
end;

{ TCNFile }

function TCNFile.Add: TFileLine;
begin
  Result:=TFileLine.Create;
  if not Assigned(FContexts) then
    FContexts:=TObjectList.Create;
  FContexts.Add(Result);
end;

destructor TCNFile.destroy;
begin
  if Assigned(FContexts) then
    FContexts.Free;
end;

function TCNFile.GetContexts(const Index: integer): TFileLine;
begin
  Result:=nil;
  if Index in [0..Count-1] then
    Result:=TFileLine(FContexts.Items[Index]);
end;

function TCNFile.GetCount: Integer;
begin
  Result:= -1 ;
  if Assigned(FContexts) then
    Result:=FContexts.Count;
end;

{ TFolder }

function TFolder.Add: TCNFile;
begin
  FCS.Enter;
  Result:=TCNFile.Create;
  if not Assigned(FFiles) then
    FFiles:=TObjectList.Create;
  FFiles.Add(Result);
  FCS.Leave;
end;

function TFolder.AddFoler: TFolder;
begin
  Result:=TFolder.Create;
  if not Assigned(FFolders) then
    FFolders:=TObjectList.Create;
  FFolders.Add(Result);
end;

constructor TFolder.Create;
begin
  FCS:=TCriticalSection.Create;
end;

destructor TFolder.Destroy;
begin
  if Assigned(FFiles) then
    FFiles.Free;
  if Assigned(FFolders) then
    FFolders.Free;
  FCS.Free;
  inherited;
end;

function TFolder.GetCount: Integer;
begin
  Result:= -1 ;
  if Assigned(FFiles) then
    Result:=FFiles.Count;
end;

function TFolder.GetFiles(const Index: integer): TCNFile;
begin
  Result:=nil;
  if Index in [0..Count-1] then
    Result:=TCNFile(FFiles.Items[Index]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  TreeView1.Items.Clear;
  if Assigned(Root) then
    FreeAndNil(Root);
  Root:=TFolder.Create;
  Root.Name:='搜索结果';
  SearchProc(Root,edt_Path.Text);
  WaitFor;
end;

function TFolder.GetFolderCount: Integer;
begin
  Result:= -1 ;
  if Assigned(FFolders) then
    Result:=FFolders.Count;
end;

function TFolder.GetFolders(const Index: integer): TFolder;
begin
  Result:=nil;
  if Index in [0..FolderCount-1] then
    Result:=TFolder(FFolders.Items[Index]);
end;

{ TFileThread }

procedure TFileThread.Execute;
begin
//  FreeOnTerminate:=True;
  if Assigned(FMethod) then
    FMethod(FFolder,FFileName);
end;

procedure TForm1.TreeView1Click(Sender: TObject);
var
  item:TTreeNode;
  i:Integer;
  _File:TCNFile;
  _Line:TFileLine;
  Count:Integer;
begin
  item:=TreeView1.Selected;
  if FLast = item then Exit;
  FLast:=item;
  FCS.Enter;
  if not Assigned(item) then Exit;
  if Assigned(item.Data) then
  begin
//    if item.Data is TCNFile then
    begin
      Memo1.Lines.BeginUpdate;
      Memo1.Lines.Clear;
      _File:=TCNFile(item.Data);
      stText.Caption:=_File.Name;
      if _File.Count > 50 then
        Count:=50
      else
        Count:=_File.Count;
      for i:=0 to Count -1 do
      begin
        _Line:=_File.Contexts[i];
        Memo1.Lines.Add('行号：' + IntToStr(_Line.Line));
        Memo1.Lines.Add(_Line.Context);
        Memo1.Lines.Add('');
      end;
      Memo1.Lines.EndUpdate;
    end;  
  end;
  FCS.Leave; 
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FCS:=TCriticalSection.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FCS.Free;
  if Assigned(Root) then
    Root.Free;
end;

procedure TForm1.TreeView1DblClick(Sender: TObject);
var
  item:TTreeNode;
begin
  item:=TreeView1.Selected;
  if not Assigned(item) then Exit;
  if Assigned(item.Data) then
    WinExec(PChar('notepad.exe ' + TCNFile(item.Data).Name),SW_SHOW);
end;

procedure TForm1.edt_PathDblClick(Sender: TObject);
var
  outMsg: string;
  OldPath,_Path:string;
begin
  outMsg := '选择目录';
  OldPath:=edt_Path.Text;
  _Path := BrowseForFolder(outMsg, OldPath);
  if _Path = EmptyStr then
    _Path:=OldPath;
  edt_Path.Text:=_Path;
end;

procedure TForm1.cb_CNClick(Sender: TObject);
begin
  TreeView1.Items.BeginUpdate;
  TreeView1.Items.Clear;
  MakeTree;
  TreeView1.Items.EndUpdate;
end;

procedure TForm1.stTextDblClick(Sender: TObject);
var
  _file:string;
begin
  _file:=stText.Caption;
  if FileExists(_file) then
    ShellExecute(Handle,PChar('Open'),PChar(_file),nil,nil,SW_SHOWNORMAL);
end;

end.