Board index » delphi » a riddle about TAutoObject descendant, main VCL thread, and single apartment thread

a riddle about TAutoObject descendant, main VCL thread, and single apartment thread

Hi, All!

Could somebody explain me the following riddle about
TAutoObject descendant implementing a COM interface
in a single apartment thread.
The following code line creates the COM object strictly
in the main VCL thread context, however the current
thread is not the main VCL thread
      AIWorkerObject := CoWorkerObject.Create;
whereas the following one
      AIWorkerObject := TWorkerObject.Create;
creates the object in the current thread context.

Why is it so?
The sample project is following.

Project1.dpr
--------------
program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Project1_TLB in 'Project1_TLB.pas',
  Unit2 in 'Unit2.pas' {WorkerObject: CoClass},
  Unit3 in 'Unit3.pas';

{$R *.TLB}

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit1.pas
----------
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Unit3, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FWorkerThread: TWorkerThread;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
  FWorkerThread := TWorkerThread.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FWorkerThread);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Assert(Assigned(FWorkerThread));
  FWorkerThread.DoSomething;
end;

end.

unit1.dfm
----------
object Form1: TForm1
  Left = 168
  Top = 170
  Width = 261
  Height = 153
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 120
  TextHeight = 16
  object Button1: TButton
    Left = 64
    Top = 32
    Width = 121
    Height = 57
    Caption = 'DoSomething'
    TabOrder = 0
    OnClick = Button1Click
  end
end

unit2.pas
-----------
unit Unit2;

interface

uses
  Windows, ComObj, ActiveX, Project1_TLB, StdVcl;
type
  TWorkerObject = class(TAutoObject, IWorkerObject)
  protected
    { Protected declarations }
    procedure DoSomething; safecall;
  end;

implementation

uses ComServ;

procedure TWorkerObject.DoSomething;
begin
  MessageBeep($FFFFFFFF);
end;

initialization
  TAutoObjectFactory.Create(ComServer, TWorkerObject, Class_WorkerObject,
    ciMultiInstance, tmApartment);
end.

unit3.pas
-----------
unit Unit3;

interface

uses
  Windows, SyncObjs, ComObj, ActiveX, SysUtils, Classes, Project1_TLB,
Unit2;

type
  TWorkerThread = class(TThread)
  private
    { Private declarations }
    FThreadEvent: TEvent;
    FStream: Pointer;
    FIWorkerObjectStub: IWorkerObject;
  protected
    procedure Execute; override;
  public
    constructor Create; reintroduce;
    procedure MsgWaitFor;
    destructor Destroy; override;
    procedure DoSomething;
  end;

implementation

{ TWorkerThread }

constructor TWorkerThread.Create;
begin
  inherited Create(True);
  FreeOnTerminate := False;
  FThreadEvent := TEvent.Create(nil, True, False, '');
  Resume;
  if Suspended then Abort;
  FThreadEvent.WaitFor(INFINITE);
  CoGetInterfaceAndReleaseStream(IStream(FStream),
    IWorkerObject, FIWorkerObjectStub);
  FStream := nil;
end;

destructor TWorkerThread.Destroy;
begin
  try
    try
      try
        FIWorkerObjectStub := nil;
      finally
        MsgWaitFor;
      end;
    finally
      FreeAndNil(FThreadEvent);
    end;
  finally
    inherited Destroy;
  end;
end;

procedure TWorkerThread.DoSomething;
begin
  Assert(Assigned(FIWorkerObjectStub));
  FIWorkerObjectStub.DoSomething;
end;

procedure TWorkerThread.Execute;
var
  ThreadEvent: Boolean;
  AIWorkerObject: IWorkerObject;
  AIUnk: IUnknown;
  Msg: TMsg;
begin
  ThreadEvent := False;
  try
    OleCheck(CoInitialize(nil));
    try
// It won't work 'cause the object is cretated in the main VCL thread
      AIWorkerObject := CoWorkerObject.Create;
// You will never be here 'cause the main VCL thread is waiting
// in FThreadEvent.WaitFor(INFINITE);

// But the following code line is working as desired and the object
// is created in this thread instead of the main VCL thread
//      AIWorkerObject := TWorkerObject.Create;
      try
        AIUnk := AIWorkerObject as IUnknown;
        try
          OleCheck(CoMarshalInterThreadInterfaceInStream(IWorkerObject,
            AIUnk, IStream(FStream)));
        finally
          AIUnk := nil;
        end;
        FThreadEvent.SetEvent;
        ThreadEvent := True;
        while not Terminated do
        begin
          Sleep(50);
          while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
            DispatchMessage(Msg);
        end;
      finally
        AIWorkerObject := nil;
      end;
    finally
      CoUninitialize;
    end;
  except
    if not ThreadEvent then
      FThreadEvent.SetEvent;
  end;
end;

procedure TWorkerThread.MsgWaitFor;
var
  Msg: TMsg;
  H: THandle;
begin
  Terminate;
  H := Handle;
  while MsgWaitForMultipleObjects(1, H, False, 1000, QS_ALLINPUT) <>
WAIT_OBJECT_0 do
  begin
    while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;
end;

end.

Project1_tlb.pas
----------------
unit Project1_TLB;

// ************************************************************************
//
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************
//

// PASTLWTR : $Revision:   1.88.1.0.1.0  $
// File generated on 19.10.00 21:22:03 from Type Library described below.

// ************************************************************************
//
// Type Lib: C:\Program
Files\Borland\Delphi5\Projects\BUGGYAUTO\Project1.tlb (1)
// IID\LCID: {DC383C2D-3756-47E1-B338-3C31684ED315}\0
// Helpfile:
// DepndLst:
//   (1) v2.0 stdole, (C:\WINDOWS\SYSTEM\StdOle2.tlb)
//   (2) v4.0 StdVCL, (C:\WINDOWS\SYSTEM\STDVCL40.DLL)
// ************************************************************************
//
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
interface

uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;

// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
//   Type Libraries     : LIBID_xxxx
//   CoClasses          : CLASS_xxxx
//   DISPInterfaces     : DIID_xxxx
//   Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
  // TypeLibrary Major and minor versions
  Project1MajorVersion = 1;
  Project1MinorVersion = 0;

  LIBID_Project1: TGUID = '{DC383C2D-3756-47E1-B338-3C31684ED315}';

  IID_IWorkerObject: TGUID = '{80C8E7F0-392B-4335-B163-C7F69EE0F265}';
  CLASS_WorkerObject: TGUID = '{9729E293-A309-454A-8074-D4C1C91C5E3D}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
  IWorkerObject = interface;
  IWorkerObjectDisp = dispinterface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
  WorkerObject = IWorkerObject;
// *********************************************************************//
// Interface: IWorkerObject
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {80C8E7F0-392B-4335-B163-C7F69EE0F265}
// *********************************************************************//
  IWorkerObject = interface(IDispatch)
    ['{80C8E7F0-392B-4335-B163-C7F69EE0F265}']
    procedure DoSomething; safecall;
  end;

// *********************************************************************//
// DispIntf:  IWorkerObjectDisp
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {80C8E7F0-392B-4335-B163-C7F69EE0F265}
// *********************************************************************//
  IWorkerObjectDisp = dispinterface
    ['{80C8E7F0-392B-4335-B163-C7F69EE0F265}']
    procedure DoSomething; dispid 1;
  end;

