asynccalls.pas

Asyncronous call of delphi functions and procedures.

class procedure TThread.WakeMainThread(Sender: TObject);
begin
  if Assigned(OrgWakeMainThread) then
    OrgWakeMainThread(Sender);
  SetEvent(SyncEvent);
end;

procedure HookWakeMainThread;
begin
  OrgWakeMainThread := Classes.WakeMainThread;
  Classes.WakeMainThread := TThread.WakeMainThread;
end;

procedure UnhookWakeMainThread;
begin
  Classes.WakeMainThread := OrgWakeMainThread;
end;
{$ENDIF DELPHI6}

type
  { TAsyncCallThread is a pooled thread. It looks itself for work. }
  TAsyncCallThread = class(TThread)
  protected
    procedure Execute; override;
  public
    procedure ForceTerminate;
  end;

  { TThreadPool contains a pool of threads that are either suspended or busy. }
  TThreadPool = class(TObject)
  private
    FMaxThreads: Integer;
    FThreads: TThreadList;
    FAsyncCalls: TThreadList;
    FNumberOfProcessors: Cardinal;

    FMainThreadSyncEvent: THandle;
    FMainThreadVclHandle: HWND;
    procedure MainThreadWndProc(var Msg: TMessage);
    procedure ProcessMainThreadSync;

    function AllocThread: TAsyncCallThread;
    function GetNextAsyncCall(Thread: TAsyncCallThread): TAsyncCall; // called from the threads
  public
    constructor Create;
    destructor Destroy; override;

    procedure SendVclSync(Call: TAsyncCall);

    procedure AddAsyncCall(Call: TAsyncCall);
    function RemoveAsyncCall(Call: TAsyncCall): Boolean;

    property MaxThreads: Integer read FMaxThreads;
    property NumberOfProcessors: Cardinal read FNumberOfProcessors;
    property MainThreadSyncEvent: THandle read FMainThreadSyncEvent;
  end;

{ ---------------------------------------------------------------------------- }

  TAsyncCallArgObject = class(TAsyncCall)
  private
    FProc: TAsyncCallArgObjectProc;
    FArg: TObject;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgObjectProc; AArg: TObject);
  end;

  TAsyncCallArgString = class(TAsyncCall)
  private
    FProc: TAsyncCallArgStringProc;
    FArg: AnsiString;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgStringProc; const AArg: AnsiString);
  end;

  TAsyncCallArgWideString = class(TAsyncCall)
  private
    FProc: TAsyncCallArgWideStringProc;
    FArg: WideString;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgWideStringProc; const AArg: WideString);
  end;

  TAsyncCallArgInterface = class(TAsyncCall)
  private
    FProc: TAsyncCallArgInterfaceProc;
    FArg: IInterface;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgInterfaceProc; const AArg: IInterface);
  end;

  TAsyncCallArgExtended = class(TAsyncCall)
  private
    FProc: TAsyncCallArgExtendedProc;
    FArg: Extended;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgExtendedProc; const AArg: Extended);
  end;

  TAsyncCallArgVariant = class(TAsyncCall)
  private
    FProc: TAsyncCallArgVariantProc;
    FArg: Variant;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgVariantProc; const AArg: Variant);
  end;

{ ---------------------------------------------------------------------------- }

  TAsyncCallLocalProc = class(TAsyncCall)
  private
    FProc: TLocalAsyncProc;
    FBasePointer: Pointer;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TLocalAsyncProc; ABasePointer: Pointer);
  end;

  TAsyncCallLocalProcEx = class(TAsyncCall)
  private
    FProc: TLocalAsyncProc;
    FBasePointer: Pointer;
    FParam: INT_PTR;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TLocalAsyncProc; AParam: INT_PTR; ABasePointer: Pointer);
  end;

  TAsyncVclCallLocalProc = class(TAsyncCall)
  private
    FProc: TLocalVclProc;
    FBasePointer: Pointer;
    FParam: INT_PTR;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TLocalVclProc; AParam: INT_PTR; ABasePointer: Pointer);
  end;

{ ---------------------------------------------------------------------------- }

  TAsyncCallMethodArgObject = class(TAsyncCall)
  private
    FProc: TAsyncCallArgObjectMethod;
    FArg: TObject;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgObjectMethod; AArg: TObject);
  end;

  TAsyncCallMethodArgString = class(TAsyncCall)
  private
    FProc: TAsyncCallArgStringMethod;
    FArg: AnsiString;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgStringMethod; const AArg: AnsiString);
  end;

  TAsyncCallMethodArgWideString = class(TAsyncCall)
  private
    FProc: TAsyncCallArgWideStringMethod;
    FArg: WideString;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgWideStringMethod; const AArg: WideString);
  end;

  TAsyncCallMethodArgInterface = class(TAsyncCall)
  private
    FProc: TAsyncCallArgInterfaceMethod;
    FArg: IInterface;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgInterfaceMethod; const AArg: IInterface);
  end;

  TAsyncCallMethodArgExtended = class(TAsyncCall)
  private
    FProc: TAsyncCallArgExtendedMethod;
    FArg: Extended;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgExtendedMethod; const AArg: Extended);
  end;

  TAsyncCallMethodArgVariant = class(TAsyncCall)
  private
    FProc: TAsyncCallArgVariantMethod;
    FArg: Variant;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgVariantMethod; const AArg: Variant);
  end;

