Multithreading 在TThread内调用COM对象
为了测试应用程序的性能，同时接收多个请求，我创建了一个应用程序，该应用程序在线程内使用Multithreading 在TThread内调用COM对象,multithreading,delphi,dcom,delphi-6,Multithreading,Delphi,Dcom,Delphi 6,为了测试应用程序的性能，同时接收多个请求，我创建了一个应用程序，该应用程序在线程内使用TDCOMConnection打开连接，创建TClientDataSet，关联ProviderName，同时插入、更新和删除记录。 但当我尝试访问服务器时，出现以下错误： 该应用程序调用了一个为 不同的线程 那会是什么 你能帮我解决这个问题吗 编辑 单元1.pas： unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Cla
TDCOMConnectionTClientDataSetProviderName你能帮我解决这个问题吗 编辑 单元1.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.
单元线程ActiveX/COM对象只能在创建它的同一线程中使用。如果需要在另一个线程中使用这样的对象，则必须使用或将其封送到该线程，以便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;
单元线程ActiveX/COM对象只能在创建它的同一线程中使用。如果需要在另一个线程中使用这样的对象，则必须使用或将其封送到该线程，以便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;
错误消息似乎是自我解释的：您已从一个线程创建了连接，并试图从另一个线程调用其方法。欢迎提供任何建议和提示错误消息似乎是自我解释的：您已从一个线程创建了连接，并试图从另一个线程调用其方法。有任何建议吗提示也很有趣，我就是这么做的，你想我发布代码吗？你是在工作线程的
Execute（）Execute（）