// *********************************************************************//
// The Class CoWorkerObject provides a Create and CreateRemote method to
// create instances of the default interface IWorkerObject exposed by
// the CoClass WorkerObject. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
  CoWorkerObject = class
    class function Create: IWorkerObject;
    class function CreateRemote(const MachineName: string): IWorkerObject;
  end;

implementation

uses ComObj;

class function CoWorkerObject.Create: IWorkerObject;
begin
  Result := CreateComObject(CLASS_WorkerObject) as IWorkerObject;
end;

class function CoWorkerObject.CreateRemote(const MachineName: string):
IWorkerObject;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_WorkerObject) as
IWorkerObject;
end;

end.
------------

 

Re:a riddle about TAutoObject descendant, main VCL thread, and single apartment thread


Without spending too much time looking at your lengthy code....

Something := TWorkerObject.Create doesnt create the COM object using the COM
mechanism, so it will create fine anyway.  you should not be calling wait
inside the Thread.Create neither, as that is still inside the main calling
thread context.  The thread will not run until you have returned from the
create...and hence the deadlock.  What are you marshaling for? Where do you
want the COM object to get instanced and then used? Are you creating on main
thread and then passing to the worker thread? if so, marshal in the
thread.create and unmarshal in the execute once you have entered the
apartment.

I dont think that solves your problem, but offers a little guidance.

Nick.
instantiates the object without using COM.  Secondly,

Quote
"Dmitri" <udmi...@newmail.ru> wrote in message news:39ef3313_1@dnews...
> Hi, All!

> Could somebody explain me the following riddle about
> TAutoObject descendant implementing a COM interface
> in a single apartment thread.
> The following code line creates the COM object strictly
> in the main VCL thread context, however the current
> thread is not the main VCL thread
>       AIWorkerObject := CoWorkerObject.Create;
> whereas the following one
>       AIWorkerObject := TWorkerObject.Create;
> creates the object in the current thread context.

> Why is it so?
> The sample project is following.

> Project1.dpr
> --------------
> program Project1;

> uses
>   Forms,
>   Unit1 in 'Unit1.pas' {Form1},
>   Project1_TLB in 'Project1_TLB.pas',
>   Unit2 in 'Unit2.pas' {WorkerObject: CoClass},
>   Unit3 in 'Unit3.pas';

> {$R *.TLB}

> {$R *.RES}

> begin
>   Application.Initialize;
>   Application.CreateForm(TForm1, Form1);
>   Application.Run;
> end.

> unit1.pas
> ----------
> unit Unit1;

> interface

> uses
>   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
>   Unit3, StdCtrls;

> type
>   TForm1 = class(TForm)
>     Button1: TButton;
>     procedure Button1Click(Sender: TObject);
>     procedure FormCreate(Sender: TObject);
>     procedure FormDestroy(Sender: TObject);
>   private
>     { Private declarations }
>     FWorkerThread: TWorkerThread;
>   public
>     { Public declarations }
>   end;

> var
>   Form1: TForm1;

> implementation

> {$R *.DFM}

> procedure TForm1.FormCreate(Sender: TObject);
> begin
>   FWorkerThread := TWorkerThread.Create;
> end;

> procedure TForm1.FormDestroy(Sender: TObject);
> begin
>   FreeAndNil(FWorkerThread);
> end;

> procedure TForm1.Button1Click(Sender: TObject);
> begin
>   Assert(Assigned(FWorkerThread));
>   FWorkerThread.DoSomething;
> end;

> end.

> unit1.dfm
> ----------
> object Form1: TForm1
>   Left = 168
>   Top = 170
>   Width = 261
>   Height = 153
>   Caption = 'Form1'
>   Color = clBtnFace
>   Font.Charset = DEFAULT_CHARSET
>   Font.Color = clWindowText
>   Font.Height = -13
>   Font.Name = 'MS Sans Serif'
>   Font.Style = []
>   OldCreateOrder = False
>   OnCreate = FormCreate
>   OnDestroy = FormDestroy
>   PixelsPerInch = 120
>   TextHeight = 16
>   object Button1: TButton
>     Left = 64
>     Top = 32
>     Width = 121
>     Height = 57
>     Caption = 'DoSomething'
>     TabOrder = 0
>     OnClick = Button1Click
>   end
> end

> unit2.pas
> -----------
> unit Unit2;

> interface

> uses
>   Windows, ComObj, ActiveX, Project1_TLB, StdVcl;

> type
>   TWorkerObject = class(TAutoObject, IWorkerObject)
>   protected
>     { Protected declarations }
>     procedure DoSomething; safecall;
>   end;

> implementation

> uses ComServ;

> procedure TWorkerObject.DoSomething;
> begin
>   MessageBeep($FFFFFFFF);
> end;

> initialization
>   TAutoObjectFactory.Create(ComServer, TWorkerObject, Class_WorkerObject,
>     ciMultiInstance, tmApartment);
> end.

> unit3.pas
> -----------
> unit Unit3;

> interface

> uses
>   Windows, SyncObjs, ComObj, ActiveX, SysUtils, Classes, Project1_TLB,
> Unit2;

> type
>   TWorkerThread = class(TThread)
>   private
>     { Private declarations }
>     FThreadEvent: TEvent;
>     FStream: Pointer;
>     FIWorkerObjectStub: IWorkerObject;
>   protected
>     procedure Execute; override;
>   public
>     constructor Create; reintroduce;
>     procedure MsgWaitFor;
>     destructor Destroy; override;
>     procedure DoSomething;
>   end;

> implementation

> { TWorkerThread }

> constructor TWorkerThread.Create;
> begin
>   inherited Create(True);
>   FreeOnTerminate := False;
>   FThreadEvent := TEvent.Create(nil, True, False, '');
>   Resume;
>   if Suspended then Abort;
>   FThreadEvent.WaitFor(INFINITE);
>   CoGetInterfaceAndReleaseStream(IStream(FStream),
>     IWorkerObject, FIWorkerObjectStub);
>   FStream := nil;
> end;

> destructor TWorkerThread.Destroy;
> begin
>   try
>     try
>       try
>         FIWorkerObjectStub := nil;
>       finally
>         MsgWaitFor;
>       end;
>     finally
>       FreeAndNil(FThreadEvent);
>     end;
>   finally
>     inherited Destroy;
>   end;
> end;

> procedure TWorkerThread.DoSomething;
> begin
>   Assert(Assigned(FIWorkerObjectStub));
>   FIWorkerObjectStub.DoSomething;
> end;

> procedure TWorkerThread.Execute;
> var
>   ThreadEvent: Boolean;
>   AIWorkerObject: IWorkerObject;
>   AIUnk: IUnknown;
>   Msg: TMsg;
> begin
>   ThreadEvent := False;
>   try
>     OleCheck(CoInitialize(nil));
>     try
> // It won't work 'cause the object is cretated in the main VCL thread
>       AIWorkerObject := CoWorkerObject.Create;
> // You will never be here 'cause the main VCL thread is waiting
> // in FThreadEvent.WaitFor(INFINITE);

> // But the following code line is working as desired and the object
> // is created in this thread instead of the main VCL thread
> //      AIWorkerObject := TWorkerObject.Create;
>       try
>         AIUnk := AIWorkerObject as IUnknown;
>         try
>           OleCheck(CoMarshalInterThreadInterfaceInStream(IWorkerObject,
>             AIUnk, IStream(FStream)));
>         finally
>           AIUnk := nil;
>         end;
>         FThreadEvent.SetEvent;
>         ThreadEvent := True;
>         while not Terminated do
>         begin
>           Sleep(50);
>           while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
>             DispatchMessage(Msg);
>         end;
>       finally
>         AIWorkerObject := nil;
>       end;
>     finally
>       CoUninitialize;
>     end;
>   except
>     if not ThreadEvent then
>       FThreadEvent.SetEvent;
>   end;
> end;