{ ---------------------------------------------------------------------------- }

  TAsyncCallArgRecord = class(TAsyncCall)
  private
    FProc: TAsyncCallArgRecordProc;
    FArg: Pointer;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgRecordProc; AArg: Pointer);
  end;

  TAsyncCallMethodArgRecord = class(TAsyncCall)
  private
    FProc: TAsyncCallArgRecordMethod;
    FArg: Pointer;
  protected
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: TAsyncCallArgRecordMethod; AArg: Pointer);
  end;

  TAsyncCallArrayOfConst = class(TAsyncCall)
  private
    FProc: function: Integer register;
    FArgs: array of TVarRec;
  protected
    function CopyVarRec(const Data: TVarRec): TVarRec;
    function ExecuteAsyncCall: Integer; override;
  public
    constructor Create(AProc: Pointer; const AArgs: array of const); overload;
    constructor Create(AProc: Pointer; MethodData: TObject; const AArgs: array of const); overload;
    destructor Destroy; override;
  end;

{ ---------------------------------------------------------------------------- }
var
  ThreadPool: TThreadPool;

procedure SetMaxAsyncCallThreads(MaxThreads: Integer);
begin
  if MaxThreads >= 0 then
    ThreadPool.FMaxThreads := MaxThreads;
end;

function GetMaxAsyncCallThreads: Integer;
begin
  Result := ThreadPool.FMaxThreads
end;

{ ---------------------------------------------------------------------------- }

function AsyncCall(Proc: TAsyncCallArgObjectProc; Arg: TObject): IAsyncCall;
begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Proc(Arg))
  else
    Result := TAsyncCallArgObject.Create(Proc, Arg).ExecuteAsync;
end;

function AsyncCall(Proc: TAsyncCallArgIntegerProc; Arg: Integer): IAsyncCall;
begin
  Result := AsyncCall(TAsyncCallArgObjectProc(Proc), TObject(Arg));
end;

function AsyncCall(Proc: TAsyncCallArgStringProc; const Arg: AnsiString): IAsyncCall;
begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Proc(Arg))
  else
    Result := TAsyncCallArgString.Create(Proc, Arg).ExecuteAsync;
end;

function AsyncCall(Proc: TAsyncCallArgWideStringProc; const Arg: WideString): IAsyncCall;
begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Proc(Arg))
  else
    Result := TAsyncCallArgWideString.Create(Proc, Arg).ExecuteAsync;
end;

function AsyncCall(Proc: TAsyncCallArgInterfaceProc; const Arg: IInterface): IAsyncCall;
begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Proc(Arg))
  else
    Result := TAsyncCallArgInterface.Create(Proc, Arg).ExecuteAsync;
end;

function AsyncCall(Proc: TAsyncCallArgExtendedProc; const Arg: Extended): IAsyncCall;
begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Proc(Arg))
  else
    Result := TAsyncCallArgExtended.Create(Proc, Arg).ExecuteAsync;
end;

function AsyncCallVar(Proc: TAsyncCallArgVariantProc; const Arg: Variant): IAsyncCall;
begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Proc(Arg))
  else
    Result := TAsyncCallArgVariant.Create(Proc, Arg).ExecuteAsync;
end;

{ ---------------------------------------------------------------------------- }

function AsyncCall(Method: TAsyncCallArgObjectMethod; Arg: TObject): IAsyncCall;
begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Method(Arg))
  else
    Result := TAsyncCallMethodArgObject.Create(Method, Arg).ExecuteAsync;
end;

function AsyncCall(Method: TAsyncCallArgIntegerMethod; Arg: Integer): IAsyncCall;
begin
  Result := AsyncCall(TAsyncCallArgObjectMethod(Method), TObject(Arg));
end;

function AsyncCall(Method: TAsyncCallArgStringMethod; const Arg: AnsiString): IAsyncCall;
begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Method(Arg))
  else
    Result := TAsyncCallMethodArgString.Create(Method, Arg).ExecuteAsync;
end;

function AsyncCall(Method: TAsyncCallArgWideStringMethod; const Arg: WideString): IAsyncCall;
begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Method(Arg))
  else
    Result := TAsyncCallMethodArgWideString.Create(Method, Arg).ExecuteAsync;
end;

function AsyncCall(Method: TAsyncCallArgInterfaceMethod; const Arg: IInterface): IAsyncCall;
begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Method(Arg))
  else
    Result := TAsyncCallMethodArgInterface.Create(Method, Arg).ExecuteAsync;
end;

function AsyncCall(Method: TAsyncCallArgExtendedMethod; const Arg: Extended): IAsyncCall;
begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Method(Arg))
  else
    Result := TAsyncCallMethodArgExtended.Create(Method, Arg).ExecuteAsync;
end;

function AsyncCallVar(Method: TAsyncCallArgVariantMethod; const Arg: Variant): IAsyncCall;