Calling COM Object inside TThread

Question

In order to test the performance of the application, receiving many requests at the same time, I created an application that, inside threads, opens a connection using the TDCOMConnection creates a TClientDataSet, associates ProviderName and Inserts, Updates and Deletes records at the same time. But when i try access the server, I am getting the following error:

The application called an interface that was marshalled for a different thread.

What would that be?
Could you help me to solve this problem?

Edit

Unit1.pas:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtSvrConnect, ExtDBClient, SyncObjs, ActiveX;

type
  //0 - Executing
  //1 - Done
  //TMsg Adress
  PArray = ^TArray;
  TArray = Array of Integer;

  TCS = class(TMultiReadExclusiveWriteSynchronizer);

  TMsg = class
  public
    Done: Boolean;
    Strings: array of String;
  end;

  TWorker = class(TThread)
  private
    FOpt,
    FQuantity,
    FIndex: Integer;
    FRef: PArray;

    FCon: TExtSocketConnection;
    FCds: TExtClientDataSet;
    FMsg: TMsg;
  protected
    procedure OpenCds;
    procedure CreateObjs;
    procedure DestroyObjs;
    procedure Execute; override;
  public
    constructor Create(Opt, Quantity, I: Integer; Pt: PArray);
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    edQuantity: TEdit;
    Memo1: TMemo;
    edClients: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Button2: TButton;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    Workers : Array of TWorker;
    Signals : TArray;

    Size, Loop,
    Opt, CountDone: Integer;
  protected
    procedure InitializeThreads;
    procedure Reset;
    procedure Initialize;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Cs: TCS;  

implementation

uses DB;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Reset;
  Initialize;
  Button2Click(Sender);
end;

procedure TForm1.InitializeThreads;
var I: Integer;
begin
  for I:= 0 to Length(Signals)-1 do
    Signals[I] := 0;

  for I:= 0 to Length(Workers)-1 do
    Workers[I] := TWorker.Create(Opt, Loop, I, @Signals);

  for I:= 0 to Length(Workers)-1 do
    Workers[I].Resume;
end;

procedure TForm1.Initialize;
begin
  try
     Size := StrToInt(edClients.Text);
     if Size <= 0 then
       raise Exception.Create('Value must be > 0');
  except
    //on EConvertError do
    ShowMessage('Invalid Number!');
    edClients.SetFocus;
  end;

  if Size > 0 then
  begin
    try
       Loop := StrToInt(edQuantity.Text);
       if Loop <= 0 then
         raise Exception.Create('Value must be > 0');
    except
      //on EConvertError do
      ShowMessage('Invalid Number!');
      edQuantity.SetFocus;
    end;

    if Loop > 0 then
    begin
      while (Opt < 1) or (Opt > 4) do
        try
          Opt := StrToInt(InputBox('Choose.','Choose', '4'));
        except
          Opt := 0;
          ShowMessage('Invalid Number!');
        end;

      SetLength(Workers, Size);
      SetLength(Signals, Size);
      InitializeThreads;
      Label11.Caption := IntToStr(Size);
    end;
  end;

  Button1.Enabled := (Size <= 0) or
                     (Loop <= 0);
end;

procedure TForm1.Reset;
begin
  Label11.Caption := '0'; //created
  Label12.Caption := '0'; //finalized
  Label8.Caption  := 'Threads terminated: 0';
  Size := 0;
  Loop := 0;
  Opt  := 0;
  CountDone:= 0;
  Memo1.Lines.Clear;
  Button1.Enabled := False;
end;

{ TWorker }

constructor TWorker.Create(Opt, Quantity, I: Integer; Pt: PArray);
begin
  inherited Create(True);
  FOpt   := Opt;
  FQuantity := Quantity;
  FIndex := I;
  FRef   := Pt;
  FreeOnTerminate := True;
end;

