Resources




Delphi - Simple Thread Example

unit DirectoryPollerThread;

interface

uses
  Windows, SysUtils, Classes, FileCtrl, Forms;

const 
  FILE_PATTERN = '*.*';

type
  TNewFileEvent = procedure(Sender: TObject; FileName: String) of object;

  TDirectoryPollerThread = class(TThread)
  private
    FOnNewFile: TNewFileEvent;

    FPollingDirectory: String;

    procedure ListFiles;
    procedure HandleInputFile(SearchRec: TSearchRec);
  protected
    procedure Execute; override;

    // events
    procedure DoNewFile(FileName: String); dynamic;
  public
    constructor Create(const PollingDirectory: String; const CreateSuspended: boolean); overload;
    destructor Destroy; override;

    // events
    property OnNewFile: TNewFileEvent read FOnNewFile write FOnNewFile;
  end;

implementation

{ TDirectoryPollerThread }

{------------------------------------------------------------------------------}

constructor TDirectoryPollerThread.Create(const PollingDirectory: String; const CreateSuspended: boolean);
begin
  FreeOnTerminate := True;
  Priority := tpLower;

  FPollingDirectory := IncludeTrailingBackslash(PollingDirectory);

  ForceDirectories(FPollingDirectory);

  inherited Create(CreateSuspended);
end;

{------------------------------------------------------------------------------}

destructor TDirectoryPollerThread.Destroy;
begin
  inherited;
end;

{------------------------------------------------------------------------------}

procedure TDirectoryPollerThread.DoNewFile(FileName: String);
begin
  if Assigned(FOnNewFile) then
  begin
    FOnNewFile(Self, FileName);
  end;
end;

{------------------------------------------------------------------------------}

procedure TDirectoryPollerThread.Execute;
begin
  while not Terminated do
  begin
    Sleep(SLEEP_TIME);
    ListFiles;
  end;
end;

{------------------------------------------------------------------------------}

procedure TDirectoryPollerThread.HandleInputFile(SearchRec: TSearchRec);
begin
   DoNewFile(SearchRec.Name);
end;

{------------------------------------------------------------------------------}

procedure TDirectoryPollerThread.ListFiles;
var
  SearchRec: TSearchRec;
begin
  if not DirectoryExists(FPollingDirectory) then
  begin
    // SUSPENDING THREAD - Unable to Create Input Directory
    Suspend;
  end
  else
  begin
    try
      if FindFirst(FPollingDirectory + FILE_PATTERN, faAnyFile, SearchRec) = 0 then
      begin
        HandleInputFile(SearchRec);

        while (FindNext(SearchRec) = 0) and (not Terminated) do
        begin
          HandleInputFile(SearchRec);
        end;
      end;
    finally
      SysUtils.findClose(SearchRec);
    end;
  end;
end;

{------------------------------------------------------------------------------}

end.