📄 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: 11787: IdThreadComponent.pas
{
{ Rev 1.13 9/30/2004 2:26:04 PM BGooijen
{ wrong property was referenced
}
{
{ Rev 1.12 2004.02.03 4:17:12 PM czhower
{ For unit name changes.
}
{
{ Rev 1.11 2004.01.20 10:03:38 PM czhower
{ InitComponent
}
{
{ Rev 1.10 09.11.2003 14:05:52 ARybin
{ AV
}
{
{ Rev 1.9 08.11.2003 20:03:20 ARybin
{ run-time active bug
}
{
Rev 1.8 10/15/2003 8:48:58 PM DSiders
Added resource strings for exceptions raised when setting thread component
properties.
}
{
{ Rev 1.7 2003.10.11 9:58:04 PM czhower
{ Several bug fixes
}
{
{ Rev 1.6 2003.10.11 5:51:54 PM czhower
{ -VCL fixes for servers
{ -Chain suport for servers (Super core)
{ -Scheduler upgrades
{ -Full yarn support
}
{
{ Rev 1.5 2003.09.30 7:48:02 PM czhower
{ Fixed Loop and ThreadName
}
{
{ Rev 1.4 9/18/2003 07:40:52 PM JPMugaas
{ Removed IdGlobal.
}
{
{ Rev 1.3 9/16/2003 04:47:22 PM JPMugaas
{ Made some code follow the Indy conventions so it's easier to debug.
}
{
{ Rev 1.2 2003.07.01 4:14:38 PM czhower
{ ThreadName and Loop added. Other bugs fixed.
}
{
{ Rev 1.1 06.03.2003 12:16:52 ARybin
{ adapted for new IdThread
}
{
{ Rev 1.0 11/13/2002 08:03:06 AM JPMugaas
}
{-----------------------------------------------------------------------------
UnitName: IdThreadComponent
Author: Andrew P.Rybin [magicode@mail.ru]
Creation: 12.03.2002
Version: 0.1.0
Purpose:
History: Based on my TmcThread
2002-05-03 -Andrew P.Rybin
-St閜hane Grob閠y (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
-----------------------------------------------------------------------------}
unit IdThreadComponent;
interface
uses
Classes,
IdBaseComponent, IdException, IdGlobal, IdThread,
SysUtils;
const
IdThreadComponentDefaultPriority = tpNormal;
IdThreadComponentDefaultStopMode = smTerminate;
type
TIdThreadComponent = class;
TIdExceptionThreadComponentEvent = procedure(Sender: TIdThreadComponent; AException: Exception) of object;
TIdExceptionThreadComponentEventEx = procedure(Sender: TIdThreadComponent; AException: Exception; var VHandled: Boolean) of object;
TIdNotifyThreadComponentEvent = procedure(Sender: TIdThreadComponent) of object;
//TIdSynchronizeThreadComponentEvent = procedure(Sender: TIdThreadComponent; AData: Pointer) of object;
TIdThreadComponent = class(TIdBaseComponent)
protected
FActive: Boolean;
FLoop: Boolean;
FPriority : TIdThreadPriority;
FStopMode : TIdThreadStopMode;
FThread: TIdThread;
FThreadName: string;
//
FOnAfterExecute: TIdNotifyThreadComponentEvent;
FOnAfterRun: TIdNotifyThreadComponentEvent;
FOnBeforeExecute: TIdNotifyThreadComponentEvent;
FOnBeforeRun: TIdNotifyThreadComponentEvent;
FOnCleanup: TIdNotifyThreadComponentEvent;
FOnException: TIdExceptionThreadComponentEvent;
FOnRun: TIdNotifyThreadComponentEvent;
FOnStopped: TIdNotifyThreadComponentEvent;
FOnTerminate: TIdNotifyThreadComponentEvent;
FOnHandleRunException: TIdExceptionThreadComponentEventEx;
//
procedure DoAfterExecute; virtual;
procedure DoAfterRun; virtual;
procedure DoBeforeExecute; virtual;
procedure DoBeforeRun; virtual;
procedure DoCleanup; virtual;
procedure DoException(AThread: TIdThread; AException: Exception); virtual; //thev
function DoHandleRunException(AException: Exception): Boolean; virtual;
procedure DoRun; virtual;
procedure DoStopped(AThread: TIdThread); virtual; //thev
procedure DoTerminate(Sender: TObject); virtual; //thev
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 InitComponent; override;
function IsRunning: Boolean;
procedure Loaded; override;
procedure SetActive(const AValue: Boolean); virtual;
procedure SetData(const AValue: TObject);
procedure SetLoop(const AValue: Boolean);
procedure SetThreadName(const AValue: string);
procedure SetOnTerminate(const AValue: TIdNotifyThreadComponentEvent);
procedure SetPriority(const AValue: TIdThreadPriority);
procedure SetReturnValue(const AValue: Integer);
procedure SetStopMode(const AValue: TIdThreadStopMode);
public
destructor Destroy; override;
procedure Start; virtual;
procedure Stop; virtual;
procedure Synchronize(AMethod: TThreadMethod);
procedure Terminate; virtual;
procedure TerminateAndWaitFor; virtual;
function WaitFor: LongWord;
// Properties
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 TerminatingException: string read GetTerminatingException;
property TerminatingExceptionClass: TClass read GetTerminatingExceptionClass;
property Terminated: Boolean read GetTerminated;
published
property Active: Boolean read GetActive write SetActive;
property Loop: Boolean read FLoop write SetLoop;
property Priority: TIdThreadPriority read GetPriority write SetPriority;
property StopMode: TIdThreadStopMode read GetStopMode write SetStopMode;
property ThreadName: string read FThreadName write SetThreadName;
// Events
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 OnHandleRunException: TIdExceptionThreadComponentEventEx
read FOnHandleRunException write FOnHandleRunException;
property OnRun: TIdNotifyThreadComponentEvent read FOnRun write FOnRun;
property OnStopped: TIdNotifyThreadComponentEvent read FOnStopped
write FOnStopped;
property OnTerminate: TIdNotifyThreadComponentEvent read FOnTerminate
write SetOnTerminate;
end;
//For Component-writers ONLY!
TIdThreadEx = class(TIdThread)
protected
FThreadComponent: TIdThreadComponent;
//
procedure AfterRun; override;
procedure AfterExecute; override;
procedure BeforeExecute; override;
procedure BeforeRun; override;
procedure Cleanup; override;
function HandleRunException(AException: Exception): Boolean; override;
procedure Run; override;
public
constructor Create(AThreadComponent: TIdThreadComponent); reintroduce;
end;
implementation
uses
IdResourceStringsCore;
{ 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
inherited Cleanup;
FThreadComponent.DoCleanup;
end;
constructor TIdThreadEx.Create(AThreadComponent: TIdThreadComponent);
begin
inherited Create(True, AThreadComponent.Loop, iif(AThreadComponent.ThreadName = ''
, AThreadComponent.Name, AThreadComponent.ThreadName));
Exclude(FOptions, itoDataOwner); //TIdThreadComponent is data owner
FThreadComponent := AThreadComponent;
FOnException := FThreadComponent.DoException;
FOnStopped := FThreadComponent.DoStopped;
end;
function TIdThreadEx.HandleRunException(AException: Exception): Boolean;
begin
Result := FThreadComponent.DoHandleRunException(AException);
end;
procedure TIdThreadEx.Run;
begin
FThreadComponent.DoRun;
end;
{ TIdThreadComponent }
procedure TIdThreadComponent.DoAfterExecute;
begin
if Assigned(FOnAfterExecute) then
begin
FOnAfterExecute(SELF);
end;
end;
procedure TIdThreadComponent.DoAfterRun;
begin
if Assigned(FOnAfterRun) then
begin
FOnAfterRun(SELF);
end;
end;
procedure TIdThreadComponent.DoBeforeExecute;
begin
if Assigned(FOnBeforeExecute) then
begin
FOnBeforeExecute(SELF);
end;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -