unit ThreadRepeater;

interface

uses
  ThreadPool,
  Windows, Classes, SysUtils;

const
  _RepeaterTimeOut = 1000 * 5;

type
  TThreadRepeater = class (TComponent)
  private
    class var FCount : integer;
  private
    FThread : pointer;
    FTimeOut: DWORD;
    FStackSize: integer;
    function GetStoped: boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Execute(MethodHandle:TNotifyEvent);
    procedure Stop;

    procedure Terminate;

    class property Count : integer read FCount;
  published
    property TimeOut : DWORD read FTimeOut write FTimeOut;
    property Stoped : boolean read GetStoped;
    property StackSize : integer read FStackSize write FStackSize;
  end;

implementation

type
  TThreadRepeaterImp = class
  private
    FHandle: THandle platform;
    FThreadID : TThreadID;
    FTerminate : boolean;
    FIsRunning : boolean;
    FThreadRepeater : TThreadRepeater;
    FMethodHandle : TNotifyEvent;
  protected
    procedure Execute;
  public
    constructor Create(ThreadRepeater:TThreadRepeater; MethodHandle:TNotifyEvent; StackSize:integer); reintroduce;

    procedure Terminate;
    procedure TerminateAndWait;
  end;

{ TThreadRepeater }

constructor TThreadRepeater.Create(AOwner: TComponent);
begin
  inherited;

  IsMultiThread := true;

  FThread := nil;
  FTimeOut := _RepeaterTimeOut;
  FStackSize := 0;
end;

destructor TThreadRepeater.Destroy;
begin
  Stop;

  inherited;
end;

procedure TThreadRepeater.Execute(MethodHandle: TNotifyEvent);
begin
  if FThread <> nil then
    raise Exception.Create('ThreadRepeater is already Executed.');

  FThread := TThreadRepeaterImp.Create(Self, MethodHandle, StackSize);
end;

function TThreadRepeater.GetStoped: boolean;
begin
  Result := FThread = nil;
end;

procedure TThreadRepeater.Stop;
var
  Thread : TThreadRepeaterImp;
begin
  Thread := InterlockedExchangePointer(FThread, nil);
  if Thread = nil then Exit;

  Thread.TerminateAndWait;
end;

procedure TThreadRepeater.Terminate;
var
  Thread : TThreadRepeaterImp;
begin
  Thread := InterlockedExchangePointer(FThread, nil);
  if Thread = nil then Exit;

  Thread.Terminate;
end;

{ TThreadRepeaterImp }

function ThreadProc(Parameter : Pointer) : Integer;
begin
  Result := 0;
  try
    TThreadRepeaterImp(Parameter).Execute;
  finally
    EndThread(0);
    TThreadRepeaterImp(Parameter).Free;
  end;
end;

constructor TThreadRepeaterImp.Create(ThreadRepeater: TThreadRepeater;
  MethodHandle: TNotifyEvent; StackSize: integer);
begin
  inherited Create;

  FTerminate := false;
  FIsRunning := true;

  FThreadRepeater := ThreadRepeater;
  FMethodHandle := MethodHandle;

  FHandle := BeginThread(nil, StackSize, @ThreadProc, Pointer(Self), 0, FThreadID);
end;

procedure TThreadRepeaterImp.Execute;
begin
  TThread.NameThreadForDebugging(AnsiString(FThreadRepeater.Name));

  InterlockedIncrement(TThreadRepeater.FCount);
  try
    repeat
      try
        FMethodHandle(FThreadRepeater);
      except
        Terminate;
      end;
    until FTerminate;
  finally
    InterlockedDecrement(TThreadRepeater.FCount);
  end;

  FIsRunning := false;
end;

procedure TThreadRepeaterImp.Terminate;
begin
  FTerminate := true;
end;

function TerminateThread(lpThreadParameter: Pointer): Integer; stdcall;
begin
  if lpThreadParameter <> nil then
    TThreadRepeaterImp(lpThreadParameter).Terminate;

  Result := 0;
end;

procedure TThreadRepeaterImp.TerminateAndWait;
begin
  QueueWorkItem(TerminateThread, Self);

  if FIsRunning then
    WaitforSingleObject(FHandle, FThreadRepeater.FTimeOut);
end;

initialization
  TThreadRepeater.FCount := 0;
end.