> procedure TWorkerThread.MsgWaitFor;
> var
>   Msg: TMsg;
>   H: THandle;
> begin
>   Terminate;
>   H := Handle;
>   while MsgWaitForMultipleObjects(1, H, False, 1000, QS_ALLINPUT) <>
> WAIT_OBJECT_0 do
>   begin
>     while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
>     begin
>       TranslateMessage(Msg);
>       DispatchMessage(Msg);
>     end;
>   end;
> end;

> end.

> Project1_tlb.pas
> ----------------
> unit Project1_TLB;

> //

************************************************************************
Quote
> //
> // WARNING
> // -------
> // The types declared in this file were generated from data read from a
> // Type Library. If this type library is explicitly or indirectly (via
> // another type library referring to this type library) re-imported, or
the
> // 'Refresh' command of the Type Library Editor activated while editing
the
> // Type Library, the contents of this file will be regenerated and all
> // manual modifications will be lost.
> //

************************************************************************
Quote
> //

> // PASTLWTR : $Revision:   1.88.1.0.1.0  $
> // File generated on 19.10.00 21:22:03 from Type Library described below.

> //

************************************************************************
Quote
> //
> // Type Lib: C:\Program
> Files\Borland\Delphi5\Projects\BUGGYAUTO\Project1.tlb (1)
> // IID\LCID: {DC383C2D-3756-47E1-B338-3C31684ED315}\0
> // Helpfile:
> // DepndLst:
> //   (1) v2.0 stdole, (C:\WINDOWS\SYSTEM\StdOle2.tlb)
> //   (2) v4.0 StdVCL, (C:\WINDOWS\SYSTEM\STDVCL40.DLL)
> //

************************************************************************

- Show quoted text -