procedure TWorker.CreateObjs;
begin
  FMsg := TMsg.Create;

  FCon := TExtSocketConnection.Create(nil);
  FCon.Address := '127.0.0.1';
  FCon.ConnectionName := 'ServerConn';
  FCon.ComputerName := '127.0.0.1';
  FCon.LoginPrompt := False;
  FCon.ServerGUID := '{5CC58302-83A4-11D2-B28F-00E046600CDA}';
  FCon.ServerName := 'ServerConn.ServerConnDat';

  FCds := TExtClientDataSet.Create(nil);
  FCds.FieldDefs.Add('Code', ftInteger, 0, True);
  FCds.FieldDefs.Add('Code2', ftInteger, 0, True);
  FCds.FieldDefs.Add('Year', ftInteger, 0, True);
  FCds.FieldDefs.Add('Month', ftInteger, 0, True);
  FCds.FieldDefs.Add('Amount', ftInteger, 0, True);

  FCds.Params.CreateParam(ftInteger, 'Code', ptInput);
  FCds.Params.CreateParam(ftInteger, 'Code2', ptInput);

  FCds.RemoteServer := FCon;
  FCds.ProviderName := 'prvYearMonth';

  FCds.CreateDataSet;
end;

procedure TWorker.DestroyObjs;
begin
  FCon.AppServer.Logout;
  FCds.Free;
  FCon.Free;
  if Length(FMsg.Strings) = 0 then
    FMsg.Free;
end;

procedure TWorker.Execute;
var I: Integer;
    Y,M: Integer;
    Entered: Boolean;
begin
  inherited;
  CoInitialize(nil);
  CreateObjs;
  Y := 2013;
  M := 12;
  try
    OpenCds;
    for I:= 0 To FQuantity-1 do
    begin
      try
        //Insert
        FCds.Append;
        FCds.FieldByName('Code').AsInteger := 0;
        FCds.FieldByName('Code2').AsInteger := 1;
        FCds.FieldByName('Year').AsInteger := Y;
        FCds.FieldByName('Month').AsInteger := M;
        FCds.FieldByName('Amount').AsInteger := 99;
        FCds.Post;
        FCds.ApplyUpdates(0);

        //Update
        if FOpt > 2 then
        begin
          FCds.Last;
          FCds.Edit;
          FCds.FieldByName('Amount').AsInteger := 88;
          FCds.Post;
          FCds.ApplyUpdates(0);
        end;

        //delete
        if (FOpt mod 2) = 0 then
        begin
          FCds.Last;
          FCds.Delete;
          FCds.ApplyUpdates(0);
        end;

      except
        SetLength(FMsg.Strings, Length(FMsg.Strings)+1);
        FMsg.Strings[Length(FMsg.Strings)-1] := 'Turn: '+IntToStr(I)+'. Msg: '+Exception(ExceptObject).Message;
      end;

      Inc(M);
      if M = 13 then
      begin
        M := 1;
        Inc(Y);
      end;
    end;
    if Length(FMsg.Strings) > 0 then
    begin
      repeat Entered := Cs.BeginWrite;
       until Entered; //Hint: Is this necessary??

      try
        FMsg.Done := True;
        FRef^[FIndex] := Integer(FMsg);
      finally Cs.EndWrite; end;
    end
    else
    begin
      repeat Entered := Cs.BeginWrite;
      until Entered;

      try
        FRef^[FIndex] := 1;
      finally Cs.EndWrite; end;
    end;
  finally
    DestroyObjs;
    CoUninitialize;
  end;
end;

procedure TWorker.OpenCds;
begin
  FCds.FetchParams;
  FCds.RemoteServer.AppServer.Login();
  FCds.Params.ParamByName('Code').AsInteger := 0;
  FCds.Params.ParamByName('Code2').AsInteger := 1;
  FCds.DataRequestAndOpen; //this will perform DataRequest and Open.
end;

procedure TForm1.Button2Click(Sender: TObject);
var I, J: Integer;
    P: TMsg;
    IsDone: Boolean;
    Signal: Integer;
begin
  for I:= 0 to Length(Signals)-1 do
  begin
    Cs.BeginRead;

    try
      Signal := Signals[I];
    finally Cs.EndRead; end;

    if Signal > 0 then
      if Signal = 1 then
      begin
        Memo1.Lines.Add('Thread: '+IntToStr(I)+' Finished!');
        Inc(CountDone);
      end
      else
      begin
        P:= TMsg(Signal);

        Cs.BeginRead;
        try
          IsDone := P.Done;
        finally Cs.EndRead; end;

        if IsDone then
        begin
          for J := 0 to Length(P.Strings)-1 do
            Memo1.Lines.Add('Thread: '+IntToStr(I)+' Threw an exception: '+ P.Strings[J]);
          Inc(CountDone);
          P.Free;
        end;
      end;
  end;
  if CountDone = Size then
  begin
    Label8.Caption := 'Finished';
    Button1.Enabled := True;
  end
  else
    Label8.Caption := 'Threads running :'+IntToStr(Size-CountDone);
  Label12.Caption := IntToStr(CountDone);
