| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806 |
- {
- $Project$
- $Workfile$
- $Revision$
- $DateUTC$
- $Id$
- This file is part of the Indy (Internet Direct) project, and is offered
- under the dual-licensing agreement described on the Indy website.
- (http://www.indyproject.org/)
- Copyright:
- (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
- }
- {
- $Log$
- }
- {
- Rev 1.34 03/16/05 10:29:40 AM JSouthwell
- Added a default thread name to ease debugging of IdThreads.
- Rev 1.33 1/15/05 1:52:36 PM RLebeau
- Extra cleanup handling for the FYarn member
- Rev 1.32 1/6/2005 10:02:58 PM JPMugaas
- This should compile.
- Rev 1.31 1/6/05 2:33:04 PM RLebeau
- one more try...finally block, for Before/AfterExecute()
- Rev 1.29 1/5/05 5:31:08 PM RLebeau
- Added extra try..finally block to Execute() to free the FYarn member.
- Rev 1.28 6/9/2004 10:38:46 PM DSiders
- Fixed case for TIdNotifyThreadEvent.
- Rev 1.27 3/12/2004 7:11:02 PM BGooijen
- Changed order of commands for dotnet
- Rev 1.26 2004.03.01 5:12:44 PM czhower
- -Bug fix for shutdown of servers when connections still existed (AV)
- -Implicit HELP support in CMDserver
- -Several command handler bugs
- -Additional command handler functionality.
- Rev 1.25 2004.02.03 4:17:00 PM czhower
- For unit name changes.
- Rev 1.24 2004.01.22 5:59:12 PM czhower
- IdCriticalSection
- Rev 1.23 2003.12.28 2:33:16 PM czhower
- .Net finalization fix.
- Rev 1.22 2003.12.28 1:27:46 PM czhower
- .Net compatibility
- Rev 1.21 2003.10.24 12:59:20 PM czhower
- Name change
- Rev 1.20 2003.10.21 12:19:04 AM czhower
- TIdTask support and fiber bug fixes.
- Rev 1.19 10/15/2003 8:40:48 PM DSiders
- Added locaization comments.
- Rev 1.18 10/5/2003 3:19:58 PM BGooijen
- disabled some stuff for DotNet
- Rev 1.17 2003.09.19 10:11:22 PM czhower
- Next stage of fiber support in servers.
- Rev 1.14 2003.09.19 11:54:36 AM czhower
- -Completed more features necessary for servers
- -Fixed some bugs
- Rev 1.13 2003.09.18 4:43:18 PM czhower
- -Removed IdBaseThread
- -Threads now have default names
- Rev 1.12 12.9.2003 ã. 16:42:08 DBondzhev
- Fixed AV when exception is raised in BeforeRun and thread is terminated
- before Start is compleated
- Rev 1.11 2003.07.08 2:41:52 PM czhower
- Avoid calling SetThreadName if we do not need to
- Rev 1.10 08.07.2003 13:16:18 ARybin
- tiny opt fix
- Rev 1.9 7/1/2003 7:11:30 PM BGooijen
- Added comment
- Rev 1.8 2003.07.01 4:14:58 PM czhower
- Consolidation.
- Added Name, Loop
- Rev 1.7 04.06.2003 14:06:20 ARybin
- bug fix & limited waiting
- Rev 1.6 28.05.2003 14:16:16 ARybin
- WaitAllThreadsTerminated class method
- Rev 1.5 08.05.2003 12:45:10 ARybin
- "be sure" fix
- Rev 1.4 4/30/2003 4:53:26 PM BGooijen
- Fixed bug in Kylix where GThreadCount was not decremented
- Rev 1.3 4/22/2003 4:44:06 PM BGooijen
- changed Handle to ThreadID
- Rev 1.2 3/22/2003 12:53:26 PM BGooijen
- - Exceptions in the constructor are now handled better.
- - GThreadCount can't become negative anymore
- Rev 1.1 06.03.2003 11:54:24 ARybin
- TIdThreadOptions: is thread Data owner, smart Cleanup
- Rev 1.0 11/13/2002 09:01:14 AM JPMugaas
- 2002-03-12 -Andrew P.Rybin
- -TerminatingExceptionClass, etc.
- 2002-06-20 -Andrew P.Rybin
- -"Terminated Start" bug fix (FLock.Leave AV)
- -Wait All threads termination in FINALIZATION (prevent AV in WinSock)
- -HandleRunException
- 2003-01-27 -Andrew P.Rybin
- -TIdThreadOptions
- }
- unit IdThread;
- {
- 2002-03-12 -Andrew P.Rybin
- -TerminatingExceptionClass, etc.
- 2002-06-20 -Andrew P.Rybin
- -"Terminated Start" bug fix (FLock.Leave AV)
- -Wait All threads termination in FINALIZATION (prevent AV in WinSock)
- -HandleRunException
- 2003-01-27 -Andrew P.Rybin
- -TIdThreadOptions
- }
- interface
- {$I IdCompilerDefines.inc}
- // RLebeau: On OSX/iOS, an auto-release object pool should be used to clean up
- // Objective-C objects that are created within a thread. On Android, any thread
- // that uses Java objects will attach to the JVM and must be detached from the
- // JVM before terminating.
- //
- // All objects must be released before terminating/detaching the thread.
- //
- // This problem was fixed in TThread in RAD Studio XE6.
- //
- {$UNDEF PLATFORM_CLEANUP_NEEDED}
- {$IFDEF DCC}
- {$IFNDEF VCL_XE6_OR_ABOVE}
- {$IFDEF MACOS}
- {$DEFINE PLATFORM_CLEANUP_NEEDED}
- {$ENDIF MACOS}
- {$IFDEF ANDROID}
- {$DEFINE PLATFORM_CLEANUP_NEEDED}
- {$ENDIF}
- {$ENDIF}
- {$ELSE}
- // TODO: Does this need to be applied to FreePascal?
- {$ENDIF}
- uses
- Classes,
- IdGlobal, IdException, IdYarn, IdTask, IdThreadSafe, SysUtils;
- const
- IdWaitAllThreadsTerminatedCount = 1 * 60 * 1000;
- IdWaitAllThreadsTerminatedStep = 250;
- type
- EIdThreadException = class(EIdException);
- EIdThreadTerminateAndWaitFor = class(EIdThreadException);
- TIdThreadStopMode = (smTerminate, smSuspend);
- TIdThread = class;
- TIdExceptionThreadEvent = procedure(AThread: TIdThread; AException: Exception) of object;
- TIdNotifyThreadEvent = procedure(AThread: TIdThread) of object;
- TIdSynchronizeThreadEvent = procedure(AThread: TIdThread; AData: Pointer) of object;
- // Note: itoDataOwner doesn't make sense in DCC nextgen when AutoRefCounting is enabled...
- TIdThreadOption = (itoStopped, itoReqCleanup, itoDataOwner, itoTag);
- TIdThreadOptions = set of TIdThreadOption;
- TIdThread = class(TThread)
- protected
- {$IFDEF USE_OBJECT_ARC}
- // When ARC is enabled, object references MUST be valid objects.
- // It is common for users to store non-object values, though, so
- // we will provide separate properties for those purposes
- //
- // TODO; use TValue instead of separating them
- //
- FDataObject: TObject;
- FDataValue: PtrInt;
- {$ELSE}
- FData: TObject;
- {$ENDIF}
- FLock: TIdCriticalSection;
- FLoop: Boolean;
- FName: string;
- FStopMode: TIdThreadStopMode;
- FOptions: TIdThreadOptions;
- FTerminatingException: String;
- FTerminatingExceptionClass: TClass;
- FYarn: TIdYarn;
- //
- FOnException: TIdExceptionThreadEvent;
- FOnStopped: TIdNotifyThreadEvent;
- //
- {$IFDEF PLATFORM_CLEANUP_NEEDED}
- {$IFDEF MACOS}
- FObjCPool: Pointer;
- {$ENDIF}
- {$ENDIF}
- procedure AfterRun; virtual; //3* not abstract - otherwise it is required
- procedure AfterExecute; virtual;//5 not abstract - otherwise it is required
- procedure BeforeExecute; virtual;//1 not abstract - otherwise it is required
- procedure BeforeRun; virtual; //2* not abstract - otherwise it is required
- procedure Cleanup; virtual;//4*
- procedure DoException(AException: Exception); virtual;
- procedure DoStopped; virtual;
- procedure Execute; override;
- {$IFDEF PLATFORM_CLEANUP_NEEDED}
- procedure DoTerminate; override;
- {$ENDIF}
- function GetStopped: Boolean;
- function HandleRunException(AException: Exception): Boolean; virtual;
- procedure Run; virtual; abstract;
- class procedure WaitAllThreadsTerminated(AMSec: Integer = IdWaitAllThreadsTerminatedCount); {$IFDEF HAS_DEPRECATED}deprecated;{$ENDIF}
- public
- constructor Create(ACreateSuspended: Boolean = True;
- ALoop: Boolean = True; const AName: string = ''); virtual;
- destructor Destroy; override;
- procedure Start; {$IFDEF DEPRECATED_TThread_SuspendResume}reintroduce;{$ENDIF} virtual;
- procedure Stop; virtual;
- procedure Synchronize(Method: TThreadMethod); overload;
- {$IFDEF HAS_TThreadProcedure}
- procedure Synchronize(Method: TThreadProcedure); overload;
- {$ENDIF}
- // Here to make virtual
- procedure Terminate; virtual;
- procedure TerminateAndWaitFor; virtual;
- //
- {$IFDEF USE_OBJECT_ARC}
- property DataObject: TObject read FDataObject write FDataObject;
- property DataValue: PtrInt read FDataValue write FDataValue;
- {$ELSE}
- property Data: TObject read FData write FData;
- {$ENDIF}
- property Loop: Boolean read FLoop write FLoop;
- property Name: string read FName write FName;
- property ReturnValue;
- property StopMode: TIdThreadStopMode read FStopMode write FStopMode;
- property Stopped: Boolean read GetStopped;
- property Terminated;
- // TODO: Change this to be like TIdFiber. D6 implementation is not as good
- // as what is done in TIdFiber.
- property TerminatingException: string read FTerminatingException;
- property TerminatingExceptionClass: TClass read FTerminatingExceptionClass;
- //Represents the thread or fiber for the scheduler of the thread.
- property Yarn: TIdYarn read FYarn write FYarn;
- //
- property OnException: TIdExceptionThreadEvent read FOnException write FOnException;
- property OnStopped: TIdNotifyThreadEvent read FOnStopped write FOnStopped;
- end;
- TIdThreadWithTask = class(TIdThread)
- protected
- FTask: TIdTask;
- //
- procedure AfterRun; override;
- procedure BeforeRun; override;
- procedure Run; override;
- procedure DoException(AException: Exception); override;
- procedure SetTask(AValue: TIdTask);
- public
- // Defaults because
- // Must always create suspended so task can be set
- // And a bit crazy to create a non looped task
- constructor Create(
- ATask: TIdTask = nil;
- const AName: string = ''
- ); reintroduce; virtual;
- destructor Destroy; override;
- //
- // Must be writeable because tasks are often created after thread or
- // thread is pooled
- property Task: TIdTask read FTask write SetTask;
- end;
- TIdThreadClass = class of TIdThread;
- TIdThreadWithTaskClass = class of TIdThreadWithTask;
- var
- // GThreadCount should be in implementation as it is not needed outside of
- // this unit. However with D8, GThreadCount will be deallocated before the
- // finalization can run and thus when the finalization accesses GThreadCount
- // in TerminateAll an error occurs. Moving this declaration to the interface
- // "fixes" it.
- GThreadCount: TIdThreadSafeInteger = nil{$IFDEF HAS_DEPRECATED}{$IFDEF USE_SEMICOLON_BEFORE_DEPRECATED};{$ENDIF} deprecated{$ENDIF};
- implementation
- uses
- //facilitate inlining only.
- {$IFDEF DOTNET}
- {$IFDEF USE_INLINE}
- System.Threading,
- {$ENDIF}
- {$ENDIF}
- {$IFDEF USE_VCL_POSIX}
- Posix.SysSelect,
- Posix.SysTime,
- {$ENDIF}
- {$IFDEF VCL_XE3_OR_ABOVE}
- System.SyncObjs,
- System.Types,
- {$ENDIF}
- {$IFDEF PLATFORM_CLEANUP_NEEDED}
- {$IFDEF MACOS}
- Macapi.ObjCRuntime,
- {$ENDIF}
- {$IFDEF ANDROID}
- Androidapi.NativeActivity,
- {$ENDIF}
- {$ENDIF}
- IdSchedulerOfThread, IdScheduler,
- IdResourceStringsCore;
- {$I IdDeprecatedImplBugOff.inc}
- class procedure TIdThread.WaitAllThreadsTerminated(AMSec: Integer = IdWaitAllThreadsTerminatedCount);
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$I IdSymbolDeprecatedOff.inc}
- while AMSec > 0 do begin
- if GThreadCount.Value = 0 then begin
- Break;
- end;
- IndySleep(IdWaitAllThreadsTerminatedStep);
- AMSec := AMSec - IdWaitAllThreadsTerminatedStep;
- end;
- {$I IdSymbolDeprecatedOn.inc}
- end;
- procedure TIdThread.TerminateAndWaitFor;
- begin
- if FreeOnTerminate then begin
- raise EIdThreadTerminateAndWaitFor.Create(RSThreadTerminateAndWaitFor);
- end;
- Terminate;
- Start; //resume
- WaitFor;
- end;
- procedure TIdThread.BeforeRun;
- begin
- end;
- procedure TIdThread.AfterRun;
- begin
- end;
- procedure TIdThread.BeforeExecute;
- begin
- end;
- procedure TIdThread.AfterExecute;
- begin
- end;
- procedure TIdThread.Execute;
- begin
- // Must make this call from INSIDE the thread. The call in Create
- // was naming the thread that was creating this thread. :(
- //
- // RLebeau - no need to put this inside the try blocks below as it
- // already uses its own try..except block internally
- if Name = '' then begin
- Name := 'IdThread (unknown)'; {do not localize}
- end;
- SetThreadName(Name);
- {$IFDEF PLATFORM_CLEANUP_NEEDED}
- {$IFDEF MACOS}
- // Register the auto release pool
- FObjCPool := objc_msgSend(objc_msgSend(objc_getClass('NSAutoreleasePool'), sel_getUid('alloc')), sel_getUid('init'));
- {$ENDIF MACOS}
- {$ENDIF}
- try
- BeforeExecute;
- try
- while not Terminated do begin
- if Stopped then begin
- DoStopped;
- // It is possible that either in the DoStopped or from another thread,
- // the thread is restarted, in which case we dont want to restop it.
- if Stopped then begin // DONE: if terminated?
- if Terminated then begin
- Break;
- end;
- // Thread manager will revive us
- {$IFDEF DEPRECATED_TThread_SuspendResume}
- Suspended := True;
- {$ELSE}
- Suspend;
- {$ENDIF}
- if Terminated then begin
- Break;
- end;
- end;
- end;
- Include(FOptions, itoReqCleanup);
- try
- try
- try
- BeforeRun;
- if Loop then begin
- while not Stopped do begin
- try
- Run;
- except
- on E: Exception do begin
- if not HandleRunException(E) then begin
- Terminate;
- raise;
- end;
- end;
- end;
- end;
- end else begin
- try
- Run;
- except
- on E: Exception do begin
- if not HandleRunException(E) then begin
- Terminate;
- raise;
- end;
- end;
- end;
- end;
- finally
- AfterRun;
- end;
- except
- Terminate;
- raise;
- end;
- finally
- Cleanup;
- end;
- end;
- finally
- AfterExecute;
- end;
- except
- on E: Exception do begin
- FTerminatingExceptionClass := E.ClassType;
- FTerminatingException := E.Message;
- DoException(E);
- Terminate;
- end;
- end;
- end;
- {$IFDEF PLATFORM_CLEANUP_NEEDED}
- procedure TIdThread.DoTerminate;
- {$IFDEF ANDROID}
- var
- PActivity: PANativeActivity;
- {$ENDIF}
- begin
- try
- inherited;
- finally
- {$IFDEF MACOS}
- // Last thing to do in thread is to drain the pool
- objc_msgSend(FObjCPool, sel_getUid('drain')); {do not localize}
- {$ENDIF}
- {$IFDEF ANDROID}
- // Detach the NativeActivity virtual machine to ensure the proper release of JNI contexts attached to the current thread
- PActivity := PANativeActivity(System.DelphiActivity);
- PActivity^.vm^.DetachCurrentThread(PActivity^.vm);
- {$ENDIF}
- end;
- end;
- {$ENDIF}
- constructor TIdThread.Create(ACreateSuspended: Boolean; ALoop: Boolean; const AName: string);
- begin
- {$IFDEF DOTNET}
- inherited Create(True);
- {$ENDIF}
- FOptions := [itoDataOwner];
- if ACreateSuspended then begin
- Include(FOptions, itoStopped);
- end;
- FLock := TIdCriticalSection.Create;
- Loop := ALoop;
- Name := AName;
- //
- {$IFDEF DOTNET}
- if not ACreateSuspended then begin
- {$IFDEF DEPRECATED_TThread_SuspendResume}
- Suspended := False;
- {$ELSE}
- Resume;
- {$ENDIF}
- end;
- {$ELSE}
- //
- // Most things BEFORE inherited - inherited creates the actual thread and if
- // not suspended will start before we initialize
- inherited Create(ACreateSuspended);
- {$IFNDEF VCL_6_OR_ABOVE}
- // Delphi 6 and above raise an exception when an error occures while
- // creating a thread (eg. not enough address space to allocate a stack)
- // Delphi 5 and below don't do that, which results in a TIdThread
- // instance with an invalid handle in it, therefore we raise the
- // exceptions manually on D5 and below
- if (ThreadID = 0) then begin
- IndyRaiseLastError;
- end;
- {$ENDIF}
- {$ENDIF}
- // Last, so we only do this if successful
- {$I IdSymbolDeprecatedOff.inc}
- GThreadCount.Increment;
- {$I IdSymbolDeprecatedOn.inc}
- end;
- destructor TIdThread.Destroy;
- begin
- inherited Destroy;
- try
- if itoReqCleanup in FOptions then begin
- Cleanup;
- end;
- finally
- // RLebeau- clean up the Yarn one more time, in case the thread was
- // terminated after the Yarn was assigned but the thread was not
- // re-started, so the Yarn would not be freed in Cleanup()
- try
- IdDisposeAndNil(FYarn);
- finally
- // Protect FLock if thread was resumed by Start Method and we are still there.
- // This usually happens if Exception was raised in BeforeRun for some reason
- // And thread was terminated there before Start method is completed.
- FLock.Enter; try
- finally FLock.Leave; end;
- FreeAndNil(FLock);
- {$I IdSymbolDeprecatedOff.inc}
- GThreadCount.Decrement;
- {$I IdSymbolDeprecatedOn.inc}
- end;
- end;
- end;
- procedure TIdThread.Start;
- begin
- FLock.Enter; try
- if Stopped then begin
- // Resume is also called for smTerminate as .Start can be used to initially start a
- // thread that is created suspended
- if Terminated then begin
- Include(FOptions,itoStopped);
- end else begin
- Exclude(FOptions,itoStopped);
- end;
- {$IFDEF DEPRECATED_TThread_SuspendResume}
- Suspended := False;
- {$ELSE}
- Resume;
- {$ENDIF}
- {APR: [in past] thread can be destroyed here! now Destroy wait FLock}
- end;
- finally FLock.Leave; end;
- end;
- procedure TIdThread.Stop;
- begin
- FLock.Enter; try
- if not Stopped then begin
- case FStopMode of
- smTerminate: Terminate;
- smSuspend: {DO not suspend here. Suspend is immediate. See Execute for implementation};
- end;
- Include(FOptions, itoStopped);
- end;
- finally FLock.Leave; end;
- end;
- function TIdThread.GetStopped: Boolean;
- begin
- if Assigned(FLock) then begin
- FLock.Enter; try
- // Suspended may be True if checking stopped from another thread
- Result := Terminated or (itoStopped in FOptions) or Suspended;
- finally FLock.Leave; end;
- end else begin
- Result := True; //user call Destroy
- end;
- end;
- procedure TIdThread.DoStopped;
- begin
- if Assigned(OnStopped) then begin
- OnStopped(Self);
- end;
- end;
- procedure TIdThread.DoException(AException: Exception);
- begin
- if Assigned(FOnException) then begin
- FOnException(Self, AException);
- end;
- end;
- procedure TIdThread.Terminate;
- begin
- //this assert can only raise if terminate is called on an already-destroyed thread
- Assert(FLock<>nil);
-
- FLock.Enter; try
- Include(FOptions, itoStopped);
- inherited Terminate;
- finally FLock.Leave; end;
- end;
- type
- TIdYarnOfThreadAccess = class(TIdYarnOfThread)
- end;
- procedure TIdThread.Cleanup;
- var
- LScheduler: TIdScheduler;
- LList: TIdYarnList;
- begin
- Exclude(FOptions, itoReqCleanup);
- // RLebeau 9/20/2019: there is a race condition here with TIdScheduler.TerminateAllYarns().
- // Notify TIdScheduler of the Yarn being freed here, otherwise, a double free of the Yarn
- // can happen if TIdThread.Cleanup() and TIdSchedulerOfThread.TerminateYarn() try to destroy
- // the Yarn at the same time. TerminateYarn() destroys the Yarn inside the ActiveYarns lock,
- // so the destroy here needs to be done inside of the same lock...
- //IdDisposeAndNil(FYarn);
- if FYarn is TIdYarnOfThread then
- begin
- {$I IdObjectChecksOff.inc}
- LScheduler := TIdYarnOfThreadAccess(FYarn).FScheduler;
- {$I IdObjectChecksOn.inc}
- if Assigned(LScheduler) then
- begin
- LList := LScheduler.ActiveYarns.LockList;
- try
- // if the Yarn is still in the list, remove and destroy it now.
- // If not, assume TIdScheduler has already done so ...
- if LList.Remove(FYarn) <> -1 then begin
- IdDisposeAndNil(FYarn);
- end;
- finally
- LScheduler.ActiveYarns.UnlockList;
- end;
- end;
- end else
- begin
- // just free the Yarn normally and let it figure out what to do...
- // TODO: is special handling needed for TIdYarnOfFiber like above?
- IdDisposeAndNil(FYarn);
- end;
- if itoDataOwner in FOptions then begin
- // TODO: use IdDisposeAndNil() instead?
- FreeAndNil({$IFDEF USE_OBJECT_ARC}FDataObject{$ELSE}FData{$ENDIF});
- end;
- {$IFDEF USE_OBJECT_ARC}
- FDataValue := 0;
- {$ENDIF}
- end;
- function TIdThread.HandleRunException(AException: Exception): Boolean;
- begin
- // Default behavior: Exception is death sentence
- Result := False;
- end;
- procedure TIdThread.Synchronize(Method: TThreadMethod);
- begin
- inherited Synchronize(Method);
- end;
- {$IFDEF HAS_TThreadProcedure}
- procedure TIdThread.Synchronize(Method: TThreadProcedure);
- begin
- inherited Synchronize(Method);
- end;
- {$ENDIF}
- { TIdThreadWithTask }
- procedure TIdThreadWithTask.AfterRun;
- begin
- FTask.DoAfterRun;
- inherited AfterRun;
- end;
- procedure TIdThreadWithTask.BeforeRun;
- begin
- inherited BeforeRun;
- FTask.DoBeforeRun;
- end;
- procedure TIdThreadWithTask.DoException(AException: Exception);
- begin
- inherited DoException(AException);
- FTask.DoException(AException);
- end;
- constructor TIdThreadWithTask.Create(ATask: TIdTask; const AName: string);
- begin
- inherited Create(True, True, AName);
- FTask := ATask;
- end;
- destructor TIdThreadWithTask.Destroy;
- begin
- FreeAndNil(FTask);
- inherited Destroy;
- end;
- procedure TIdThreadWithTask.Run;
- begin
- if not FTask.DoRun then begin
- Stop;
- end;
- end;
- procedure TIdThreadWithTask.SetTask(AValue: TIdTask);
- begin
- if FTask <> AValue then begin
- FreeAndNil(FTask);
- FTask := AValue;
- end;
- end;
- {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
- type
- TIdThreadSafeIntegerAccess = class(TIdThreadSafeInteger);
- {$ENDIF}
-
- initialization
- // RLebeau 7/19/09: According to RAID #271221:
- //
- // "Indy always names the main thread. It should not name the main thread,
- // it should only name threads that it creates. This basically means that
- // any app that uses Indy will end up with the main thread named "Main".
- //
- // The IDE currently names it's main thread, but because Indy is used by
- // the dcldbx140.bpl package which gets loaded by the IDE, the name used
- // for the main thread always ends up being overwritten with the name
- // Indy gives it."
- //
- // So, DO NOT uncomment the following line...
- // SetThreadName('Main'); {do not localize}
- {$I IdSymbolDeprecatedOff.inc}
- GThreadCount := TIdThreadSafeInteger.Create;
- {$IFNDEF FREE_ON_FINAL}
- {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
- IndyRegisterExpectedMemoryLeak(GThreadCount);
- {$I IdObjectChecksOff.inc}
- IndyRegisterExpectedMemoryLeak(TIdThreadSafeIntegerAccess(GThreadCount).FCriticalSection);
- {$I IdObjectChecksOn.inc}
- {$ENDIF}
- {$ENDIF}
- {$I IdSymbolDeprecatedOn.inc}
- finalization
- // This call hangs if not all threads have been properly destroyed.
- // But without this, bad threads can often have worse results. Catch 22.
- // TIdThread.WaitAllThreadsTerminated;
- {$IFDEF FREE_ON_FINAL}
- //only enable this if you know your code exits thread-clean
- {$I IdSymbolDeprecatedOff.inc}
- FreeAndNil(GThreadCount);
- {$I IdSymbolDeprecatedOn.inc}
- {$ENDIF}
- end.
|