[Dlephi] TTask（並列処理（タスク処理））とTThread（非同期処理（マルチスレッド））と。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  System.Threading,//追加。TTaskライブラリの読み込み
  Vcl.FileCtrl;

type
  //ここから
  ThreadFunc = function():boolean;
  TisThread = class(TThread)
  private
    { Private 宣言 }
  public
    func_set: ThreadFunc;
  protected
    procedure Execute; override;
  end;
  TMyFunctionArray = array[0..255] of function():boolean;
  //ここまで追加。

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    ListBox1: TListBox;
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure DirectoryListBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    //Privateに以下を追加。
    isThread: TisThread;
    function Run(f:TisThread):boolean;
    function RunFindDir():TisThread;
    function FindDir(Dir,FindFileType: string;files:TStringlist):string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
  //ここから
  procedure TisThread.Execute;
  function run_method:boolean;
  function set_function(f:ThreadFunc):boolean;
    var
      s:TMyFunctionArray;
    begin
      s[0] := f;
    end;
  begin
    run_method := true;
    try
      set_function(func_set);
    except
      run_method := false;
    end;
  end;

begin
  run_method;
  if Application.Terminated then begin

  end;
end;

function Tform1.Run(f:TisThread):boolean;
begin
  try
    try
      isThread:= f;
      if isThread=nil then
        isThread:=TisThread.Create(false);
    except
      //例外が発生した場合にここに移動
    end;
  finally
    //処理が成功した場合にここに移動
  end;
  exit;
end;

function TForm1.FindDir(Dir,FindFileType: string;files:TStringlist):string;
var
  Rec: TSearchRec;
begin
  //フォルダ名の最後に がついていなければつける
  Dir :=IncludeTrailingPathDelimiter(Dir);
  if FindFirst(Dir + FindFileType, faAnyFile, Rec) = 0 then
  try
    repeat
     if Rec.Attr and faDirectory <> 0 then
      begin
          if (Rec.Name='.') or (Rec.Name='..') then
            Continue;
            //フォルダなら再度この関数を呼び出し
            Result :=FindDir(Dir + Rec.Name,FindFileType,files);
      end
      else begin //ファイルなら追加
          files.Add(Dir + Rec.Name);
          form1.Caption := Dir + Rec.Name
      end;

      Application.ProcessMessages;
    until (FindNext(Rec) <> 0) or (Result <> '');
  finally
     FindClose(Rec);
  end;
end;

function Tform1.RunFindDir():TisThread;
var
  Time: Cardinal;
  st:Tstringlist;
begin
  st := tstringlist.Create;
  st.Clear;
  Time :=GetTickCount;
  FindDir(form1.Edit1.Text,'*.*',st);
  form1.Memo1.Lines.Add('TThread処理時間: '+IntToStr(GetTickCount -Time));
  form1.Memo1.Lines.Add(edit1.Text+':'+IntToStr(st.Count)+'files');
  form1.ListBox1.Items.Text := st.Text;
  st.Free;
  showmessage('処理が完了しました。');
end;
//ここまで追加

//Button1Clickに以下を追加。
procedure TForm1.Button1Click(Sender: TObject);
var
  Time: Cardinal;
  st:Tstringlist;
  Task1: ITask;
begin
  st := tstringlist.Create;
  st.Clear;
  Task1 := TTask.Create (procedure ()
  begin
    Time :=GetTickCount;
    FindDir(form1.Edit1.Text,'*.*',st);
    form1.Memo1.Lines.Add('TTask処理時間: '+IntToStr(GetTickCount -Time));
  form1.Memo1.Lines.Add(edit1.Text+':'+IntToStr(st.Count)+'files');
    form1.ListBox1.Items.Text := st.Text;
    showmessage('処理が完了しました。');
    st.Free;
  end);
  Task1.Start;
end;

//Button2Clickに以下を追加。
procedure TForm1.Button2Click(Sender: TObject);
begin
  run(RunFindDir());
end;

//DirectoryListBox1Changeに以下を追加。
procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
  edit1.Text := form1.DirectoryListBox1.Directory;
end;

//FormCreateに以下を追加。
procedure TForm1.FormCreate(Sender: TObject);
begin
  edit1.Text := form1.DirectoryListBox1.Directory;
end;

end.