Indy组件问题，在线等待...... ( 积分: 100 )

  • 主题发起人 主题发起人 陌生
  • 开始时间 开始时间
陌

陌生

Unregistered / Unconfirmed
GUEST, unregistred user!
{服务器端代码}
unit XYUnit;

interface

Type
{传递数据结构定义}
TCommBlock=Record
CNo:String[4];
Command:String;
RData:String;
DNumber:String[15];
end;

implementation

end.
{服务器主窗体代码}
unit MainUnit;

interface

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

type
TMainForm = class(TForm)
TXServer: TIdTCPServer;
IdThreadMgrDefault1: TIdThreadMgrDefault;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TXServerConnect(AThread: TIdPeerThread);
procedure TXServerDisconnect(AThread: TIdPeerThread);
procedure TXServerExecute(AThread: TIdPeerThread);
private
{ Private declarations }
public
{ Public declarations }
end;

var
MainForm: TMainForm;

implementation

uses GlobalUnit, xyUnit;

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
{客户端列表}
Clients:=TThreadList.Create;
{打开服务器}
try
txServer.Active :=True;
except

end;

end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
{释放客户端列表对象}
Clients.Free;
{关闭服务器}
if txServer.Active then
txServer.Active :=False;

end;

procedure TMainForm.TXServerConnect(AThread: TIdPeerThread);
var
NewClient:PClient;
begin
GetMem(NewClient,SizeOf(TClient));
NewClient^.CIP :=AThread.Connection.Socket.Binding.PeerIP;
NewClient^.Thread :=AThread;
AThread.Data :=TObject(NewClient);
try
Clients.LockList.Add(NewClient);
finally
Clients.UnlockList;
end;

end;

procedure TMainForm.TXServerDisconnect(AThread: TIdPeerThread);
var
ActClient:PClient;
begin
ActClient:=PClient(AThread.Data);
try
Clients.LockList.Remove(ActClient);
finally
Clients.UnlockList;
end;
FreeMem(ActClient);
AThread.Data :=Nil;

end;

procedure TMainForm.TXServerExecute(AThread: TIdPeerThread);
var
ActClient:PClient;
CommBlock,NewCommBlock:TCommBlock;
begin
if (Not AThread.Terminated) and (AThread.Connection.Connected)then
begin
AThread.Connection.ReadBuffer(CommBlock,SizeOf(CommBlock));
ActClient:=PClient(AThread.Data);
{问题在于服务器端不能够得到Command，或者说不能够正确地获得客户端传输过来的内容}
if CommBlock.Command='LOGIN' then
begin
NewCommBlock:=CommBlock;
NewCommBlock.Command :='LOGINED';
AThread.Connection.WriteBuffer(NewCommBlock,SizeOf(NewCommBlock),True);
end;
end;
end;

end.
{客户端程序代码}
unit MainUnit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, StdCtrls,XYUnit;

type
TClientHandleThread=Class(TThread)
private
CB:TCommBlock;
procedure HandleInput;
Protected
Procedure Execute;override;
end;

TMainForm = class(TForm)
Client: TIdTCPClient;
IdAntiFreeze1: TIdAntiFreeze;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
MainForm: TMainForm;
ClientHandleThread:TClientHandleThread;

implementation

uses GlobalUnit;

{$R *.dfm}

{ TClientHandleThread }

procedure TClientHandleThread.Execute;
begin
while Not Terminated do
begin
MainForm.Client.ReadBuffer(CB,SizeOf(CB));
Synchronize(HandleInput);

end; // while

end;

procedure TClientHandleThread.HandleInput;
begin
if CB.Command='LOGINED' then
Showmessage('Login Success!!!');
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
try
Client.Connect(10000);

ClientHandleThread:=TClientHandleThread.Create(True);
ClientHandleThread.Resume;
except
on e: Exception do
ShowMessage(e.Message );
end;
end;

procedure TMainForm.Button2Click(Sender: TObject);
var
CommBlock:TCommBlock;
begin
CommBlock.Command :='LOGIN';
CommBlock.CNo :='1001';
CommBlock.DNumber :='1002';
Client.WriteBuffer(CommBlock,SizeOf(CommBlock),True);

end;

end.
两者共用一个GlobalUnit，希望大家帮忙看一下问题到底出在哪里了？有时候我还会发现在客户端连接之后会马上断开连接，不知道是为什么，因为对于Indy组件不是很熟悉，现在请大家帮帮忙了。
 
{服务器端代码}
unit XYUnit;

interface

Type
{传递数据结构定义}
TCommBlock=Record
CNo:String[4];
Command:String;
RData:String;
DNumber:String[15];
end;

