Question

为了测试应用程序的性能，同时接收多个请求，我创建了一个应用程序，在线程内部，使用TDCOMConnection打开连接创建TClientDataSet，关联{ {1}}和插入，更新和删除记录同时进行。但是当我尝试访问服务器时，我收到以下错误：

该应用程序调用了一个为a编组的接口不同的主题。

那会是什么？
你能帮我解决这个问题吗？

修改

Unit1.pas：

ProviderName

Unit1.dfm：

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.

Answer 1

单元线程的ActiveX / COM对象只能在创建它的同一个线程中使用。如果需要在另一个线程中使用这样的对象，则必须使用{{3}对该线程进行编组。 }}或CoMarshalInterThreadInterfaceInStream()因此ActiveX / COM可以创建一个特殊的代理，将方法调用委托给原始线程。由于您使用的是组件包装器，因此您无法使用任何选项。因此，您唯一的选择是在将要使用它们的线程的Execute()方法内创建组件实例，并且不要忘记先Execute()调用CoInitialize/Ex()，例如：

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;

在TThread中调用COM对象

修改

1 个答案: