1. 客户端连接服务器,连接成功的时候,在该客户端信息里面设置一个ReciveFlag,初始化为True(准备好);
2. 服务端发送数据,等待客户端返回信息,客户端反馈信息为“OK”,服务端发送数据后,把该客户端的ReciveFlag置为False。
3. 客户端接收到数据后,给服务端发送反馈信息告诉对方已经收到信息,在此发送“OK”给服务端。
4. 服务端收到“OK”后,把该客户端的ReciveFlag置为True,在给某一个客户端发送信息的时候要判断该客户端的ReciveFlag是否为True(即客户端有没有取走服务端发送的信息)。
5. 服务端设置超时信息,发送数据后如果在规定的时间内没有收到客户端反馈信息则进行重复发送,多次不成功后,断开和客户端的连接。规定时间为3秒钟,重发次数为3次。
当时我写了个实验程序,服务端和客户端发送和接收数据的时候都显示一下,当然了在线程中都是用Synchronize来同步显示的。经测试实验程序没有问题,后来我把应答机制加入了我现在正在开发的系统发现通讯没几次就死掉了(不再通讯了,因为服务端的ReciveFlag不能置为True).
当时我怀疑是我的系统其他地方有影响,后来逐步排除才发现我在做测试程序的时候把收发的数据都进行了显示,去掉显示实验程序也会死掉。于是我在服务器的接收线程中把显示去掉,在显示的地方加上了sleep(0),系统一切正常,我晕,这叫什么事啊。我开始怀疑是不是通讯太快了,就在客户端返回信息的时候加上了延时,还是不行。
大家快帮我分析一下问题到底在哪里,我都晕了一周了,我不愿意相信加上个sleep能解决问题
14 个解决方案
#1
我把代码贴出来大家帮我分析一下吧
server端接收线程
procedure TMainForm.IdTcpServerExecute(AThread: TIdPeerThread);
var
Client : TLoginUser;
Msg : String;
TempIp:string;
begin
if not AThread.Terminated and AThread.Connection.Connected() then
begin
//自客户端读取相应的数据
AThread.Connection.MaxLineLength:=2*65536;
Client:= TLoginUser(AThread.Data);
fCount:=fCount+1;
Msg:= AThread.Connection.ReadLn(ConstTerminateChar);
//fData:=AThread.Connection.Socket.Binding.PeerIP+'----link----'+Msg;
//AThread.Synchronize(DisplayRecData);
sleep(0);
if trim(Msg) = 'OK' then
begin
Client.ReceiveFlag:=true; //***就是在这里程序跑飞了,设置断点运行到这里就跑了
end;
end;
end;
server端发送线程:
function TCommunication.SendDataPackageToScaner(
ScanDataPackage: string): integer;
var
AThread : TIdPeerThread;
SendStream:TStringStream;
i:integer;
Client:TLoginUser; //Added by lhx 2006/06/22
begin
Result:=0;
try
SendStream:=TStringStream.Create(ScanDataPackage+ConstTerminateChar);
try
with IdTCPServerSSScaner.Threads.LockList do
begin
try
for i := 0 to Count - 1 do
begin
AThread := Items[i];
Client:=TLoginUser(AThread.Data);
//Added by lhx 2006/06/22
if Client.ReceiveFlag then
begin
try
AThread.Connection.WriteStream(SendStream);
Client.ReceiveFlag:=false; //Added by lhx 2006/06/22
except
AThread.Stop;
Result:=1;
end;
end;
end;
finally
IdTCPServerSSScaner.Threads.UnlockList;
end;
end;
finally
SendStream.Free();
end;
except
Result:=1;
end;
end;
客户端接收线程:
procedure TClientDataThread.Execute;
var
DataSize:integer;
begin
//while
self.FreeOnTerminate:=True;
while (not Terminated) and fTCPClient.Connected do
begin
//sleep(100); //***在这里做个延时也不行***
s:=fTCPClient.ReadLn(ConstTerminateChar);
if trim(s)<>'' then
begin
fTCPClient.WriteLn('OK' + ConstTerminateChar);
synchAddDataToControl;
end;
end;
end;
server端接收线程
procedure TMainForm.IdTcpServerExecute(AThread: TIdPeerThread);
var
Client : TLoginUser;
Msg : String;
TempIp:string;
begin
if not AThread.Terminated and AThread.Connection.Connected() then
begin
//自客户端读取相应的数据
AThread.Connection.MaxLineLength:=2*65536;
Client:= TLoginUser(AThread.Data);
fCount:=fCount+1;
Msg:= AThread.Connection.ReadLn(ConstTerminateChar);
//fData:=AThread.Connection.Socket.Binding.PeerIP+'----link----'+Msg;
//AThread.Synchronize(DisplayRecData);
sleep(0);
if trim(Msg) = 'OK' then
begin
Client.ReceiveFlag:=true; //***就是在这里程序跑飞了,设置断点运行到这里就跑了
end;
end;
end;
server端发送线程:
function TCommunication.SendDataPackageToScaner(
ScanDataPackage: string): integer;
var
AThread : TIdPeerThread;
SendStream:TStringStream;
i:integer;
Client:TLoginUser; //Added by lhx 2006/06/22
begin
Result:=0;
try
SendStream:=TStringStream.Create(ScanDataPackage+ConstTerminateChar);
try
with IdTCPServerSSScaner.Threads.LockList do
begin
try
for i := 0 to Count - 1 do
begin
AThread := Items[i];
Client:=TLoginUser(AThread.Data);
//Added by lhx 2006/06/22
if Client.ReceiveFlag then
begin
try
AThread.Connection.WriteStream(SendStream);
Client.ReceiveFlag:=false; //Added by lhx 2006/06/22
except
AThread.Stop;
Result:=1;
end;
end;
end;
finally
IdTCPServerSSScaner.Threads.UnlockList;
end;
end;
finally
SendStream.Free();
end;
except
Result:=1;
end;
end;
客户端接收线程:
procedure TClientDataThread.Execute;
var
DataSize:integer;
begin
//while
self.FreeOnTerminate:=True;
while (not Terminated) and fTCPClient.Connected do
begin
//sleep(100); //***在这里做个延时也不行***
s:=fTCPClient.ReadLn(ConstTerminateChar);
if trim(s)<>'' then
begin
fTCPClient.WriteLn('OK' + ConstTerminateChar);
synchAddDataToControl;
end;
end;
end;
#2
在两端的Execute函数中都加入
try
except
end;
屏蔽异常
try
except
end;
屏蔽异常
#3
呵呵,我已经加了,不管用的,因为这个是测试程序,当时没有写。不过我觉得原因不在这里,后来加上试试看,还是不行的
#4
唉,我也用TIdTcpClient ,D7版本的,用多线程方法接收和发送,结果发着发着(大批量的时候)就假死了,为什么说假死呢,只要服务器那边主动给这边发个包,立马就活了(其实不应该不发包,因为我的缓冲里还有3MB多数据没发完),唉,我现在先换TTcpClient,估计和你的问题一样.
#5
看看这个帖子,可能有帮助哦
http://community.csdn.net/Expert/topic/4833/4833361.xml?temp=.786648
http://community.csdn.net/Expert/topic/4833/4833361.xml?temp=.786648
#6
To:zpointroc(横空逆云)
没有研究一下是哪里有问题吗?那个TTcpClient我以前用过,不好使,效率和稳定性还不如indy,有联系方式吗,可以讨论一下,交流一下
我的msn:xhsnow111@hotmail.com;QQ:47115458
没有研究一下是哪里有问题吗?那个TTcpClient我以前用过,不好使,效率和稳定性还不如indy,有联系方式吗,可以讨论一下,交流一下
我的msn:xhsnow111@hotmail.com;QQ:47115458
#7
看看indy的demo吧,不行重新写过
#8
呵呵,那个demo没有应答的,太简单了,对数据的大量处理还是由问题的
#9
liuhaixiao的问题还是老原因,用一个线程给多个连接发数据.
给liuhaixiao参考一段代码,取自DELPHI6\SOURCE\VCL\sconnect.pas
procedure TTransportThread.Execute;
....
var
msg: TMsg;
Data: IDataBlock;
Event: THandle;
Context: Integer;
begin
CoInitialize(nil);
try
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
ReleaseSemaphore(FSemaphore, 1, nil);
try
FTransport.Connected := True;
try
Event := FTransport.GetWaitEvent;
while not Terminated and FTransport.Connected do
try
case MsgWaitForMultipleObjects(1, Event, False, INFINITE, QS_ALLINPUT) of
WAIT_OBJECT_0:
begin
//这里面处理数据的接收
end;
WAIT_OBJECT_0 + 1:
begin
while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
//这个消息从其它线程POST而来,这样就不会阻塞那个线程.
begin
if (msg.hwnd = 0) then
case msg.message of
THREAD_SENDSTREAM://这是个自定义消息
begin
Data := IDataBlock(msg.lParam);//取得消息里面数据块.
Data._Release;
Context := FTransport.Send(Data);//发送出去.
....
end;
THREAD_REPLACETRANSPORT:
begin
FTransport := ITransport(msg.lParam);
FTransport._Release;
end;
else
DispatchMessage(msg);//线程消息循环处理余下消息.
end
else
DispatchMessage(msg);
end;
end;
end;
except
SynchronizeException;
end;
finally
Data := nil;
FTransport.Connected := False;
end;
except
SynchronizeException;
end;
finally
FTransport := nil;
CoUninitialize();
end;
end;
//-----------------------------------------------------------
以上代码重在理解,不适应硬搬到INDY组件上用..
给liuhaixiao参考一段代码,取自DELPHI6\SOURCE\VCL\sconnect.pas
procedure TTransportThread.Execute;
....
var
msg: TMsg;
Data: IDataBlock;
Event: THandle;
Context: Integer;
begin
CoInitialize(nil);
try
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
ReleaseSemaphore(FSemaphore, 1, nil);
try
FTransport.Connected := True;
try
Event := FTransport.GetWaitEvent;
while not Terminated and FTransport.Connected do
try
case MsgWaitForMultipleObjects(1, Event, False, INFINITE, QS_ALLINPUT) of
WAIT_OBJECT_0:
begin
//这里面处理数据的接收
end;
WAIT_OBJECT_0 + 1:
begin
while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
//这个消息从其它线程POST而来,这样就不会阻塞那个线程.
begin
if (msg.hwnd = 0) then
case msg.message of
THREAD_SENDSTREAM://这是个自定义消息
begin
Data := IDataBlock(msg.lParam);//取得消息里面数据块.
Data._Release;
Context := FTransport.Send(Data);//发送出去.
....
end;
THREAD_REPLACETRANSPORT:
begin
FTransport := ITransport(msg.lParam);
FTransport._Release;
end;
else
DispatchMessage(msg);//线程消息循环处理余下消息.
end
else
DispatchMessage(msg);
end;
end;
end;
except
SynchronizeException;
end;
finally
Data := nil;
FTransport.Connected := False;
end;
except
SynchronizeException;
end;
finally
FTransport := nil;
CoUninitialize();
end;
end;
//-----------------------------------------------------------
以上代码重在理解,不适应硬搬到INDY组件上用..
#10
halfdream老兄,谢谢你,我看了你的贴子,我也觉得我的设计机制有问题,我是第一次使用indy做项目,呵呵这个项目一年了还潜在有问题,这几天重新整理一下底层通信,当时项目结束的时候我就觉得如果出问题还是sock,但是因为其他的项目把这个项目搁下了,因为稳定性还可以,三四个月不会出问题。后来据我了解,个别的用户还是存在偶尔出现当机情况,才决定重新整理一下。
不怕你笑话,我真是对底层通信不懂,充其量也是当时indy好用,加上看看demo和delphi帮助才写了这么个程序(还漏洞百出)。你能帮我大概的修改一下程序吗?针对我的程序给我具体的讲一下好吗?因为我现在没有时间钻研这个了,正在做一个短信监控的项目,但是这个问题不解决又不行。
唉,我发现女孩子的钻研能力是比较差,精力也不行,呵呵,明年一定转个方向,不能再做研发了,现在我负责公司软件部的工作,同时开着两个项目,我觉得自己知识面真是窄,b/s的,短信的,视频的,头都大了。呵呵,我做负责人主要是对这块的业务了解比较多,每个都懂一些,但是没有很精的,别笑话我噢。
有时间再帮我瞅瞅,谢谢:)
不怕你笑话,我真是对底层通信不懂,充其量也是当时indy好用,加上看看demo和delphi帮助才写了这么个程序(还漏洞百出)。你能帮我大概的修改一下程序吗?针对我的程序给我具体的讲一下好吗?因为我现在没有时间钻研这个了,正在做一个短信监控的项目,但是这个问题不解决又不行。
唉,我发现女孩子的钻研能力是比较差,精力也不行,呵呵,明年一定转个方向,不能再做研发了,现在我负责公司软件部的工作,同时开着两个项目,我觉得自己知识面真是窄,b/s的,短信的,视频的,头都大了。呵呵,我做负责人主要是对这块的业务了解比较多,每个都懂一些,但是没有很精的,别笑话我噢。
有时间再帮我瞅瞅,谢谢:)
#11
我翻看以前的代码,也是时常直冒汗..呵呵..现在我没以前那样开发压力,有些技术问题反而看得透些.
我上面贴出来的东西主要只是针对你发送时候被阻塞问题.
至于应答通讯会死掉...
先问一声, TLoginUser这个对象在哪儿创建的?
我上面贴出来的东西主要只是针对你发送时候被阻塞问题.
至于应答通讯会死掉...
先问一声, TLoginUser这个对象在哪儿创建的?
#12
TLoginUser是在连接的时候创建的,能告诉我msn或者qq吗,这样太慢了
#13
初步判断是发送和接收线程没有同步,导致用户对象被锁无法赋值,大家看看是不是这个原因呢发送函数改动如下: RemoteIPAddr:='127.0.0.1';
SendStream:=TStringStream.Create('Server1 Send' + ConstTerminateChar);
with fUserList.LockList do
try
for i := 0 to Count-1 do // iterate through client-list
begin
Client := TLoginUser(Items[i]); // get client-object
if Client.ReceiveFlag then
begin
CurrThread:=TIdPeerThread(Client.Thread);
CurrThread.Connection.WriteStream(SendStream);
Client.ReceiveFlag:=false;
end;
end;
finally
fUserList.UnlockList;
end;
接收改动如下:
if trim(s) = 'OK' then
begin
//sleep(0);
//Client.ReceiveFlag:=true;
with fUserList.LockList do
try
for i := 0 to Count-1 do // iterate through client-list
begin
CurrClient := Items[i]; // get client-object
//RecThread := RecClient.Thread; // get client-thread out of it
if CurrClient.IPAddr=AThread.Connection.Socket.Binding.PeerIP then
begin
CurrClient.ReceiveFlag:=true;
//RecThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), True); // send the stuff
end;
end;
finally
fUserList.UnlockList;
end;
SendStream:=TStringStream.Create('Server1 Send' + ConstTerminateChar);
with fUserList.LockList do
try
for i := 0 to Count-1 do // iterate through client-list
begin
Client := TLoginUser(Items[i]); // get client-object
if Client.ReceiveFlag then
begin
CurrThread:=TIdPeerThread(Client.Thread);
CurrThread.Connection.WriteStream(SendStream);
Client.ReceiveFlag:=false;
end;
end;
finally
fUserList.UnlockList;
end;
接收改动如下:
if trim(s) = 'OK' then
begin
//sleep(0);
//Client.ReceiveFlag:=true;
with fUserList.LockList do
try
for i := 0 to Count-1 do // iterate through client-list
begin
CurrClient := Items[i]; // get client-object
//RecThread := RecClient.Thread; // get client-thread out of it
if CurrClient.IPAddr=AThread.Connection.Socket.Binding.PeerIP then
begin
CurrClient.ReceiveFlag:=true;
//RecThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), True); // send the stuff
end;
end;
finally
fUserList.UnlockList;
end;
#14
问题已解决,多线程同步的问题
#1
我把代码贴出来大家帮我分析一下吧
server端接收线程
procedure TMainForm.IdTcpServerExecute(AThread: TIdPeerThread);
var
Client : TLoginUser;
Msg : String;
TempIp:string;
begin
if not AThread.Terminated and AThread.Connection.Connected() then
begin
//自客户端读取相应的数据
AThread.Connection.MaxLineLength:=2*65536;
Client:= TLoginUser(AThread.Data);
fCount:=fCount+1;
Msg:= AThread.Connection.ReadLn(ConstTerminateChar);
//fData:=AThread.Connection.Socket.Binding.PeerIP+'----link----'+Msg;
//AThread.Synchronize(DisplayRecData);
sleep(0);
if trim(Msg) = 'OK' then
begin
Client.ReceiveFlag:=true; //***就是在这里程序跑飞了,设置断点运行到这里就跑了
end;
end;
end;
server端发送线程:
function TCommunication.SendDataPackageToScaner(
ScanDataPackage: string): integer;
var
AThread : TIdPeerThread;
SendStream:TStringStream;
i:integer;
Client:TLoginUser; //Added by lhx 2006/06/22
begin
Result:=0;
try
SendStream:=TStringStream.Create(ScanDataPackage+ConstTerminateChar);
try
with IdTCPServerSSScaner.Threads.LockList do
begin
try
for i := 0 to Count - 1 do
begin
AThread := Items[i];
Client:=TLoginUser(AThread.Data);
//Added by lhx 2006/06/22
if Client.ReceiveFlag then
begin
try
AThread.Connection.WriteStream(SendStream);
Client.ReceiveFlag:=false; //Added by lhx 2006/06/22
except
AThread.Stop;
Result:=1;
end;
end;
end;
finally
IdTCPServerSSScaner.Threads.UnlockList;
end;
end;
finally
SendStream.Free();
end;
except
Result:=1;
end;
end;
客户端接收线程:
procedure TClientDataThread.Execute;
var
DataSize:integer;
begin
//while
self.FreeOnTerminate:=True;
while (not Terminated) and fTCPClient.Connected do
begin
//sleep(100); //***在这里做个延时也不行***
s:=fTCPClient.ReadLn(ConstTerminateChar);
if trim(s)<>'' then
begin
fTCPClient.WriteLn('OK' + ConstTerminateChar);
synchAddDataToControl;
end;
end;
end;
server端接收线程
procedure TMainForm.IdTcpServerExecute(AThread: TIdPeerThread);
var
Client : TLoginUser;
Msg : String;
TempIp:string;
begin
if not AThread.Terminated and AThread.Connection.Connected() then
begin
//自客户端读取相应的数据
AThread.Connection.MaxLineLength:=2*65536;
Client:= TLoginUser(AThread.Data);
fCount:=fCount+1;
Msg:= AThread.Connection.ReadLn(ConstTerminateChar);
//fData:=AThread.Connection.Socket.Binding.PeerIP+'----link----'+Msg;
//AThread.Synchronize(DisplayRecData);
sleep(0);
if trim(Msg) = 'OK' then
begin
Client.ReceiveFlag:=true; //***就是在这里程序跑飞了,设置断点运行到这里就跑了
end;
end;
end;
server端发送线程:
function TCommunication.SendDataPackageToScaner(
ScanDataPackage: string): integer;
var
AThread : TIdPeerThread;
SendStream:TStringStream;
i:integer;
Client:TLoginUser; //Added by lhx 2006/06/22
begin
Result:=0;
try
SendStream:=TStringStream.Create(ScanDataPackage+ConstTerminateChar);
try
with IdTCPServerSSScaner.Threads.LockList do
begin
try
for i := 0 to Count - 1 do
begin
AThread := Items[i];
Client:=TLoginUser(AThread.Data);
//Added by lhx 2006/06/22
if Client.ReceiveFlag then
begin
try
AThread.Connection.WriteStream(SendStream);
Client.ReceiveFlag:=false; //Added by lhx 2006/06/22
except
AThread.Stop;
Result:=1;
end;
end;
end;
finally
IdTCPServerSSScaner.Threads.UnlockList;
end;
end;
finally
SendStream.Free();
end;
except
Result:=1;
end;
end;
客户端接收线程:
procedure TClientDataThread.Execute;
var
DataSize:integer;
begin
//while
self.FreeOnTerminate:=True;
while (not Terminated) and fTCPClient.Connected do
begin
//sleep(100); //***在这里做个延时也不行***
s:=fTCPClient.ReadLn(ConstTerminateChar);
if trim(s)<>'' then
begin
fTCPClient.WriteLn('OK' + ConstTerminateChar);
synchAddDataToControl;
end;
end;
end;
#2
在两端的Execute函数中都加入
try
except
end;
屏蔽异常
try
except
end;
屏蔽异常
#3
呵呵,我已经加了,不管用的,因为这个是测试程序,当时没有写。不过我觉得原因不在这里,后来加上试试看,还是不行的
#4
唉,我也用TIdTcpClient ,D7版本的,用多线程方法接收和发送,结果发着发着(大批量的时候)就假死了,为什么说假死呢,只要服务器那边主动给这边发个包,立马就活了(其实不应该不发包,因为我的缓冲里还有3MB多数据没发完),唉,我现在先换TTcpClient,估计和你的问题一样.
#5
看看这个帖子,可能有帮助哦
http://community.csdn.net/Expert/topic/4833/4833361.xml?temp=.786648
http://community.csdn.net/Expert/topic/4833/4833361.xml?temp=.786648
#6
To:zpointroc(横空逆云)
没有研究一下是哪里有问题吗?那个TTcpClient我以前用过,不好使,效率和稳定性还不如indy,有联系方式吗,可以讨论一下,交流一下
我的msn:xhsnow111@hotmail.com;QQ:47115458
没有研究一下是哪里有问题吗?那个TTcpClient我以前用过,不好使,效率和稳定性还不如indy,有联系方式吗,可以讨论一下,交流一下
我的msn:xhsnow111@hotmail.com;QQ:47115458
#7
看看indy的demo吧,不行重新写过
#8
呵呵,那个demo没有应答的,太简单了,对数据的大量处理还是由问题的
#9
liuhaixiao的问题还是老原因,用一个线程给多个连接发数据.
给liuhaixiao参考一段代码,取自DELPHI6\SOURCE\VCL\sconnect.pas
procedure TTransportThread.Execute;
....
var
msg: TMsg;
Data: IDataBlock;
Event: THandle;
Context: Integer;
begin
CoInitialize(nil);
try
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
ReleaseSemaphore(FSemaphore, 1, nil);
try
FTransport.Connected := True;
try
Event := FTransport.GetWaitEvent;
while not Terminated and FTransport.Connected do
try
case MsgWaitForMultipleObjects(1, Event, False, INFINITE, QS_ALLINPUT) of
WAIT_OBJECT_0:
begin
//这里面处理数据的接收
end;
WAIT_OBJECT_0 + 1:
begin
while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
//这个消息从其它线程POST而来,这样就不会阻塞那个线程.
begin
if (msg.hwnd = 0) then
case msg.message of
THREAD_SENDSTREAM://这是个自定义消息
begin
Data := IDataBlock(msg.lParam);//取得消息里面数据块.
Data._Release;
Context := FTransport.Send(Data);//发送出去.
....
end;
THREAD_REPLACETRANSPORT:
begin
FTransport := ITransport(msg.lParam);
FTransport._Release;
end;
else
DispatchMessage(msg);//线程消息循环处理余下消息.
end
else
DispatchMessage(msg);
end;
end;
end;
except
SynchronizeException;
end;
finally
Data := nil;
FTransport.Connected := False;
end;
except
SynchronizeException;
end;
finally
FTransport := nil;
CoUninitialize();
end;
end;
//-----------------------------------------------------------
以上代码重在理解,不适应硬搬到INDY组件上用..
给liuhaixiao参考一段代码,取自DELPHI6\SOURCE\VCL\sconnect.pas
procedure TTransportThread.Execute;
....
var
msg: TMsg;
Data: IDataBlock;
Event: THandle;
Context: Integer;
begin
CoInitialize(nil);
try
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
ReleaseSemaphore(FSemaphore, 1, nil);
try
FTransport.Connected := True;
try
Event := FTransport.GetWaitEvent;
while not Terminated and FTransport.Connected do
try
case MsgWaitForMultipleObjects(1, Event, False, INFINITE, QS_ALLINPUT) of
WAIT_OBJECT_0:
begin
//这里面处理数据的接收
end;
WAIT_OBJECT_0 + 1:
begin
while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
//这个消息从其它线程POST而来,这样就不会阻塞那个线程.
begin
if (msg.hwnd = 0) then
case msg.message of
THREAD_SENDSTREAM://这是个自定义消息
begin
Data := IDataBlock(msg.lParam);//取得消息里面数据块.
Data._Release;
Context := FTransport.Send(Data);//发送出去.
....
end;
THREAD_REPLACETRANSPORT:
begin
FTransport := ITransport(msg.lParam);
FTransport._Release;
end;
else
DispatchMessage(msg);//线程消息循环处理余下消息.
end
else
DispatchMessage(msg);
end;
end;
end;
except
SynchronizeException;
end;
finally
Data := nil;
FTransport.Connected := False;
end;
except
SynchronizeException;
end;
finally
FTransport := nil;
CoUninitialize();
end;
end;
//-----------------------------------------------------------
以上代码重在理解,不适应硬搬到INDY组件上用..
#10
halfdream老兄,谢谢你,我看了你的贴子,我也觉得我的设计机制有问题,我是第一次使用indy做项目,呵呵这个项目一年了还潜在有问题,这几天重新整理一下底层通信,当时项目结束的时候我就觉得如果出问题还是sock,但是因为其他的项目把这个项目搁下了,因为稳定性还可以,三四个月不会出问题。后来据我了解,个别的用户还是存在偶尔出现当机情况,才决定重新整理一下。
不怕你笑话,我真是对底层通信不懂,充其量也是当时indy好用,加上看看demo和delphi帮助才写了这么个程序(还漏洞百出)。你能帮我大概的修改一下程序吗?针对我的程序给我具体的讲一下好吗?因为我现在没有时间钻研这个了,正在做一个短信监控的项目,但是这个问题不解决又不行。
唉,我发现女孩子的钻研能力是比较差,精力也不行,呵呵,明年一定转个方向,不能再做研发了,现在我负责公司软件部的工作,同时开着两个项目,我觉得自己知识面真是窄,b/s的,短信的,视频的,头都大了。呵呵,我做负责人主要是对这块的业务了解比较多,每个都懂一些,但是没有很精的,别笑话我噢。
有时间再帮我瞅瞅,谢谢:)
不怕你笑话,我真是对底层通信不懂,充其量也是当时indy好用,加上看看demo和delphi帮助才写了这么个程序(还漏洞百出)。你能帮我大概的修改一下程序吗?针对我的程序给我具体的讲一下好吗?因为我现在没有时间钻研这个了,正在做一个短信监控的项目,但是这个问题不解决又不行。
唉,我发现女孩子的钻研能力是比较差,精力也不行,呵呵,明年一定转个方向,不能再做研发了,现在我负责公司软件部的工作,同时开着两个项目,我觉得自己知识面真是窄,b/s的,短信的,视频的,头都大了。呵呵,我做负责人主要是对这块的业务了解比较多,每个都懂一些,但是没有很精的,别笑话我噢。
有时间再帮我瞅瞅,谢谢:)
#11
我翻看以前的代码,也是时常直冒汗..呵呵..现在我没以前那样开发压力,有些技术问题反而看得透些.
我上面贴出来的东西主要只是针对你发送时候被阻塞问题.
至于应答通讯会死掉...
先问一声, TLoginUser这个对象在哪儿创建的?
我上面贴出来的东西主要只是针对你发送时候被阻塞问题.
至于应答通讯会死掉...
先问一声, TLoginUser这个对象在哪儿创建的?
#12
TLoginUser是在连接的时候创建的,能告诉我msn或者qq吗,这样太慢了
#13
初步判断是发送和接收线程没有同步,导致用户对象被锁无法赋值,大家看看是不是这个原因呢发送函数改动如下: RemoteIPAddr:='127.0.0.1';
SendStream:=TStringStream.Create('Server1 Send' + ConstTerminateChar);
with fUserList.LockList do
try
for i := 0 to Count-1 do // iterate through client-list
begin
Client := TLoginUser(Items[i]); // get client-object
if Client.ReceiveFlag then
begin
CurrThread:=TIdPeerThread(Client.Thread);
CurrThread.Connection.WriteStream(SendStream);
Client.ReceiveFlag:=false;
end;
end;
finally
fUserList.UnlockList;
end;
接收改动如下:
if trim(s) = 'OK' then
begin
//sleep(0);
//Client.ReceiveFlag:=true;
with fUserList.LockList do
try
for i := 0 to Count-1 do // iterate through client-list
begin
CurrClient := Items[i]; // get client-object
//RecThread := RecClient.Thread; // get client-thread out of it
if CurrClient.IPAddr=AThread.Connection.Socket.Binding.PeerIP then
begin
CurrClient.ReceiveFlag:=true;
//RecThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), True); // send the stuff
end;
end;
finally
fUserList.UnlockList;
end;
SendStream:=TStringStream.Create('Server1 Send' + ConstTerminateChar);
with fUserList.LockList do
try
for i := 0 to Count-1 do // iterate through client-list
begin
Client := TLoginUser(Items[i]); // get client-object
if Client.ReceiveFlag then
begin
CurrThread:=TIdPeerThread(Client.Thread);
CurrThread.Connection.WriteStream(SendStream);
Client.ReceiveFlag:=false;
end;
end;
finally
fUserList.UnlockList;
end;
接收改动如下:
if trim(s) = 'OK' then
begin
//sleep(0);
//Client.ReceiveFlag:=true;
with fUserList.LockList do
try
for i := 0 to Count-1 do // iterate through client-list
begin
CurrClient := Items[i]; // get client-object
//RecThread := RecClient.Thread; // get client-thread out of it
if CurrClient.IPAddr=AThread.Connection.Socket.Binding.PeerIP then
begin
CurrClient.ReceiveFlag:=true;
//RecThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), True); // send the stuff
end;
end;
finally
fUserList.UnlockList;
end;
#14
问题已解决,多线程同步的问题