スレッド(TThread)で指定フォルダ以下のファイルを再帰的に探索 ～Delphiソースコード集

• ホーム
• Delphiでお手軽プログラミング
• スレッド(TThread)で指定フォルダ以下のファイルを再帰的に探索 ～Delphiソースコード集

スレッド(TThread)で指定フォルダ以下のファイルを再帰的に探索 ～Delphiソースコード集

Delphiを起動して新規作成を行う

スレッド(TThreadからの派生クラス）用のユニットを作成

unit UThreadSearchFile;

interface
uses system.sysutils,system.classes,system.strutils;
type
  TSearchFileKind=(sfFileOnly,sfDirectoryOnly,sfFileAndDirectory);
  TOnSearchFileFind=procedure(Sender:TObject;FindName:String) of object;

  TThreadSearchFile=class(TThread)
  private
    fStl:TStringList;//探索結果リストが入る
    fPath:String;    //初期パス
    fKind:TSearchFileKind;//探索種別
    fOnFind:TOnSearchFileFind;//逐次ファイルフォルダが探索されるイベント
    procedure SearchFile(path:string);//再帰探索
  protected
    procedure Execute; override;
  public
    constructor Create(DirName:String;kind:TSearchFileKind=sfFileOnly);
    destructor Destroy; override;
    property OnFind:TOnSearchFileFind write fOnFind;
    property List:TStringList read fstl;
  end;

implementation

{ TThreadSearchFile }

constructor TThreadSearchFile.Create(DirName:String;
  kind:TSearchFileKind=sfFileOnly);
begin
  //Suspend状態で開始する
  inherited Create(true);
  //処理終了時にオブジェクトを自動破棄する
  FreeOnTerminate:=True;
  fPath:=DirName;
  fKind:=kind;
  fStl:=TStringList.Create;
  //ソートする
  fStl.Sorted:=True;
  fOnFind:=nil;
end;

destructor TThreadSearchFile.Destroy;
begin
  fstl.Free;
  inherited;
end;

procedure TThreadSearchFile.Execute;
begin
  inherited;
  //再帰処理を行う
  SearchFile(fPath);
end;

procedure TThreadSearchFile.SearchFile(path:string);
var f:TSearchRec;
    ret:Integer;
begin
  if RightStr(path,1)='\' then
    path:=LeftStr(path,length(path)-1);
  if not DirectoryExists(path) then exit;

  //ファイル、フォルダの探索
  ret:=FindFirst(path+'\*',faAnyFile,f);
  while (ret=0) and (not Terminated) do
  begin
    if (f.Name<>'.') and (f.Name<>'..') then
    begin
      if (f.Attr and faDirectory)=faDirectory then
      begin
        //フォルダの場合
        if fKind<>sfFileOnly then
        begin
          fStl.Add(path+'\'+f.Name);
          if Assigned(fOnFind) then
            Synchronize(
              procedure()
              begin
                fOnFind(self,path+'\'+f.Name);
              end
            );
        end;
        Self.SearchFile(path+'\'+f.Name);
      end
      else
      begin
        //ファイルの場合
        if fKind<>sfDirectoryOnly then
        begin
          fStl.Add(path+'\'+f.Name);
          if Assigned(fOnFind) then
            Synchronize(
              procedure()
              begin
                fOnFind(self,path+'\'+f.Name);
              end
            );
        end;
      end;
    end;
    while (not Terminated) and Suspended do
    begin
      //terminateではなく、suspendedの間は待つ
      sleep(100);
    end;
    ret:=FindNext(f);
  end;
  FindClose(f);
end;

end.

Unit1のソースコードを記述

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  Vcl.FileCtrl,UThreadSearchFile;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    tsf:TThreadSearchFile;
    procedure onFindFile(Sender:TObject;FindName:String);
    procedure onTerminated(Sender:TObject);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var SelDir:string;
begin
  SelDir:='';
  //フォルダ探索の開始
  Vcl.FileCtrl.SelectDirectory(
    '探索開始フォルダの選択',
    '',
    SelDir,
    [sdNewUI,sdShowShares],
    Self
  );
  if SelDir='' then exit;

  memo1.Lines.Clear;
  Button1.Enabled:=false;//開始ボタン
  Button2.Enabled:=true; //終了ボタン
  tsf:=TThreadSearchFile.Create(SelDir,sfFileOnly);
  //逐次ファイル又はフォルダが探索される度にイベント発生
  tsf.OnFind:=onFindFile;
  //フォルダ探索が完了後のイベント
  tsf.OnTerminate:=onTerminated;
  //探索開始
  tsf.Start;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
  //フォルダ探索の停止
  if assigned(tsf) then
    tsf.Terminate;
  Button1.Enabled:=true; //開始ボタン
  Button2.Enabled:=false;//終了ボタン
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.Enabled:=true; //開始ボタン
  Button2.Enabled:=false;//終了ボタン
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if assigned(tsf) then
    tsf.Terminate;
end;


procedure TForm1.onFindFile(Sender: TObject; FindName: String);
begin
  //逐次探索結果を表示する場合
  Memo1.Lines.Add(FindName);
end;

procedure TForm1.onTerminated(Sender: TObject);
begin
  //フォルダ探索完了後にソートされた一覧を一括表示する場合
  //memo1.Lines.Assign(tsf.List);

  tsf:=nil;//FreeOnTerminate=trueの為、破棄は任せる
  Button1.Enabled:=true; //開始ボタン
  Button2.Enabled:=false;//終了ボタン
end;

end.

実行する