implementation

end.
{服务器主窗体代码}
unit MainUnit;

interface

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

type
TMainForm = class(TForm)
TXServer: TIdTCPServer;
IdThreadMgrDefault1: TIdThreadMgrDefault;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TXServerConnect(AThread: TIdPeerThread);
procedure TXServerDisconnect(AThread: TIdPeerThread);
procedure TXServerExecute(AThread: TIdPeerThread);
private
{ Private declarations }
public
{ Public declarations }
end;

var
MainForm: TMainForm;

implementation

uses GlobalUnit, xyUnit;

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
{客户端列表}
Clients:=TThreadList.Create;
{打开服务器}
try
txServer.Active :=True;
except

end;

end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
{释放客户端列表对象}
Clients.Free;
{关闭服务器}
if txServer.Active then
txServer.Active :=False;

end;

procedure TMainForm.TXServerConnect(AThread: TIdPeerThread);
var
NewClient:PClient;
begin
GetMem(NewClient,SizeOf(TClient));
NewClient^.CIP :=AThread.Connection.Socket.Binding.PeerIP;
NewClient^.Thread :=AThread;
AThread.Data :=TObject(NewClient);
try
Clients.LockList.Add(NewClient);
finally
Clients.UnlockList;
end;

end;

procedure TMainForm.TXServerDisconnect(AThread: TIdPeerThread);
var
ActClient:PClient;
begin
ActClient:=PClient(AThread.Data);
try
Clients.LockList.Remove(ActClient);
finally
Clients.UnlockList;
end;
FreeMem(ActClient);
AThread.Data :=Nil;

end;

procedure TMainForm.TXServerExecute(AThread: TIdPeerThread);
var
ActClient:PClient;
CommBlock,NewCommBlock:TCommBlock;
begin
if (Not AThread.Terminated) and (AThread.Connection.Connected)then
begin
AThread.Connection.ReadBuffer(CommBlock,SizeOf(CommBlock));
ActClient:=PClient(AThread.Data);
{问题在于服务器端不能够得到Command，或者说不能够正确地获得客户端传输过来的内容}
if CommBlock.Command='LOGIN' then
begin
NewCommBlock:=CommBlock;
NewCommBlock.Command :='LOGINED';
AThread.Connection.WriteBuffer(NewCommBlock,SizeOf(NewCommBlock),True);
end;
end;
end;

end.
{客户端程序代码}
unit MainUnit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, StdCtrls,XYUnit;

type
TClientHandleThread=Class(TThread)
private
CB:TCommBlock;
procedure HandleInput;
Protected
Procedure Execute;override;
end;

TMainForm = class(TForm)
Client: TIdTCPClient;
IdAntiFreeze1: TIdAntiFreeze;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
MainForm: TMainForm;
ClientHandleThread:TClientHandleThread;

implementation

uses GlobalUnit;

{$R *.dfm}

{ TClientHandleThread }

procedure TClientHandleThread.Execute;
begin
while Not Terminated do
begin
MainForm.Client.ReadBuffer(CB,SizeOf(CB));
Synchronize(HandleInput);

end; // while

end;

procedure TClientHandleThread.HandleInput;
begin
if CB.Command='LOGINED' then
Showmessage('Login Success!!!');
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
try
Client.Connect(10000);

ClientHandleThread:=TClientHandleThread.Create(True);
ClientHandleThread.Resume;
except
on e: Exception do
ShowMessage(e.Message );
end;
end;

procedure TMainForm.Button2Click(Sender: TObject);
var
CommBlock:TCommBlock;
begin
CommBlock.Command :='LOGIN';
CommBlock.CNo :='1001';
CommBlock.DNumber :='1002';
Client.WriteBuffer(CommBlock,SizeOf(CommBlock),True);

end;

end.
两者共用一个GlobalUnit，希望大家帮忙看一下问题到底出在哪里了？有时候我还会发现在客户端连接之后会马上断开连接，不知道是为什么，因为对于Indy组件不是很熟悉，现在请大家帮帮忙了。
 
仔细看看例题demo/indy/idTcpDemo ，应该可以解决。
 
您必须登录或注册才可回复。

Similar threads

S
[转]ClientDataSet加上TDataSetProvider的数据保存问题
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
[转]ClientDataSet加上TDataSetProvider的数据保存问题
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
文件的合并和分解
回复
0
查看
695
import
I
I
在标题栏添加按钮
回复
0
查看
524
import
I
I
IE历史记录菜单控件
回复
0
查看
491
import
I
后退
顶部