多线程访问COM对象的疑惑

[darnis]

我应用是这样的：

本地应用通过SOCKET接收来自网络的信息，阻塞方式，单独的线程处理接收工作，
当收到的数据报要求与COM对象交互时，由线程中的代码驱动另一模块的相关操作，
本来在用户界面上可以正常进行的功能，但经过该线程去驱动执行时，却不能正常
工作（部分功能正常）。本人基础知识薄弱，实在分析不透是什么原因，只是初步
判定是线程环境与 要操作的COM对象生成时的环境之间有问题。不知如何解决。

想到由于线程产生的问题，估计与同步相关。修改线程中的代码，在收到操作请求时，
并不直接操纵COM对象。采用 PostMessage 的方式，通知数据处理模块。我为数据处理
模块添加了消息循环处理（参照的 TTimer 的实现），这样问题得以解决。但是另一个
问题又出现了：
死锁！

在数据处理模块中的消息处理过程如下：
procedure TlbCmdTransact.WndProc(var aMsg: TMessage);
begin
if aMsg.Msg = WM_PACKET then
try
Prepared;
except
//Application.HandleException(Self);
end
else
aMsg.Result := DefWindowProc(FHandle, aMsg.Msg, aMsg.wParam, aMsg.lParam);
end;
//////////////
// 数据处理模块初始化时
FHandle := AllocateHWnd(wndproc);

大部分时间会发生死锁，疑惑中………………

[cdsun]

你说的死锁是死锁什么？

死锁界面？

那就是你线程用的不对

[darnis]

我不用 PostMessage 时功能基本都是正常的，
目前调试结果看到有一个功能不能正常，但是该功能通过界面操作是正常的。

在 PostMessage 给数据处理模块处理之后，基本都会发生死锁，但在没有死倘的情况
下，前面的问题得以解决。

[darnis]

线程内处理我实在看不出有什么问题。
我把线程的 Execute 代码贴出来：
procedure TlbReceiver.Execute;
var
da: IlbDataAnnouncer;
i, iRec, iPort: integer;
buf: PChar;
strFrom, strRec: string;
iErr: integer;
blRec, blRecBreak, blProcessing: boolean;
t1: cardinal;
fromHost: WideString;
fromPort: integer;
s: IlbStation;
iCount: integer;
begin
CoInitialize(nil);
GetMem(buf, CommBase.MaxBufferSize);
try
iErr := 0;
iCount := 0;
while not Terminated do
begin
blRec := false;
blRecBreak := false;
blProcessing := false;
if not Commbase.Active then
begin
sleep(1);
continue;
end;
if ManagePacket then
begin
/// 自动管理数据包的处理过程
t1 := GetTickCount;
CommProxy.Packet.EmptyInBuffer;
repeat
if GetTickCount - t1 > CommBase.GetTimeout then
break;
try
iRec := CommBase.ReceiveFrom(buf^, Commbase.MaxBufferSize,
fromHost, fromPort, 10);
iCount := 0;

except
on e: Exception do
begin
if Terminated or CommProxy.Freed then exit;
if (e is EIdConnClosedGracefully) and (iCount < 3) then
begin
inc(iCount);
CommProxy.__(Format('[ManagePacket] error(%s:%s] on receivebuffer in TlbReceiver.Execute',
[e.ClassName, e.Message]));
end else if not (e is EIdConnClosedGracefully) then
begin
CommProxy.__(Format('[ManagePacket] error(%s:%s] on receivebuffer in TlbReceiver.Execute',
[e.ClassName, e.Message]));
end;
blRecBreak := true;
end;
end;
if iRec > 0 then
begin
SetLength(strRec, iRec);
Move(buf^, strRec[1], iRec);
blRec := CommProxy.Packet.PushPacket(strRec);
blProcessing := true;
end
else if not blProcessing then
begin
break;
end;
until blRec;
if blRec then
try
strRec := CommProxy.Packet.InPacket;
iRec := Length(strRec);
except
on e: Exception do
begin
if Terminated then exit;
CommProxy.__(Format('%s: %s', [e.ClassName, e.Message]));
end;
end;
end
else
try
iRec := Commbase.ReceiveFrom(buf^, Commbase.MaxBufferSize, fromHost,
fromPort, 10);
blRec := iRec > 0;
if blRec then
begin
SetLength(strRec, irec);
Move(buf^, strRec[1], iRec);
end;
except
if Terminated then exit;
CommProxy.__('error on receivebuffer in TlbReceiver.Execute');
blRecBreak := true;
end;

