Unit Joinable Threads

(* Joinable threads library for Delphi. Copyright (c) 2009, Andrei Borovsky. 
Free for both commercial and non-commercial use. You can contact me at  anb@symmetrica.net *)

unit JoinableThreads;

interface

uses
  Windows, Messages, SysUtils, Classes;

type

  TJoinableThread = class(TThread)
  public
    procedure AfterConstruction; override;
  end;

  (* Function: Join Blocks the calling thread until all the exisiting
      joinable threads are terminated. If no joinable thread is currently executed Join
      returns immediately. *)
  procedure Join;

  (* Function: GetJoinableThreadsCount Returns the current number
      of joinable threads. *)
   function GetJoinableThreadsCount : Integer;

  (* Function: TerminateJoinableThread This is a wrapper around
      the TerminateThread Windows API call to forcibly terminate a joinable thread. *)
   function TerminateJoinableThread(AThread : TJoinableThread; Exicode : LongWord) : Boolean;

implementation

var
  Counter : Integer = 0;
  CS : TRTLCriticalSection;
  JoinEvent : THandle;
  OldProc : TSystemThreadEndProc;

  procedure TJoinableThread.AfterConstruction;
  begin
    EnterCriticalSection(CS);
    Inc(Counter);
    ResetEvent(JoinEvent);
    LeaveCriticalSection(CS);
    inherited;
  end;

  procedure ThreadEnd(ExitCode: Integer);
  begin
    EnterCriticalSection(CS);
    Dec(Counter);
    if Counter = 0 then SetEvent(JoinEvent);
    LeaveCriticalSection(CS);
    if Assigned(OldProc) then
       OldProc(ExitCode);
  end;

  procedure Join;
  begin
    WaitForSingleObject(JoinEvent, INFINITE);
  end;

  function GetJoinableThreadsCount : Integer;
  begin
    Result := Counter;
  end;

  function TerminateJoinableThread(AThread : TJoinableThread; 
                                   Exicode : LongWord) : Boolean;
  begin
    Result := TerminateThread(AThread.Handle, Exicode);
    if Result then
    begin
      EnterCriticalSection(CS);
      if Counter > 0 then (* Sanity check *)
        Dec(Counter);
      if Counter = 0 then SetEvent(JoinEvent);
      LeaveCriticalSection(CS);
    end;
  end;

initialization
  InitializeCriticalSection(CS);
  JoinEvent := CreateEvent(nil, True, True, nil); (* event is initially signaled so that call to Join 
                                                     before any thread is created wouldn't block. *)
  OldProc := SystemThreadEndProc; (* In Delphi 2009 SystemThreadEndProc is set to nil, 
                                     but this may change in the future. *)
  SystemThreadEndProc := ThreadEnd;

finalization
  CloseHandle(JoinEvent);
  DeleteCriticalSection(CS);

end.
Другие статьи по Delphi