uThread

Post date: Jul 17, 2010 1:17:40 AM

uThread is designed as a lightweight replacement for the TThread class in the Classes delphi unit.

There is a small bug in the code:

If you call WaitFor, the next time, the thread tries to enter the critical section and you run into a deadlock.

{#########################################
#                                                                                #
#  uThread                                                                   #
#                                                                                #
#  Author:   testest                                                       #
#  Date:     2010-07-09                                                  #
#  Version:  0.1                                                             #
#                                                                                #
#  Thanks to Aphex for his ThreadUnit                               #
#                                                                                #
#  ToDo:                                                                      #
#    - Fix WaitFor                                                           #
#                                                                                #
##########################################}
unit uThread;
interface
uses Windows;
type
  TNotifyEvent = procedure(Sender: TObject) of object;
  TSynchronizeProcedure = procedure of object;
  TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal,
                     tpHigher, tpHighest, tpTimeCritical);
  TThread = class
  private
    FHandle: THandle;
    FThreadId: Cardinal;
    FTerminated: Boolean;
    FSuspended: Boolean;
    FExitCode: Cardinal;
    FOnTerminate: TNotifyEvent;
    FFreeOnTerminate: Boolean;
    FPriority: TThreadPriority;
    FData: TObject;
    FFreeDataOnTerminate: Boolean;
    procedure SetPriority(Value: TThreadPriority);
  protected
    procedure Synchronize(SnycProc: TSynchronizeProcedure);
    procedure Execute; virtual; abstract;
  public
    constructor Create(CreateSuspended: Boolean);
    procedure Resume;
    procedure Suspend;
    procedure Terminate;
    function WaitFor(Timeout: Cardinal = INFINITE): Cardinal;
    property Terminated: Boolean read FTerminated;
    property Suspended: Boolean read FSuspended;
    property Priority: TThreadPriority read FPriority write SetPriority;
    property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;
    property ExitCode: Cardinal read FExitCode;
    property Handle: THandle read FHandle;
    property Id: Cardinal read FThreadId;
    property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
    property Data: TObject read FData write FData;
    property FreeDataOnTerminate: Boolean read FFreeDataOnTerminate write FFreeDataOnTerminate;
    procedure Lock;
    procedure Unlock;
    destructor Destroy; override;
  end;
implementation
const
  THREAD_ERROR = Cardinal(-1);
var
  ThreadLock: TRTLCriticalSection;
function ThreadFunc(Thread: Pointer): Integer;
begin
  with TThread(Thread) do try
    Execute;
  finally
    GetExitCodeThread(FHandle, Cardinal(Result));
    FExitCode := Result;
    FTerminated := True;
    if Assigned(FOnTerminate) then
    begin
      Lock;
      try
        FOnTerminate(Thread);
      finally
        Unlock;
      end;
    end;
    if FFreeDataOnTerminate then
      FData.Free;
    if FFreeOnTerminate then
      Free;
    ExitThread(Result);
  end;
end;
constructor TThread.Create(CreateSuspended: Boolean);
var
  Flags: Cardinal;
begin
  inherited Create;
  FTerminated := False;
  FSuspended := CreateSuspended;
  FExitCode := 0;
  FOnTerminate := nil;
  FFreeOnTerminate := False;
  FPriority := tpNormal;
  FData := nil;
  FFreeDataOnTerminate := False;
  if CreateSuspended then
    Flags := CREATE_SUSPENDED
  else
    Flags := 0;
  FHandle := BeginThread(nil, 0, ThreadFunc, Pointer(Self), Flags, FThreadId);
end;
procedure TThread.Synchronize(SnycProc: TSynchronizeProcedure);
begin
  Lock;
  try
    SnycProc;
  finally
    Unlock;
  end;
end;
procedure TThread.SetPriority(Value: TThreadPriority);
var
  Priority: Integer;
begin
  if Value <> FPriority then
  begin
    case Value of
      tpIdle: Priority := THREAD_PRIORITY_IDLE;
      tpTimeCritical: Priority := THREAD_PRIORITY_TIME_CRITICAL;
      else Priority := Integer(Value) - THREAD_PRIORITY_NORMAL;
    end;
    if SetThreadPriority(FHandle, Priority) then
      FPriority := Value;
  end;
end;
procedure TThread.Resume;
begin
  if FSuspended and (ResumeThread(FHandle) <> THREAD_ERROR) then
    FSuspended := False;
end;
procedure TThread.Suspend;
begin
  if not Suspended and (SuspendThread(FHandle) <> THREAD_ERROR) then
    FSuspended := True;
end;
procedure TThread.Terminate;
begin
  if not FTerminated then
    FTerminated := True;
end;
function TThread.WaitFor(Timeout: Cardinal = INFINITE): Cardinal;
begin
  Result := WaitForSingleObject(FHandle, Timeout);
end;
procedure TThread.Lock;
begin
  EnterCriticalSection(ThreadLock);
end;
procedure TThread.Unlock;
begin
  LeaveCriticalSection(ThreadLock);
end;
destructor TThread.Destroy;
begin
  CloseHandle(FHandle);
  inherited Destroy;
end;
initialization
  InitializeCriticalSection(ThreadLock);
finalization
  DeleteCriticalSection(ThreadLock);
end.