if blRecBreak then
begin
/// 发生异常，
Sleep(1);
continue;
end;

if blRec then
begin
try
// 内部处理接收到的数据
CommBase.SetRemoteIP(fromHost);
CommBase.SetRemotePort(fromPort);
s := CommProxy.GetStationManager.q_IP_port(fromHost, fromPort);
if s = nil then
begin
s := CommProxy.GetStationManager.AddStation;
s.IP := fromHost;
s.Port := fromPort;
s.StationType := stOther;
s.StationName := Format('%s:%d', [fromHost, fromPort]);
end;
s.p2pAvalid := true;
s.Acttime := DateTimeToStr(now);
s.Commbase := Commbase;
////
//// 保证当前数据的处理过程中 Commbase 不会改变，
//// 要求所有对 CommProxy 的 Commbase 需要设定的地方
//// 为了保证传输的正确性，都应该用 InTrans 和 OutTrans 把
//// 处理过程包起来。
////
CommProxy.InTrans;
try
CommProxy.SetCommBase(s.Commbase);
/// 它会被 CmdTransact 处理，
CommProxy.ReceiveData(PChar(strRec), iRec);
finally commproxy.OutTrans; end;

strFrom := strFrom;
iPort := iPort;
for i := 0 to CommBase.Announcer.Count - 1 do
begin
if CommProxy.Announcer.Items[i].QueryInterface(IlbDataAnnouncer, da) = S_OK then
begin
da.OnReceive(PChar(buf), iRec, strFrom, iPort);
end;
end;
except
on e: exception do
begin
if Terminated then exit;
CommProxy.__(Format('[TlbReceiver.Execute]when handle the data ' +
'occur exception %s:%s' , [e.ClassName, e.Message]));
//if e is EidException then raise;
end;
end;
end;
end;
finally
FreeMem(buf);
CoUninitialize;
end;
end;

[darnis]

在线程中 CommProxy.ReceiveData(PChar(strRec), iRec)
它会驱动数据报处理模块，对收到的报文进行处理：

function TlbCmdTransact.Parse(AParams: PChar; ABufLen: integer): integer;
var
strTmp, str1: string;
oData: OleVariant;
rtTmp: TlbReqOPCTree;
ra: TlbResponseAsk;
iTmp: integer;
p: TlbParameterMana;
begin
SetLength(strtmp, aBufLen);
Move(aParams^, strTmp[1], aBufLen);
if DEBUG then
_(Format('P:[%s]',[strTmp]));
FMsg.XML := TlbDPAssistant.unpackData(DP, strTmp);
if FMsg.IsEmpty then
begin
/// 错误报告
///
_(Format('Packet Error:%s', [strTmp]));
Result := R_FAIL;
exit;
end;
///////
// 扩展类可以可以重载 MsgPrepared 对数据报内容进行修订，
// 加入这一功能的目的是为了解决转发数据包的地址转换问题。
MsgPrepared(Fmsg);
/// 这里如果POST message 给数据处理模块进行处理的话，经常发生死锁，
/// 如果不 Post 出去，而直接处理的话，就有个别功能不能正常。
// PostMessage(FHandle, WM_PACKET, 0, 0);
// (*
p := TlbParameterMana.Create;
try
///
/// 填充调用参数.
///
if Sender <> nil then
begin
p.Add('host', sender.Commbase.RemoteIP);
p.Add('port', sender.Commbase.RemotePort);
p.Add('sender', sender);
end;
result := FDispatcher[Byte(FMsg.PacketType)](Fmsg, p);
finally
p.Free;
end; // *)
end;

[Delphi1985]

用Synchronize可以解決的
Synchronize(你的線程函數)

[darnis]

用 Synchronize 的确可以解决问题，不过效率上有点问题。

我想问一下， 按 TTimer 那种 PostMessage 的方式为什么会发生死锁？

[halfdream]

楼主所说的'死锁'...是界面冻结吗?

你把任务都POST到主线程去处理..在主线程处理某个长时间操作过程中,当然要出现冻结现象.


另外,楼主问题其实是一个COM的基本使用常识:不要跨线程传递COM对象指针.
其实COM对象自身设计的多线程安全机制.
比较简单的做法是每个线程里面对COM对象现创建现用.

[darnis]

谢谢 halfdream(哈欠) 的指教，