Quote
> //
> {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked
pointers.
> interface

> uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;

> // *********************************************************************//
> // GUIDS declared in the TypeLibrary. Following prefixes are used:
> //   Type Libraries     : LIBID_xxxx
> //   CoClasses          : CLASS_xxxx
> //   DISPInterfaces     : DIID_xxxx
> //   Non-DISP interfaces: IID_xxxx
> // *********************************************************************//
> const
>   // TypeLibrary Major and minor versions
>   Project1MajorVersion = 1;
>   Project1MinorVersion = 0;

>   LIBID_Project1: TGUID = '{DC383C2D-3756-47E1-B338-3C31684ED315}';

>   IID_IWorkerObject: TGUID = '{80C8E7F0-392B-4335-B163-C7F69EE0F265}';
>   CLASS_WorkerObject: TGUID = '{9729E293-A309-454A-8074-D4C1C91C5E3D}';
> type

> // *********************************************************************//
> // Forward declaration of types defined in TypeLibrary
> // *********************************************************************//
>   IWorkerObject = interface;
>   IWorkerObjectDisp = dispinterface;

> // *********************************************************************//
> // Declaration of CoClasses defined in Type Library
> // (NOTE: Here we map each CoClass to its Default Interface)
> // *********************************************************************//
>   WorkerObject = IWorkerObject;

> // *********************************************************************//
> // Interface: IWorkerObject
> // Flags:     (4416) Dual OleAutomation Dispatchable
> // GUID:      {80C8E7F0-392B-4335-B163-C7F69EE0F265}
> // *********************************************************************//
>   IWorkerObject = interface(IDispatch)
>     ['{80C8E7F0-392B-4335-B163-C7F69EE0F265}']
>     procedure DoSomething; safecall;

...

read more »

Re:a riddle about TAutoObject descendant, main VCL thread, and single apartment thread


This should work fine. The only thing I can think of this that TWorkerObject
is in the same DPR as your entire EXE project. In that case, the call to
CoWorkerObject.Create will wait because it's class factory
(IClassFactory.CreateInstance) will need to execute on the main thread to be
able to succesfully create CoWorkerObject - therefore, you cannot do a
WaitFor on the main thread because you'll lock up the class factory. If
TWorkerObject was implemented in a separate DLL COM server and
ThreadingModel=Apartment (and above), this should work fine.

have fun
--
Binh Ly
http://www.techvanguards.com

Quote
"Dmitri" <udmi...@newmail.ru> wrote in message news:39ef3313_1@dnews...
> Hi, All!

> Could somebody explain me the following riddle about
> TAutoObject descendant implementing a COM interface
> in a single apartment thread.
> The following code line creates the COM object strictly
> in the main VCL thread context, however the current
> thread is not the main VCL thread
>       AIWorkerObject := CoWorkerObject.Create;
> whereas the following one
>       AIWorkerObject := TWorkerObject.Create;
> creates the object in the current thread context.

> Why is it so?
> The sample project is following.

> Project1.dpr
> --------------
> program Project1;

> uses
>   Forms,
>   Unit1 in 'Unit1.pas' {Form1},
>   Project1_TLB in 'Project1_TLB.pas',
>   Unit2 in 'Unit2.pas' {WorkerObject: CoClass},
>   Unit3 in 'Unit3.pas';

> {$R *.TLB}

> {$R *.RES}

> begin
>   Application.Initialize;
>   Application.CreateForm(TForm1, Form1);
>   Application.Run;
> end.

> unit1.pas
> ----------
> unit Unit1;

> interface

> uses
>   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
>   Unit3, StdCtrls;

> type
>   TForm1 = class(TForm)
>     Button1: TButton;
>     procedure Button1Click(Sender: TObject);
>     procedure FormCreate(Sender: TObject);
>     procedure FormDestroy(Sender: TObject);
>   private
>     { Private declarations }
>     FWorkerThread: TWorkerThread;
>   public
>     { Public declarations }
>   end;

> var
>   Form1: TForm1;

> implementation

> {$R *.DFM}

> procedure TForm1.FormCreate(Sender: TObject);
> begin
>   FWorkerThread := TWorkerThread.Create;
> end;

> procedure TForm1.FormDestroy(Sender: TObject);
> begin
>   FreeAndNil(FWorkerThread);
> end;

> procedure TForm1.Button1Click(Sender: TObject);
> begin
>   Assert(Assigned(FWorkerThread));
>   FWorkerThread.DoSomething;
> end;

> end.

> unit1.dfm
> ----------
> object Form1: TForm1
>   Left = 168
>   Top = 170
>   Width = 261
>   Height = 153
>   Caption = 'Form1'
>   Color = clBtnFace
>   Font.Charset = DEFAULT_CHARSET
>   Font.Color = clWindowText
>   Font.Height = -13
>   Font.Name = 'MS Sans Serif'
>   Font.Style = []
>   OldCreateOrder = False
>   OnCreate = FormCreate
>   OnDestroy = FormDestroy
>   PixelsPerInch = 120
>   TextHeight = 16
>   object Button1: TButton
>     Left = 64
>     Top = 32
>     Width = 121
>     Height = 57
>     Caption = 'DoSomething'
>     TabOrder = 0
>     OnClick = Button1Click
>   end
> end

> unit2.pas
> -----------
> unit Unit2;

> interface

> uses
>   Windows, ComObj, ActiveX, Project1_TLB, StdVcl;

> type
>   TWorkerObject = class(TAutoObject, IWorkerObject)
>   protected
>     { Protected declarations }
>     procedure DoSomething; safecall;
>   end;

> implementation

> uses ComServ;

> procedure TWorkerObject.DoSomething;
> begin
>   MessageBeep($FFFFFFFF);
> end;

> initialization
>   TAutoObjectFactory.Create(ComServer, TWorkerObject, Class_WorkerObject,
>     ciMultiInstance, tmApartment);
> end.

> unit3.pas
> -----------
> unit Unit3;

> interface

> uses
>   Windows, SyncObjs, ComObj, ActiveX, SysUtils, Classes, Project1_TLB,
> Unit2;

> type
>   TWorkerThread = class(TThread)
>   private
>     { Private declarations }
>     FThreadEvent: TEvent;
>     FStream: Pointer;
>     FIWorkerObjectStub: IWorkerObject;
>   protected
>     procedure Execute; override;
>   public
>     constructor Create; reintroduce;
>     procedure MsgWaitFor;
>     destructor Destroy; override;
>     procedure DoSomething;
>   end;

> implementation

> { TWorkerThread }

> constructor TWorkerThread.Create;
> begin
>   inherited Create(True);
>   FreeOnTerminate := False;
>   FThreadEvent := TEvent.Create(nil, True, False, '');
>   Resume;
>   if Suspended then Abort;
>   FThreadEvent.WaitFor(INFINITE);
>   CoGetInterfaceAndReleaseStream(IStream(FStream),
>     IWorkerObject, FIWorkerObjectStub);
>   FStream := nil;
> end;

> destructor TWorkerThread.Destroy;
> begin
>   try
>     try
>       try
>         FIWorkerObjectStub := nil;
>       finally
>         MsgWaitFor;
>       end;
>     finally
>       FreeAndNil(FThreadEvent);
>     end;
>   finally
>     inherited Destroy;
>   end;
> end;

> procedure TWorkerThread.DoSomething;
> begin
>   Assert(Assigned(FIWorkerObjectStub));
>   FIWorkerObjectStub.DoSomething;
> end;

> procedure TWorkerThread.Execute;
> var
>   ThreadEvent: Boolean;
>   AIWorkerObject: IWorkerObject;
>   AIUnk: IUnknown;
>   Msg: TMsg;
> begin
>   ThreadEvent := False;
>   try
>     OleCheck(CoInitialize(nil));
>     try
> // It won't work 'cause the object is cretated in the main VCL thread
>       AIWorkerObject := CoWorkerObject.Create;
> // You will never be here 'cause the main VCL thread is waiting
> // in FThreadEvent.WaitFor(INFINITE);

> // But the following code line is working as desired and the object
> // is created in this thread instead of the main VCL thread
> //      AIWorkerObject := TWorkerObject.Create;
>       try
>         AIUnk := AIWorkerObject as IUnknown;
>         try
>           OleCheck(CoMarshalInterThreadInterfaceInStream(IWorkerObject,
>             AIUnk, IStream(FStream)));
>         finally
>           AIUnk := nil;
>         end;
>         FThreadEvent.SetEvent;
>         ThreadEvent := True;
>         while not Terminated do
>         begin
>           Sleep(50);
>           while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
>             DispatchMessage(Msg);
>         end;
>       finally
>         AIWorkerObject := nil;
>       end;
>     finally
>       CoUninitialize;
>     end;
>   except
>     if not ThreadEvent then
>       FThreadEvent.SetEvent;
>   end;
> end;

> procedure TWorkerThread.MsgWaitFor;
> var
>   Msg: TMsg;
>   H: THandle;
> begin
>   Terminate;
>   H := Handle;
>   while MsgWaitForMultipleObjects(1, H, False, 1000, QS_ALLINPUT) <>
> WAIT_OBJECT_0 do
>   begin
>     while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
>     begin
>       TranslateMessage(Msg);
>       DispatchMessage(Msg);
>     end;
>   end;
> end;

> end.

> Project1_tlb.pas
> ----------------
> unit Project1_TLB;

> //

************************************************************************
Quote
> //
> // WARNING
> // -------
> // The types declared in this file were generated from data read from a
> // Type Library. If this type library is explicitly or indirectly (via
> // another type library referring to this type library) re-imported, or
the
> // 'Refresh' command of the Type Library Editor activated while editing
the
> // Type Library, the contents of this file will be regenerated and all
> // manual modifications will be lost.
> //

************************************************************************
Quote
> //

> // PASTLWTR : $Revision:   1.88.1.0.1.0  $
> // File generated on 19.10.00 21:22:03 from Type Library described below.

> //

************************************************************************
Quote
> //
> // Type Lib: C:\Program
> Files\Borland\Delphi5\Projects\BUGGYAUTO\Project1.tlb (1)
> // IID\LCID: {DC383C2D-3756-47E1-B338-3C31684ED315}\0
> // Helpfile:
> // DepndLst:
> //   (1) v2.0 stdole, (C:\WINDOWS\SYSTEM\StdOle2.tlb)
> //   (2) v4.0 StdVCL, (C:\WINDOWS\SYSTEM\STDVCL40.DLL)
> //

************************************************************************

- Show quoted text -

Quote
> //
> {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked
pointers.
> interface

> uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;

> // *********************************************************************//
> // GUIDS declared in the TypeLibrary. Following prefixes are used:
> //   Type Libraries     : LIBID_xxxx
> //   CoClasses          : CLASS_xxxx
> //   DISPInterfaces     : DIID_xxxx
> //   Non-DISP interfaces: IID_xxxx
> // *********************************************************************//
> const
>   // TypeLibrary Major and minor versions
>   Project1MajorVersion = 1;
>   Project1MinorVersion = 0;

>   LIBID_Project1: TGUID = '{DC383C2D-3756-47E1-B338-3C31684ED315}';

>   IID_IWorkerObject: TGUID = '{80C8E7F0-392B-4335-B163-C7F69EE0F265}';
>   CLASS_WorkerObject: TGUID = '{9729E293-A309-454A-8074-D4C1C91C5E3D}';
> type

> // *********************************************************************//
> // Forward declaration of types defined in TypeLibrary
> // *********************************************************************//
>   IWorkerObject = interface;
>   IWorkerObjectDisp = dispinterface;

> // *********************************************************************//
> // Declaration of CoClasses defined in Type Library
> // (NOTE: Here we map each CoClass to its Default Interface)
> // *********************************************************************//
>   WorkerObject = IWorkerObject;

> // *********************************************************************//
> // Interface: IWorkerObject
> // Flags:     (4416) Dual OleAutomation Dispatchable
> // GUID:      {80C8E7F0-392B-4335-B163-C7F69EE0F265}
> // *********************************************************************//
>   IWorkerObject = interface(IDispatch)
>     ['{80C8E7F0-392B-4335-B163-C7F69EE0F265}']
>     procedure DoSomething; safecall;
>   end;

> // *********************************************************************//
> // DispIntf:  IWorkerObjectDisp
> // Flags:     (4416) Dual OleAutomation Dispatchable
> // GUID:    

...

read more »

Re:a riddle about TAutoObject descendant, main VCL thread, and single apartment thread


ah...I didnt look at the initializtion of the thread properly...well I did
only glance over it! ;)

Quote
"Nick Robinson" <nick.robin...@internetroadster.com> wrote in message

news:8snkot$h7k6@bornews.borland.com...
Quote
> Without spending too much time looking at your lengthy code....

> Something := TWorkerObject.Create doesnt create the COM object using the
COM
> mechanism, so it will create fine anyway.  you should not be calling wait
> inside the Thread.Create neither, as that is still inside the main calling
> thread context.  The thread will not run until you have returned from the
> create...and hence the deadlock.  What are you marshaling for? Where do
you
> want the COM object to get instanced and then used? Are you creating on
main
> thread and then passing to the worker thread? if so, marshal in the
> thread.create and unmarshal in the execute once you have entered the
> apartment.

> I dont think that solves your problem, but offers a little guidance.

> Nick.
> instantiates the object without using COM.  Secondly,
> "Dmitri" <udmi...@newmail.ru> wrote in message news:39ef3313_1@dnews...
> > Hi, All!

> > Could somebody explain me the following riddle about
> > TAutoObject descendant implementing a COM interface
> > in a single apartment thread.
> > The following code line creates the COM object strictly
> > in the main VCL thread context, however the current
> > thread is not the main VCL thread
> >       AIWorkerObject := CoWorkerObject.Create;
> > whereas the following one
> >       AIWorkerObject := TWorkerObject.Create;
> > creates the object in the current thread context.

> > Why is it so?
> > The sample project is following.

> > Project1.dpr
> > --------------
> > program Project1;

> > uses
> >   Forms,
> >   Unit1 in 'Unit1.pas' {Form1},
> >   Project1_TLB in 'Project1_TLB.pas',
> >   Unit2 in 'Unit2.pas' {WorkerObject: CoClass},
> >   Unit3 in 'Unit3.pas';

> > {$R *.TLB}

> > {$R *.RES}

> > begin
> >   Application.Initialize;
> >   Application.CreateForm(TForm1, Form1);
> >   Application.Run;
> > end.

> > unit1.pas
> > ----------
> > unit Unit1;

> > interface

> > uses
> >   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
> Dialogs,
> >   Unit3, StdCtrls;

> > type
> >   TForm1 = class(TForm)
> >     Button1: TButton;
> >     procedure Button1Click(Sender: TObject);
> >     procedure FormCreate(Sender: TObject);
> >     procedure FormDestroy(Sender: TObject);
> >   private
> >     { Private declarations }
> >     FWorkerThread: TWorkerThread;
> >   public
> >     { Public declarations }
> >   end;

> > var
> >   Form1: TForm1;

> > implementation

> > {$R *.DFM}

> > procedure TForm1.FormCreate(Sender: TObject);
> > begin
> >   FWorkerThread := TWorkerThread.Create;
> > end;

> > procedure TForm1.FormDestroy(Sender: TObject);
> > begin
> >   FreeAndNil(FWorkerThread);
> > end;

> > procedure TForm1.Button1Click(Sender: TObject);
> > begin
> >   Assert(Assigned(FWorkerThread));
> >   FWorkerThread.DoSomething;
> > end;

> > end.

> > unit1.dfm
> > ----------
> > object Form1: TForm1
> >   Left = 168
> >   Top = 170
> >   Width = 261
> >   Height = 153
> >   Caption = 'Form1'
> >   Color = clBtnFace
> >   Font.Charset = DEFAULT_CHARSET
> >   Font.Color = clWindowText
> >   Font.Height = -13
> >   Font.Name = 'MS Sans Serif'
> >   Font.Style = []
> >   OldCreateOrder = False
> >   OnCreate = FormCreate
> >   OnDestroy = FormDestroy
> >   PixelsPerInch = 120
> >   TextHeight = 16
> >   object Button1: TButton
> >     Left = 64
> >     Top = 32
> >     Width = 121
> >     Height = 57
> >     Caption = 'DoSomething'
> >     TabOrder = 0
> >     OnClick = Button1Click
> >   end
> > end

> > unit2.pas
> > -----------
> > unit Unit2;

> > interface

> > uses
> >   Windows, ComObj, ActiveX, Project1_TLB, StdVcl;

> > type
> >   TWorkerObject = class(TAutoObject, IWorkerObject)
> >   protected
> >     { Protected declarations }
> >     procedure DoSomething; safecall;
> >   end;

> > implementation

> > uses ComServ;

> > procedure TWorkerObject.DoSomething;
> > begin
> >   MessageBeep($FFFFFFFF);
> > end;

> > initialization
> >   TAutoObjectFactory.Create(ComServer, TWorkerObject,
Class_WorkerObject,
> >     ciMultiInstance, tmApartment);
> > end.

> > unit3.pas
> > -----------
> > unit Unit3;

> > interface

> > uses
> >   Windows, SyncObjs, ComObj, ActiveX, SysUtils, Classes, Project1_TLB,
> > Unit2;

> > type
> >   TWorkerThread = class(TThread)
> >   private
> >     { Private declarations }
> >     FThreadEvent: TEvent;
> >     FStream: Pointer;
> >     FIWorkerObjectStub: IWorkerObject;
> >   protected
> >     procedure Execute; override;
> >   public
> >     constructor Create; reintroduce;
> >     procedure MsgWaitFor;
> >     destructor Destroy; override;
> >     procedure DoSomething;
> >   end;

> > implementation

> > { TWorkerThread }

> > constructor TWorkerThread.Create;
> > begin
> >   inherited Create(True);
> >   FreeOnTerminate := False;
> >   FThreadEvent := TEvent.Create(nil, True, False, '');
> >   Resume;
> >   if Suspended then Abort;
> >   FThreadEvent.WaitFor(INFINITE);
> >   CoGetInterfaceAndReleaseStream(IStream(FStream),
> >     IWorkerObject, FIWorkerObjectStub);
> >   FStream := nil;
> > end;

> > destructor TWorkerThread.Destroy;
> > begin
> >   try
> >     try
> >       try
> >         FIWorkerObjectStub := nil;
> >       finally
> >         MsgWaitFor;
> >       end;
> >     finally
> >       FreeAndNil(FThreadEvent);
> >     end;
> >   finally
> >     inherited Destroy;
> >   end;
> > end;

> > procedure TWorkerThread.DoSomething;
> > begin
> >   Assert(Assigned(FIWorkerObjectStub));
> >   FIWorkerObjectStub.DoSomething;
> > end;

> > procedure TWorkerThread.Execute;
> > var
> >   ThreadEvent: Boolean;
> >   AIWorkerObject: IWorkerObject;
> >   AIUnk: IUnknown;
> >   Msg: TMsg;
> > begin
> >   ThreadEvent := False;
> >   try
> >     OleCheck(CoInitialize(nil));
> >     try
> > // It won't work 'cause the object is cretated in the main VCL thread
> >       AIWorkerObject := CoWorkerObject.Create;
> > // You will never be here 'cause the main VCL thread is waiting
> > // in FThreadEvent.WaitFor(INFINITE);

> > // But the following code line is working as desired and the object
> > // is created in this thread instead of the main VCL thread
> > //      AIWorkerObject := TWorkerObject.Create;
> >       try
> >         AIUnk := AIWorkerObject as IUnknown;
> >         try
> >           OleCheck(CoMarshalInterThreadInterfaceInStream(IWorkerObject,
> >             AIUnk, IStream(FStream)));
> >         finally
> >           AIUnk := nil;
> >         end;
> >         FThreadEvent.SetEvent;
> >         ThreadEvent := True;
> >         while not Terminated do
> >         begin
> >           Sleep(50);
> >           while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
> >             DispatchMessage(Msg);
> >         end;
> >       finally
> >         AIWorkerObject := nil;
> >       end;
> >     finally
> >       CoUninitialize;
> >     end;
> >   except
> >     if not ThreadEvent then
> >       FThreadEvent.SetEvent;
> >   end;
> > end;

> > procedure TWorkerThread.MsgWaitFor;
> > var
> >   Msg: TMsg;
> >   H: THandle;
> > begin
> >   Terminate;
> >   H := Handle;
> >   while MsgWaitForMultipleObjects(1, H, False, 1000, QS_ALLINPUT) <>
> > WAIT_OBJECT_0 do
> >   begin
> >     while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
> >     begin
> >       TranslateMessage(Msg);
> >       DispatchMessage(Msg);
> >     end;
> >   end;
> > end;

> > end.

> > Project1_tlb.pas
> > ----------------
> > unit Project1_TLB;

> > //
> ************************************************************************
> > //
> > // WARNING
> > // -------
> > // The types declared in this file were generated from data read from a
> > // Type Library. If this type library is explicitly or indirectly (via
> > // another type library referring to this type library) re-imported, or
> the
> > // 'Refresh' command of the Type Library Editor activated while editing
> the
> > // Type Library, the contents of this file will be regenerated and all
> > // manual modifications will be lost.
> > //
> ************************************************************************
> > //

> > // PASTLWTR : $Revision:   1.88.1.0.1.0  $
> > // File generated on 19.10.00 21:22:03 from Type Library described
below.

> > //
> ************************************************************************
> > //
> > // Type Lib: C:\Program
> > Files\Borland\Delphi5\Projects\BUGGYAUTO\Project1.tlb (1)
> > // IID\LCID: {DC383C2D-3756-47E1-B338-3C31684ED315}\0
> > // Helpfile:
> > // DepndLst:
> > //   (1) v2.0 stdole, (C:\WINDOWS\SYSTEM\StdOle2.tlb)
> > //   (2) v4.0 StdVCL, (C:\WINDOWS\SYSTEM\STDVCL40.DLL)
> > //
> ************************************************************************
> > //
> > {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked
> pointers.
> > interface

> > uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;

> > //

*********************************************************************//
Quote
> > // GUIDS declared in the TypeLibrary. Following prefixes are used:
> > //   Type Libraries     : LIBID_xxxx
> > //   CoClasses          : CLASS_xxxx
> > //   DISPInterfaces     : DIID_xxxx
> > //   Non-DISP interfaces: IID_xxxx
> > //

*********************************************************************//
Quote
> > const
> >   // TypeLibrary Major and minor versions
> >   Project1MajorVersion = 1;
> >   Project1MinorVersion = 0;

> >   LIBID_Project1: TGUID = '{DC383C2D-3756-47E1-B338-3C31684ED315}';

> >   IID_IWorkerObject: TGUID = '{80C8E7F0-392B-4335-B163-C7F69EE0F265}';
> >   CLASS_WorkerObject: TGUID = '{9729E293-A309-454A-8074-D4C1C91C5E3D}';
> > type

> > //

*********************************************************************//

- Show quoted text -

Quote
> > // Forward

...

read more »

Re:a riddle about TAutoObject descendant, main VCL thread, and single apartment thread


Yes, the TWorkerObject, and all that code belongs entirely to the EXE
application without any DLLs. I wanted to create TAutoObject descendant
implementing IWorkerObject in a single apartment thread and unmarshal that
interface into the main VCL thread.
If I instantiate the COM object with TWorkerObject.Create than all work as I
desired,
so I can call the method of the interface stub inside the main VCL thread
context and COM machine will translate this call to the single apartment
thread which instantiated the COM object, it is OK and the interface is the
real COM interface, I believe because it's working.
(Remark - what a tangled thing is the interfaces with Delphi - you could
expect that interface is COM interface but it's only Delphi interface.)
But if I use CoWorkerObject.Create instead inside the single apartment
thread then the COM object is suddenly created in the context of main VCL
thread, the COM machine hangs in creating the object waiting for message
processing in the main VCL thread, which is blocked in Event.WaitFor call,
it is a wierd behaviour. It seems that instantiating COM objects from a
class factory does not work properly or I missed the lesson.

(the COM machine not just wants to execute the IClassFactory.CreateInstance
in the context of main VCL thread, but the COM object itself is created in
the context of the main VCL thread and further the COM machine wants to
translate all calls of the COM interface methods into the main VCL thread
context).

I especially spawned additional SA thread in which I expected the object
will be created but the COM machine pulls me back to the main VCL thread.

The real question is the following one. Why does the COM machine in case of
creating an COM object from a class factory want to create the COM object in
the main VCL thread context instead of the context of the current single
apartment thread spawned especially for that goal, what is the necessity for
that amaizing behaviour?
And what is the real difference between TWorkerObject.Create and
CoWorkerObject.Create in terms of COM programming. Both of them returns COM
interface, but the behaviour of them considerably differs.
So I guess I must not use COM API calls relying on the COM object
instantiating from a class factory in the described situation.

Quote
Binh Ly <b...@castle.net> wrote in message news:39efac87_1@dnews...
> This should work fine. The only thing I can think of this that
TWorkerObject
> is in the same DPR as your entire EXE project. In that case, the call to
> CoWorkerObject.Create will wait because it's class factory
> (IClassFactory.CreateInstance) will need to execute on the main thread to
be
> able to succesfully create CoWorkerObject - therefore, you cannot do a
> WaitFor on the main thread because you'll lock up the class factory. If
> TWorkerObject was implemented in a separate DLL COM server and
> ThreadingModel=Apartment (and above), this should work fine.

> have fun
> --
> Binh Ly
> http://www.techvanguards.com

> "Dmitri" <udmi...@newmail.ru> wrote in message news:39ef3313_1@dnews...
> > Hi, All!

> > Could somebody explain me the following riddle about
> > TAutoObject descendant implementing a COM interface
> > in a single apartment thread.
> > The following code line creates the COM object strictly
> > in the main VCL thread context, however the current
> > thread is not the main VCL thread
> >       AIWorkerObject := CoWorkerObject.Create;
> > whereas the following one
> >       AIWorkerObject := TWorkerObject.Create;
> > creates the object in the current thread context.

> > Why is it so?
> > The sample project is following.

> > Project1.dpr
> > --------------
> > program Project1;

> > uses
> >   Forms,
> >   Unit1 in 'Unit1.pas' {Form1},
> >   Project1_TLB in 'Project1_TLB.pas',
> >   Unit2 in 'Unit2.pas' {WorkerObject: CoClass},
> >   Unit3 in 'Unit3.pas';

> > {$R *.TLB}

> > {$R *.RES}

> > begin
> >   Application.Initialize;
> >   Application.CreateForm(TForm1, Form1);
> >   Application.Run;
> > end.

> > unit1.pas
> > ----------
> > unit Unit1;

> > interface

> > uses
> >   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
> Dialogs,
> >   Unit3, StdCtrls;

> > type
> >   TForm1 = class(TForm)
> >     Button1: TButton;
> >     procedure Button1Click(Sender: TObject);
> >     procedure FormCreate(Sender: TObject);
> >     procedure FormDestroy(Sender: TObject);
> >   private
> >     { Private declarations }
> >     FWorkerThread: TWorkerThread;
> >   public
> >     { Public declarations }
> >   end;

> > var
> >   Form1: TForm1;

> > implementation

> > {$R *.DFM}

> > procedure TForm1.FormCreate(Sender: TObject);
> > begin
> >   FWorkerThread := TWorkerThread.Create;
> > end;

> > procedure TForm1.FormDestroy(Sender: TObject);
> > begin
> >   FreeAndNil(FWorkerThread);
> > end;

> > procedure TForm1.Button1Click(Sender: TObject);
> > begin
> >   Assert(Assigned(FWorkerThread));
> >   FWorkerThread.DoSomething;
> > end;

> > end.

> > unit1.dfm
> > ----------
> > object Form1: TForm1
> >   Left = 168
> >   Top = 170
> >   Width = 261
> >   Height = 153
> >   Caption = 'Form1'
> >   Color = clBtnFace
> >   Font.Charset = DEFAULT_CHARSET
> >   Font.Color = clWindowText
> >   Font.Height = -13
> >   Font.Name = 'MS Sans Serif'
> >   Font.Style = []
> >   OldCreateOrder = False
> >   OnCreate = FormCreate
> >   OnDestroy = FormDestroy
> >   PixelsPerInch = 120
> >   TextHeight = 16
> >   object Button1: TButton
> >     Left = 64
> >     Top = 32
> >     Width = 121
> >     Height = 57
> >     Caption = 'DoSomething'
> >     TabOrder = 0
> >     OnClick = Button1Click
> >   end
> > end

> > unit2.pas
> > -----------
> > unit Unit2;

> > interface

> > uses
> >   Windows, ComObj, ActiveX, Project1_TLB, StdVcl;

> > type
> >   TWorkerObject = class(TAutoObject, IWorkerObject)
> >   protected
> >     { Protected declarations }
> >     procedure DoSomething; safecall;
> >   end;

> > implementation

> > uses ComServ;

> > procedure TWorkerObject.DoSomething;
> > begin
> >   MessageBeep($FFFFFFFF);
> > end;

> > initialization
> >   TAutoObjectFactory.Create(ComServer, TWorkerObject,
Class_WorkerObject,
> >     ciMultiInstance, tmApartment);
> > end.

> > unit3.pas
> > -----------
> > unit Unit3;

> > interface

> > uses
> >   Windows, SyncObjs, ComObj, ActiveX, SysUtils, Classes, Project1_TLB,
> > Unit2;

> > type
> >   TWorkerThread = class(TThread)
> >   private
> >     { Private declarations }
> >     FThreadEvent: TEvent;
> >     FStream: Pointer;
> >     FIWorkerObjectStub: IWorkerObject;
> >   protected
> >     procedure Execute; override;
> >   public
> >     constructor Create; reintroduce;
> >     procedure MsgWaitFor;
> >     destructor Destroy; override;
> >     procedure DoSomething;
> >   end;

> > implementation

> > { TWorkerThread }

> > constructor TWorkerThread.Create;
> > begin
> >   inherited Create(True);
> >   FreeOnTerminate := False;
> >   FThreadEvent := TEvent.Create(nil, True, False, '');
> >   Resume;
> >   if Suspended then Abort;
> >   FThreadEvent.WaitFor(INFINITE);
> >   CoGetInterfaceAndReleaseStream(IStream(FStream),
> >     IWorkerObject, FIWorkerObjectStub);
> >   FStream := nil;
> > end;

> > destructor TWorkerThread.Destroy;
> > begin
> >   try
> >     try
> >       try
> >         FIWorkerObjectStub := nil;
> >       finally
> >         MsgWaitFor;
> >       end;
> >     finally
> >       FreeAndNil(FThreadEvent);
> >     end;
> >   finally
> >     inherited Destroy;
> >   end;
> > end;

> > procedure TWorkerThread.DoSomething;
> > begin
> >   Assert(Assigned(FIWorkerObjectStub));
> >   FIWorkerObjectStub.DoSomething;
> > end;

> > procedure TWorkerThread.Execute;
> > var
> >   ThreadEvent: Boolean;
> >   AIWorkerObject: IWorkerObject;
> >   AIUnk: IUnknown;
> >   Msg: TMsg;
> > begin
> >   ThreadEvent := False;
> >   try
> >     OleCheck(CoInitialize(nil));
> >     try
> > // It won't work 'cause the object is cretated in the main VCL thread
> >       AIWorkerObject := CoWorkerObject.Create;
> > // You will never be here 'cause the main VCL thread is waiting
> > // in FThreadEvent.WaitFor(INFINITE);

> > // But the following code line is working as desired and the object
> > // is created in this thread instead of the main VCL thread
> > //      AIWorkerObject := TWorkerObject.Create;
> >       try
> >         AIUnk := AIWorkerObject as IUnknown;
> >         try
> >           OleCheck(CoMarshalInterThreadInterfaceInStream(IWorkerObject,
> >             AIUnk, IStream(FStream)));
> >         finally
> >           AIUnk := nil;
> >         end;
> >         FThreadEvent.SetEvent;
> >         ThreadEvent := True;
> >         while not Terminated do
> >         begin
> >           Sleep(50);
> >           while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
> >             DispatchMessage(Msg);
> >         end;
> >       finally
> >         AIWorkerObject := nil;
> >       end;
> >     finally
> >       CoUninitialize;
> >     end;
> >   except
> >     if not ThreadEvent then
> >       FThreadEvent.SetEvent;
> >   end;
> > end;

> > procedure TWorkerThread.MsgWaitFor;
> > var
> >   Msg: TMsg;
> >   H: THandle;
> > begin
> >   Terminate;
> >   H := Handle;
> >   while MsgWaitForMultipleObjects(1, H, False, 1000, QS_ALLINPUT) <>
> > WAIT_OBJECT_0 do
> >   begin
> >     while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
> >     begin
> >       TranslateMessage(Msg);
> >       DispatchMessage(Msg);
> >     end;
> >   end;
> > end;

> > end.

> > Project1_tlb.pas
> > ----------------
> > unit Project1_TLB;

> > //
> ************************************************************************
> > //
> > // WARNING
> > // -------
> > // The types declared in this file were generated from data read from a
> > // Type Library. If this type library is explicitly or indirectly (via
> > // another type library referring to this

...

read more »

Re:a riddle about TAutoObject descendant, main VCL thread, and single apartment thread


Quote
"Dmitri" <udmi...@newmail.ru> wrote in message news:39f074c3_1@dnews...
> If I instantiate the COM object with TWorkerObject.Create than all work as
I
> desired,
> so I can call the method of the interface stub inside the main VCL thread
> context and COM machine will translate this call to the single apartment
> thread which instantiated the COM object, it is OK and the interface is
the
> real COM interface, I believe because it's working.

Nope, this does not work the way you expect. When you say TFoo.Create, there
is no COM involved and there is no thread-to-thread marshaling involved. It
simply works as if you were accessing a native Delphi TFoo object.

Quote
> (Remark - what a tangled thing is the interfaces with Delphi - you could
> expect that interface is COM interface but it's only Delphi interface.)
> But if I use CoWorkerObject.Create instead inside the single apartment
> thread then the COM object is suddenly created in the context of main VCL
> thread, the COM machine hangs in creating the object waiting for message
> processing in the main VCL thread, which is blocked in Event.WaitFor call,
> it is a wierd behaviour. It seems that instantiating COM objects from a
> class factory does not work properly or I missed the lesson.

Actually, this behaviour is correct. For Delphi EXE COM servers, all COM
components are serviced on 1 single thread by default. If you want a COM
component to be serviced on separate threads, you can use free threading
(CoInitFlags := COINIT_MULTI) or apartment threading (register and implement
your own class factories).

Quote
> (the COM machine not just wants to execute the

IClassFactory.CreateInstance

Quote
> in the context of main VCL thread, but the COM object itself is created in
> the context of the main VCL thread and further the COM machine wants to
> translate all calls of the COM interface methods into the main VCL thread
> context).

Yes this is the default behaviour for Delphi EXE COM components.

have fun
--
Binh Ly
http://www.techvanguards.com

Re:a riddle about TAutoObject descendant, main VCL thread, and single apartment thread


Quote
Binh Ly <b...@castle.net> wrote in message news:39f375f2_2@dnews...
> "Dmitri" <udmi...@newmail.ru> wrote in message news:39f074c3_1@dnews...
> > If I instantiate the COM object with TWorkerObject.Create than all work
as
> I
> > desired,
> > so I can call the method of the interface stub inside the main VCL
thread
> > context and COM machine will translate this call to the single apartment
> > thread which instantiated the COM object, it is OK and the interface is
> the
> > real COM interface, I believe because it's working.

> Nope, this does not work the way you expect. When you say TFoo.Create,
there
> is no COM involved and there is no thread-to-thread marshaling involved.
It
> simply works as if you were accessing a native Delphi TFoo object.

Yes it's really involves COM machine because there is marshaling between
threads. I check my example again and it really jump between threads on
calling the stub of COM interface, and if that were not a COM interface I
think that following code

       AIWorkerObject := TWorkerObject.Create;
        AIUnk := AIWorkerObject as IUnknown;
        try
          OleCheck(CoMarshalInterThreadInterfaceInStream(IWorkerObject,
            AIUnk, IStream(FStream)));
        finally
          AIUnk := nil;
        end;

would produce OleException,

and

procedure TForm1.Button1Click(Sender: TObject);
begin
  Assert(Assigned(FWorkerThread));
  FWorkerThread.DoSomething;
end;

would not leap from main VCL thread to

procedure TWorkerObject.DoSomething;
begin
  MessageBeep($FFFFFFFF);
end;

second spawned thread.

Re:a riddle about TAutoObject descendant, main VCL thread, and single apartment thread


Quote
Dmitri <udmi...@newmail.ru> wrote in message news:39f4701c$1_2@dnews...

> Binh Ly <b...@castle.net> wrote in message news:39f375f2_2@dnews...
> > "Dmitri" <udmi...@newmail.ru> wrote in message news:39f074c3_1@dnews...
> > > If I instantiate the COM object with TWorkerObject.Create than all
work
> as
> > I
> > > desired,
> > > so I can call the method of the interface stub inside the main VCL
> thread
> > > context and COM machine will translate this call to the single
apartment
> > > thread which instantiated the COM object, it is OK and the interface
is
> > the
> > > real COM interface, I believe because it's working.

> > Nope, this does not work the way you expect. When you say TFoo.Create,
> there
> > is no COM involved and there is no thread-to-thread marshaling involved.
> It
> > simply works as if you were accessing a native Delphi TFoo object.

> Yes it's really involves COM machine because there is marshaling between
> threads. I check my example again and it really jump between threads on
> calling the stub of COM interface, and if that were not a COM interface I
> think that following code

>        AIWorkerObject := TWorkerObject.Create;
>         AIUnk := AIWorkerObject as IUnknown;
>         try
>           OleCheck(CoMarshalInterThreadInterfaceInStream(IWorkerObject,
>             AIUnk, IStream(FStream)));
>         finally
>           AIUnk := nil;
>         end;

> would produce OleException,

> and

> procedure TForm1.Button1Click(Sender: TObject);
> begin
>   Assert(Assigned(FWorkerThread));
>   FWorkerThread.DoSomething;
> end;

procedure TWorkerThread.DoSomething;
begin
  Assert(Assigned(FIWorkerObjectStub));
  FIWorkerObjectStub.DoSomething;
end;

- Show quoted text -

Quote
> would not leap from main VCL thread to

> procedure TWorkerObject.DoSomething;
> begin
>   MessageBeep($FFFFFFFF);
> end;

> second spawned thread.

Re:a riddle about TAutoObject descendant, main VCL thread, and single apartment thread


Actually, you are correct. I didn't look at your code throughly. You are
marshaling from your thread back into the main thread (and you have a valid
STA message loop in your thread). Essentially, by saying TFoo.Create, what
you're doing is you acted as if you were the class factory for CoFoo
executing in the secondary thread - there should be no problems with this
approach.

Again, the reason CoFoo.Create fails is because the class factory for Foo
(as well as Foo) needs to run on the main thread. This is default behavior
for standard EXE COM server components.

have fun
--
Binh Ly
http://www.techvanguards.com

Quote
"Dmitri" <udmi...@newmail.ru> wrote in message news:39f4701c$1_2@dnews...
> Yes it's really involves COM machine because there is marshaling between
> threads. I check my example again and it really jump between threads on
> calling the stub of COM interface, and if that were not a COM interface I
> think that following code

>        AIWorkerObject := TWorkerObject.Create;
>         AIUnk := AIWorkerObject as IUnknown;
>         try
>           OleCheck(CoMarshalInterThreadInterfaceInStream(IWorkerObject,
>             AIUnk, IStream(FStream)));
>         finally
>           AIUnk := nil;
>         end;

> would produce OleException,

Re:a riddle about TAutoObject descendant, main VCL thread, and single apartment thread


That's why I said that the default Delphi COM class factory behaviour is
weird
and could lead to many problem for COM newbies without knowing its exact
behaviour, what is documented very bad in Delphi help, I think. Moreover the
behaviour of TComponentFactory and all other like TAutoObjectFactory differs
from each other on using tmApartment flag in its constructors. I think that
they should be brought to common behavoiur maybe through some additional
constant like SpawnApartmentThreads for COM class factories being
initialized with tmApartment flag.

Quote
Binh Ly <b...@castle.net> wrote in message news:39f50240_2@dnews...
> Actually, you are correct. I didn't look at your code throughly. You are
> marshaling from your thread back into the main thread (and you have a
valid
> STA message loop in your thread). Essentially, by saying TFoo.Create, what
> you're doing is you acted as if you were the class factory for CoFoo
> executing in the secondary thread - there should be no problems with this
> approach.

> Again, the reason CoFoo.Create fails is because the class factory for Foo
> (as well as Foo) needs to run on the main thread. This is default behavior
> for standard EXE COM server components.

> have fun
> --
> Binh Ly
> http://www.techvanguards.com

> "Dmitri" <udmi...@newmail.ru> wrote in message news:39f4701c$1_2@dnews...
> > Yes it's really involves COM machine because there is marshaling between
> > threads. I check my example again and it really jump between threads on
> > calling the stub of COM interface, and if that were not a COM interface
I
> > think that following code

> >        AIWorkerObject := TWorkerObject.Create;
> >         AIUnk := AIWorkerObject as IUnknown;
> >         try
> >           OleCheck(CoMarshalInterThreadInterfaceInStream(IWorkerObject,
> >             AIUnk, IStream(FStream)));
> >         finally
> >           AIUnk := nil;
> >         end;

> > would produce OleException,

Other Threads