Indy9/Indy 9/IdThreadComponent.pas

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  10377: IdThreadComponent.pas
{
{   Rev 1.2    2003.06.15 6:20:38 PM  czhower
{ Exposed real thread for TIdSync and other purposes.
}
{
{   Rev 1.1    2003.06.15 5:35:02 PM  czhower
{ Fixed OnTerminate. If OnTerminate was set, it would AV when component was
{ created.
}
{
{   Rev 1.0    2002.11.12 10:56:00 PM  czhower
}
{-----------------------------------------------------------------------------
 UnitName: IdThreadComponent
 Author:   Andrew P.Rybin [[email protected]]
 Creation: 12.03.2002
 Version:  0.1.0
 Purpose:
 History:  Based on my TmcThread
 2002-05-03 -Andrew P.Rybin
   -Stéphane Grobéty (Fulgan) suggestion: component is Data owner, don't
    FreeAndNIL Data property
   -special TThread.OnTerminate support (it is sync-event)
 2002-05-23 -APR
   -right support for Thread terminate
 2002 - Kudzu
   -Original concept with implementation by J Peter
-----------------------------------------------------------------------------}

unit IdThreadComponent;

interface

uses
  Classes, IdBaseComponent,
  IdException, IdGlobal, IdThread,
  SysUtils;

const
  IdThreadComponentDefaultPriority = tpNormal;
  IdThreadComponentDefaultStopMode = smTerminate;

type
  TIdCustomThreadComponent = class;

  TIdExceptionThreadComponentEvent = procedure(Sender: TIdCustomThreadComponent; AException: Exception) of object;
  TIdNotifyThreadComponentEvent = procedure(Sender: TIdCustomThreadComponent) of object;
  //TIdSynchronizeThreadComponentEvent = procedure(Sender: TIdCustomThreadComponent; AData: Pointer) of object;

  TIdCustomThreadComponent = class(TIdBaseComponent)
  protected
    FActive: Boolean;
    FPriority : TIdThreadPriority;
    FStopMode : TIdThreadStopMode;
    FThread: TIdThread;
    //
    FOnAfterExecute: TIdNotifyThreadComponentEvent;
    FOnAfterRun: TIdNotifyThreadComponentEvent;
    FOnBeforeExecute: TIdNotifyThreadComponentEvent;
    FOnBeforeRun: TIdNotifyThreadComponentEvent;
    FOnCleanup: TIdNotifyThreadComponentEvent;
    FOnException: TIdExceptionThreadComponentEvent;
    FOnRun: TIdNotifyThreadComponentEvent;
    FOnStopped: TIdNotifyThreadComponentEvent;
    FOnTerminate: TIdNotifyThreadComponentEvent;
    //
    function  GetActive: Boolean;
    function  GetData: TObject;
    function  GetHandle: THandle;
    function  GetPriority: TIdThreadPriority;
    function  GetReturnValue: Integer;
    function  GetStopMode: TIdThreadStopMode;
    function  GetStopped: Boolean;
    function  GetSuspended: Boolean;
    function  GetTerminatingException: string;
    function  GetTerminatingExceptionClass: TClass;
    function  GetTerminated: Boolean;
    procedure Loaded; override;
    procedure SetActive(const AValue: Boolean); virtual;
    procedure SetData(const AValue: TObject);
    procedure SetOnTerminate(const AValue: TIdNotifyThreadComponentEvent);
    procedure SetPriority(const AValue: TIdThreadPriority);
    procedure SetReturnValue(const AValue: Integer);
    procedure SetStopMode(const AValue: TIdThreadStopMode);

    // event triggers
    procedure DoAfterExecute; virtual;
    procedure DoAfterRun; virtual;
    procedure DoBeforeExecute; virtual;
    procedure DoBeforeRun; virtual;
    procedure DoCleanup; virtual;
    procedure DoException(AThread: TIdThread; AException: Exception); virtual;
    procedure DoRun; virtual;
    procedure DoStopped(AThread: TIdThread); virtual;
    procedure DoTerminate(Sender: TObject); virtual;
    //
    property Active: Boolean read GetActive write SetActive default FALSE;
    property Priority: TIdThreadPriority read GetPriority write SetPriority;
    property StopMode: TIdThreadStopMode read GetStopMode write SetStopMode;
    //
    property OnAfterExecute: TIdNotifyThreadComponentEvent read FOnAfterExecute write FOnAfterExecute;
    property OnAfterRun: TIdNotifyThreadComponentEvent read FOnAfterRun write FOnAfterRun;
    property OnBeforeExecute: TIdNotifyThreadComponentEvent read FOnBeforeExecute write FOnBeforeExecute;
    property OnBeforeRun: TIdNotifyThreadComponentEvent read FOnBeforeRun write FOnBeforeRun;
    property OnCleanup: TIdNotifyThreadComponentEvent read FOnCleanup write FOnCleanup;
    property OnException: TIdExceptionThreadComponentEvent read FOnException write FOnException;
    property OnRun: TIdNotifyThreadComponentEvent read FOnRun write FOnRun;
    property OnStopped: TIdNotifyThreadComponentEvent read FOnStopped write FOnStopped;
    property OnTerminate: TIdNotifyThreadComponentEvent read FOnTerminate write SetOnTerminate;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Start; virtual;
    procedure Stop; virtual;
    procedure Synchronize(AMethod: TThreadMethod); overload;
    procedure Synchronize(AMethod: TMethod); overload;
    procedure Terminate; virtual;
    procedure TerminateAndWaitFor; virtual;
    function  WaitFor: LongWord;
    //
    property Data: TObject read GetData write SetData;
    property Handle: THandle read GetHandle;
    property ReturnValue: Integer read GetReturnValue write SetReturnValue;
    property Stopped: Boolean read GetStopped;
    property Suspended: Boolean read GetSuspended;
    property Thread: TIdThread read FThread;
    property TerminatingException: string read GetTerminatingException;
    property TerminatingExceptionClass: TClass read GetTerminatingExceptionClass;
    property Terminated: Boolean read GetTerminated;
  end;

  TIdThreadComponent = class(TIdCustomThreadComponent)
  published
    property Active;
    property Priority default IdThreadComponentDefaultPriority;
    property StopMode default IdThreadComponentDefaultStopMode;
    //
    property OnAfterExecute;
    property OnAfterRun;
    property OnBeforeExecute;
    property OnBeforeRun;
    property OnCleanup;
    property OnException;
    property OnRun;
    property OnStopped;
    property OnTerminate;
  end;

  //For Component-writers ONLY!
  TIdThreadEx = class(TIdThread)
  protected
    FThreadComponent: TIdCustomThreadComponent;
    //
    procedure AfterRun; override;
    procedure AfterExecute; override;
    procedure BeforeExecute; override;
    procedure BeforeRun; override;
    procedure Cleanup; override;
    procedure Run; override;
  public
    constructor Create(AThreadComponent: TIdCustomThreadComponent); reintroduce;
  end;

implementation


{ TIdThreadEx }

procedure TIdThreadEx.AfterExecute;
begin
  try
    FThreadComponent.DoAfterExecute;
  finally
    FThreadComponent.FActive := FALSE;
  end;
end;

procedure TIdThreadEx.AfterRun;
begin
  FThreadComponent.DoAfterRun;
end;

procedure TIdThreadEx.BeforeExecute;
begin
  FThreadComponent.DoBeforeExecute;
end;

procedure TIdThreadEx.BeforeRun;
begin
  FThreadComponent.DoBeforeRun;
end;

procedure TIdThreadEx.Cleanup;
begin
  //don't free FData. Now Component is Data owner! inherited Cleanup;
  FThreadComponent.DoCleanup;
end;

constructor TIdThreadEx.Create(AThreadComponent: TIdCustomThreadComponent);
begin
  inherited Create(True);
  FThreadComponent := AThreadComponent;
  FOnException := FThreadComponent.DoException;
  FOnStopped := FThreadComponent.DoStopped;
end;

procedure TIdThreadEx.Run;
begin
  FThreadComponent.DoRun;
end;

{ TIdCustomThreadComponent }

procedure TIdCustomThreadComponent.DoAfterExecute;
begin
  if Assigned(FOnAfterExecute) then FOnAfterExecute(Self);
end;

procedure TIdCustomThreadComponent.DoAfterRun;
begin
  if Assigned(FOnAfterRun) then FOnAfterRun(Self);
end;

procedure TIdCustomThreadComponent.DoBeforeExecute;
begin
  if Assigned(FOnBeforeExecute) then FOnBeforeExecute(Self);
end;

procedure TIdCustomThreadComponent.DoBeforeRun;
begin
  if Assigned(FOnBeforeRun) then FOnBeforeRun(Self);
end;

procedure TIdCustomThreadComponent.DoCleanup;
begin
  if Assigned(FOnCleanup) then FOnCleanup(Self);
end;

constructor TIdCustomThreadComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  StopMode := IdThreadComponentDefaultStopMode;
  Priority := IdThreadComponentDefaultPriority;
end;//TIdCustomThreadComponent.Create

destructor TIdCustomThreadComponent.Destroy;
begin
  {FThread.TerminateAndWaitFor;}
  //make sure thread is not active before we attempt to destroy it
  if Assigned(FThread) then begin
    FThread.Terminate;
    FThread.Start;//resume for terminate
  end;
  FreeAndNIL(FThread);
  inherited;
end;

procedure TIdCustomThreadComponent.DoException(AThread: TIdThread; AException: Exception);
begin
  if Assigned(FOnException) then begin
    FOnException(Self, AException);
  end;
end;

procedure TIdCustomThreadComponent.DoStopped(AThread: TIdThread);
begin
  if Assigned(FOnStopped) then begin
    FOnStopped(Self);
  end;
end;

procedure TIdCustomThreadComponent.DoTerminate;
begin
  if Assigned(FOnTerminate) then begin
    FOnTerminate(Self);
  end;
end;

function TIdCustomThreadComponent.GetData: TObject;
begin
  Result := FThread.Data;
end;

function TIdCustomThreadComponent.GetHandle: THandle;
begin
  Result := GetThreadHandle(FThread);
end;

function TIdCustomThreadComponent.GetReturnValue: Integer;
begin
  Result := FThread.ReturnValue;
end;

function TIdCustomThreadComponent.GetStopMode: TIdThreadStopMode;
begin
  if FThread = NIL then begin
    Result := FStopMode;
  end
  else begin
    Result := FThread.StopMode;
  end;
end;

function TIdCustomThreadComponent.GetStopped: Boolean;
begin
  Result := FThread.Stopped;
end;

function TIdCustomThreadComponent.GetSuspended: Boolean;
begin
  Result := FThread.Suspended;
end;

function TIdCustomThreadComponent.GetTerminated: Boolean;
begin
  Result := FThread.Terminated;
end;

function TIdCustomThreadComponent.GetTerminatingException: string;
begin
  Result := FThread.TerminatingException;
end;

function TIdCustomThreadComponent.GetTerminatingExceptionClass: TClass;
begin
  Result := FThread.TerminatingExceptionClass;
end;

procedure TIdCustomThreadComponent.Loaded;
begin
  inherited;

  if FActive then begin
    FActive := False;
    Active := True;
  end;
end;

procedure TIdCustomThreadComponent.DoRun;
begin
  if Assigned(FOnRun) then begin
    FOnRun(Self);
  end;
end;

procedure TIdCustomThreadComponent.SetActive(const AValue: Boolean);
begin
  if not (csDesigning in ComponentState) then begin
    if FActive<>AValue then begin
      if AValue then begin
        Start;
      end else begin
        Stop;
      end;
    end;//if
  end;
  FActive:= AValue; //component load
end;//SetActive

procedure TIdCustomThreadComponent.SetData(const AValue: TObject);
begin
// this should not be accessed at design-time.
  FThread.Data := AValue;
end;

procedure TIdCustomThreadComponent.SetReturnValue(const AValue: Integer);
begin
// this should not be accessed at design-time.
  FThread.ReturnValue := AValue;
end;

procedure TIdCustomThreadComponent.SetStopMode(const AValue: TIdThreadStopMode);
begin
  if Assigned(FThread) and not FThread.Terminated then begin
    FThread.StopMode := AValue;
  end;
  FStopMode := AValue;
end;

procedure TIdCustomThreadComponent.Start;
begin
  if not (csDesigning in ComponentState) then begin
    if Assigned(FThread) and FThread.Terminated then begin
      FreeAndNIL(FThread);
    end;//if Thread is dead

    if FThread = nil then begin
      FThread := TIdThreadEx.Create(Self);
    end;

    with FThread do begin
      OnTerminate := DoTerminate;
      StopMode := FStopMode;
      Priority := FPriority;
      // Start it last after necessary settings are made
      Start;
    end;
  end;
end;

procedure TIdCustomThreadComponent.Stop;
begin
  if Assigned(FThread) then begin
    FThread.Stop;
  end;
end;

procedure TIdCustomThreadComponent.Synchronize(AMethod: TThreadMethod);
begin
  FThread.Synchronize(AMethod);
end;

procedure TIdCustomThreadComponent.Synchronize(AMethod: TMethod);
begin
  FThread.Synchronize(AMethod);
end;

procedure TIdCustomThreadComponent.Terminate;
begin
  FThread.Terminate;
end;

procedure TIdCustomThreadComponent.TerminateAndWaitFor;
begin
  FThread.TerminateAndWaitFor;
end;

function TIdCustomThreadComponent.WaitFor: LongWord;
begin
  Result := FThread.WaitFor;
end;

function TIdCustomThreadComponent.GetPriority: TIdThreadPriority;
begin
  if csDesigning in ComponentState then begin
    Result := FPriority;
  end else begin
    Result := FThread.Priority;
  end;
end;

procedure TIdCustomThreadComponent.SetPriority(const AValue: TIdThreadPriority);
begin
  if (FThread <> nil) and (FThread.Terminated = False) then begin
    FThread.Priority := AValue;
  end;
  FPriority := AValue;
end;

function TIdCustomThreadComponent.GetActive: Boolean;
begin
  if csDesigning in ComponentState then begin
    Result := FActive;
  end else begin
    Result := not FThread.Stopped;
  end;
end;

procedure TIdCustomThreadComponent.SetOnTerminate(const AValue: TIdNotifyThreadComponentEvent);
begin
  FOnTerminate := AValue;
  if FThread <> nil then begin
    if Assigned(AValue) then begin
      FThread.OnTerminate := DoTerminate;
    end else begin
      FThread.OnTerminate := nil;
    end;
  end;
end;

end.