end;

initialization
  Cs := TCS.Create;

finalization
  Cs.free;

end.

Unit1.dfm:

object Form1: TForm1
  Left = 622
  Top = 188
  Width = 374
  Height = 494
  Caption = 'Test Performance'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 1
    Top = 1
    Width = 31
    Height = 13
    Caption = 'Clients'
  end
  object Label2: TLabel
    Left = 125
    Top = 3
    Width = 39
    Height = 13
    Caption = 'Quantity'
  end
  object Label3: TLabel
    Left = 10
    Top = 120
    Width = 30
    Height = 13
    Caption = 'Result'
  end
  object Label4: TLabel
    Left = 3
    Top = 50
    Width = 38
    Height = 13
    Caption = '1- Insert'
  end
  object Label5: TLabel
    Left = 3
    Top = 65
    Width = 81
    Height = 13
    Caption = '2- Insert e Delete'
  end
  object Label6: TLabel
    Left = 3
    Top = 95
    Width = 110
    Height = 13
    Caption = '4- Insert Update Delete'
  end
  object Label7: TLabel
    Left = 3
    Top = 80
    Width = 79
    Height = 13
    Caption = '3- Insert Update '
  end
  object Label8: TLabel
    Left = 16
    Top = 437
    Width = 103
    Height = 13
    Caption = 'Threads terminated: 0'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clRed
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    ParentFont = False
  end
  object Label9: TLabel
    Left = 264
    Top = 56
    Width = 37
    Height = 13
    Caption = 'Created'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlue
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    ParentFont = False
  end
  object Label10: TLabel
    Left = 264
    Top = 72
    Width = 53
    Height = 13
    Caption = 'Terminated'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clGreen
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    ParentFont = False
  end
  object Label11: TLabel
    Left = 320
    Top = 56
    Width = 28
    Height = 13
    AutoSize = False
    Caption = '0'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlue
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    ParentFont = False
  end
  object Label12: TLabel
    Left = 320
    Top = 72
    Width = 28
    Height = 13
    AutoSize = False
    Caption = '0'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clGreen
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    ParentFont = False
  end
  object Button1: TButton
    Left = 270
    Top = 14
    Width = 75
    Height = 25
    Caption = 'Run'
    TabOrder = 0
    OnClick = Button1Click
  end
  object edQuantity: TEdit
    Left = 125
    Top = 17
    Width = 121
    Height = 21
    TabOrder = 1
    Text = '10'
  end
  object Memo1: TMemo
    Left = 10
    Top = 136
    Width = 337
    Height = 281
    ScrollBars = ssBoth
    TabOrder = 2
  end
  object edClients: TEdit
    Left = 1
    Top = 18
    Width = 121
    Height = 21
    TabOrder = 3
    Text = '400'
  end
  object Button2: TButton
    Left = 271
    Top = 104
    Width = 75
    Height = 25
    Caption = 'Check Now'
    TabOrder = 4
    OnClick = Button2Click
  end
end

Answer 1

An apartment-threaded ActiveX/COM object can only be used in the same thread that it is created in. If you need to use such an object in another thread, it has to be marshalled to that thread using either CoMarshalInterThreadInterfaceInStream() or IGlobalInterfaceTable so ActiveX/COM can create a special proxy that delegates method calls to the original thread. Since you are using component wrappers, neither option is possible for you. So your only option is to create the component instances inside the Execute() method of the thread that is going to be using them, and don't forget to have Execute() call CoInitialize/Ex() first, eg:

procedure TMyThread.Execute;
var
  Conn: TDCOMConnection;
  DS: TClientDataSet;
begin
  CoInitialize(nil);
  try
    Conn := TDCOMConnection.Create(nil);
    try
      DS := TClientDataSet.Create(nil);
      try
        ...
      finally
        DS.Free;
      end;
    finally
      Conn.Free;
    end;
  finally
    CoUninitialize;
  end;
end;