使用indy的Tidtcpclient、Tidtcpserver的通信时的问题(50分)

我用了indy中idtcpdemo中的例子，然后对client中的增加了一个循环，
然后运行，但是client，没有接收到server发送回来的信息。
请问这是为什么？该如何解决？谢谢


整个client、sever都用indy的idtcpdemo，只是增加了一个循环
client代码如下：
unit ClientFrmMainUnit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, StdCtrls,
GlobalUnit, DB, ADODB;

type
TClientFrmMain = class(TForm)
CBClientActive: TCheckBox;
IncomingMessages: TMemo;
Label1: TLabel;
Client: TIdTCPClient;
Label2: TLabel;
EditCommand: TComboBox;
Label3: TLabel;
EditMessage: TEdit;
Label4: TLabel;
EditRecipient: TEdit;
ButtonSend: TButton;
ADOConnection1: TADOConnection;
adoq1: TADOQuery;

procedure CBClientActiveClick(Sender: TObject);
procedure ButtonSendClick(Sender: TObject);

private

public

end;

TClientHandleThread = class(TThread)
private
CB: TCommBlock;

procedure HandleInput;

protected
procedure Execute; override;

end;

var
ClientFrmMain: TClientFrmMain;
ClientHandleThread: TClientHandleThread; // variable (type see above)

implementation

{$R *.DFM}

procedure TClientHandleThread.HandleInput;
begin
if CB.Command = 'MESSAGE' then
ClientFrmMain.IncomingMessages.Lines.Add (CB.MyUserName + ': ' + CB.Msg)
else
if CB.Command = 'DIALOG' then
MessageDlg ('"'+CB.MyUserName+'" sends you this message:'+#13+CB.Msg, mtInformation, [mbOk], 0)
else // unknown command
MessageDlg('Unknown command "'+CB.Command+'" containing this message:'+#13+CB.Msg, mtError, [mbOk], 0);
end;

procedure TClientHandleThread.Execute;
begin
while not Terminated do
begin
if not ClientFrmMain.Client.Connected then
Terminate
else
try
ClientFrmMain.Client.ReadBuffer(CB, SizeOf (CB));
Synchronize(HandleInput);
except
end;
end;
end;

procedure TClientFrmMain.CBClientActiveClick(Sender: TObject);
begin
if CBClientActive.Checked then
begin
try
Client.Connect(10000); // in Indy < 8.1 leave the parameter away

ClientHandleThread := TClientHandleThread.Create(True);
ClientHandleThread.FreeOnTerminate:=True;
ClientHandleThread.Resume;
except
on E: Exception do MessageDlg ('Error while connecting:'+#13+E.Message, mtError, [mbOk], 0);
end;
end
else
begin
ClientHandleThread.Terminate;
Client.Disconnect;
end;

ButtonSend.Enabled := Client.Connected;
CBClientActive.Checked := Client.Connected;
end;

procedure TClientFrmMain.ButtonSendClick(Sender: TObject);
var
CommBlock : TCommBlock;
i:integer;
begin
{with ADOQ1 do
begin
close;
sql.clear;
sql.add('select top 20 * from clientdat where state=''false'' order by msg');
open;
for i:=0 to recordcount-1 do
begin
label1.Caption:= fieldbyname('commandtype').asstring;
commblock.id:='';
commblock.Command:='MESSAGE';
commblock.MyUserName:='11.37.35.78';
commblock.Msg:=fieldbyname('msg').asstring;
commblock.ReceiverName:='';
commblock.msgtype:='install pro';
Client.WriteBuffer (CommBlock, SizeOf (CommBlock), true);
// sendmsg(fieldbyname('commandtype').asstring,fieldbyname('ipaddress').asstring,fieldbyname('messagetype').asstring,fieldbyname('msg').asstring,fieldbyname('sendtime').asstring,'123456',0);
next;
end;}

for I:=0 to 200 do //我增加的代码
begin

commblock.Command:= EditCommand.Text; // assign the data
CommBlock.MyUserName := Client.LocalName;
CommBlock.Msg := EditMessage.Text;
CommBlock.ReceiverName := EditRecipient.Text;

Client.WriteBuffer (CommBlock, SizeOf (CommBlock), true);
end;
end;
//end;
end.


server的代码如下
unit ServerFrmMainUnit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, IdTCPServer, IdThreadMgr, IdThreadMgrDefault, IdBaseComponent,
IdComponent;

type
PClient = ^TClient;
TClient = record // Object holding data of client (see events)
DNS : String[20]; { Hostname }
Connected, { Time of connect }
LastAction : TDateTime; { Time of last transaction }
Thread : Pointer; { Pointer to thread }
end;

TServerFrmMain = class(TForm)
Server: TIdTCPServer;
CBServerActive: TCheckBox;
Protocol: TMemo;
IdThreadMgrDefault1: TIdThreadMgrDefault;

procedure CBServerActiveClick(Sender: TObject);
procedure ServerConnect(AThread: TIdPeerThread);
procedure ServerExecute(AThread: TIdPeerThread);
procedure ServerDisconnect(AThread: TIdPeerThread);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

public
end;

var
ServerFrmMain : TServerFrmMain;
Clients : TThreadList; // Holds the data of all clients

implementation

uses GlobalUnit;

{$R *.DFM}

procedure TServerFrmMain.CBServerActiveClick(Sender: TObject);
begin
Server.Active := CBServerActive.Checked;
end;

procedure TServerFrmMain.ServerConnect(AThread: TIdPeerThread);
var
NewClient: PClient;

begin
GetMem(NewClient, SizeOf(TClient));

NewClient.DNS := AThread.Connection.LocalName;
NewClient.Connected := Now;
NewClient.LastAction := NewClient.Connected;
NewClient.Thread :=AThread;

AThread.Data:=TObject(NewClient);

try
Clients.LockList.Add(NewClient);
finally
Clients.UnlockList;
end;

Protocol.Lines.Add(TimeToStr(Time)+' Connection from "'+NewClient.DNS+'"');
end;

procedure TServerFrmMain.ServerExecute(AThread: TIdPeerThread);
var
ActClient, RecClient: PClient;
CommBlock, NewCommBlock: TCommBlock;
RecThread: TIdPeerThread;
i: Integer;

begin
if not AThread.Terminated and AThread.Connection.Connected then
begin
AThread.Connection.ReadBuffer (CommBlock, SizeOf (CommBlock));
ActClient := PClient(AThread.Data);
ActClient.LastAction := Now; // update the time of last action

if (CommBlock.Command = 'MESSAGE') or (CommBlock.Command = 'DIALOG') then
begin // 'MESSAGE': A message was send - forward or broadcast it
// 'DIALOG': A dialog-window shall popup on the recipient's screen
// it's the same code for both commands...

if CommBlock.ReceiverName = '' then
begin // no recipient given - broadcast
Protocol.Lines.Add (TimeToStr(Time)+' Broadcasting '+CommBlock.Command+': "'+CommBlock.Msg+'"');
NewCommBlock := CommBlock; // nothing to change ;-))

with Clients.LockList do
try
for i := 0 to Count-1 do // iterate through client-list
begin
RecClient := Items; // get client-object
RecThread := RecClient.Thread; // get client-thread out of it
RecThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), True); // send the stuff
end;
finally
Clients.UnlockList;
end;
end
else
begin // receiver given - search him and send it to him
NewCommBlock := CommBlock; // again: nothing to change ;-))
Protocol.Lines.Add(TimeToStr(Time)+' Sending '+CommBlock.Command+' to "'+CommBlock.ReceiverName+'": "'+CommBlock.Msg+'"');
with Clients.LockList do
try
for i := 0 to Count-1 do
begin
RecClient:=Items;
if RecClient.DNS=CommBlock.ReceiverName then // we don't have a login function so we have to use the DNS (Hostname)
begin
RecThread:=RecClient.Thread;
RecThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), True);
end;
end;
finally
Clients.UnlockList;
end;
end;
end
else
begin // unknown command given
Protocol.Lines.Add (TimeToStr(Time)+' Unknown command from "'+CommBlock.MyUserName+'": '+CommBlock.Command);
NewCommBlock.Command := 'DIALOG'; // the message should popup on the client's screen
NewCommBlock.MyUserName := '[Server]'; // the server's username
NewCommBlock.Msg := 'I don''t understand your command: "'+CommBlock.Command+'"'; // the message to show
NewCommBlock.ReceiverName := '[return-to-sender]'; // unnecessary

AThread.Connection.WriteBuffer (NewCommBlock, SizeOf (NewCommBlock), true); // and there it goes...
end;
end;
end;

procedure TServerFrmMain.ServerDisconnect(AThread: TIdPeerThread);
var
ActClient: PClient;

begin
ActClient := PClient(AThread.Data);
Protocol.Lines.Add (TimeToStr(Time)+' Disconnect from "'+ActClient^.DNS+'"');
try
Clients.LockList.Remove(ActClient);
finally
Clients.UnlockList;
end;
FreeMem(ActClient);
AThread.Data := nil;
end;

procedure TServerFrmMain.FormCreate(Sender: TObject);
begin
Clients := TThreadList.Create;
end;

procedure TServerFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Server.Active := False;
Clients.Free;
end;

end.

客户端和服务器端是一问一答的方式，
你在客户端增加了一个循环 服务器端也必须增加一个循环对应应答

JUST SOSO

Socket的双工模式完全被异化了。

也没发现什么不对啊,我也这样弄的,不过我是自己写的,不是采用DEMO