[咨询]关于Indy7 的idTcpServer 真的无法识别自己的标识包吗?

od4ys 2008-05-03 08:06:39
我想用Indy做一个远程管理软件.
我希望能够indy在连接的时候,能够识别自己的数据包.
所以就用了record格式的数据.

但发现 connect时间的时候Athread.connection.readbuffer() 接受一次数据后,无法在Execute线程再一次
Athread.connection.readbuffer() ...这样让我很头疼.
望高人来帮忙看一下下面代码.


unit UnitMain;

interface

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

const
PackVer =$2008; //版本和标志
Packflg =$1121;

CMD_Message =$2001;
CMD_Process =$2002;
CMD_ExitPrc =$2003;

type
Packet=packed record
pktcmd:DWORD;
pkterr:DWORD;
pktlen:DWORD;
pktbuf:array[0..100] of Char;
end;
type
PClient=^TClient;
TClient=record
LocalName:string[20];
Athread:Pointer;
end;

type
TfrmMain = class(TForm)
statBar: TStatusBar;
grp: TGroupBox;
lvRight: TListView;
spl1: TSplitter;
lvError: TListView;
idsvr: TIdTCPServer;
idntfrz1: TIdAntiFreeze;
idthrdmgrdflt1: TIdThreadMgrDefault;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure idsvrConnect(AThread: TIdPeerThread);
procedure idsvrExecute(AThread: TIdPeerThread);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;
Clients:TThreadList;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
idsvr.DefaultPort:=7890;
idsvr.Active:=True;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
idsvr.Active:=False;
end;

procedure TfrmMain.idsvrConnect(AThread: TIdPeerThread);
var
pkt:Packet;
item:TListItem;
NewClient: PClient;
begin
if AThread.Connection.Connected and not AThread.Terminated then
begin
AThread.Connection.ReadTimeout:=5000;
AThread.Connection.ReadBuffer(pkt,SizeOf(pkt));

if pkt.pktcmd <> PackVer then //当有连接过来时候,把数据放入pkt结构
begin //判断pkt的标志是否是预定的,如果不是就在listview显示错误
item:=lvError.Items.Add;
item.Caption:= AThread.Connection.Socket.Binding.PeerIP;
item.SubItems.Add('内容');//这个内容怎么添加????
item.SubItems.Add('长度');//这个长度怎么计算????
AThread.Connection.Disconnect;
AThread.Terminate;
Exit;
end else
begin //这是正确的包
GetMem(NewClient, SizeOf(TClient));
NewClient.LocalName := AThread.Connection.LocalName;
NewClient.Athread := AThread;

AThread.Data:= TObject(NewClient);
try
Clients.LockList.Add(NewClient);
finally
Clients.UnlockList;
end;

item:=lvRight.Items.Add;
item.Caption:= AThread.Connection.Socket.Binding.PeerIP;
item.SubItems.Add(IntToStr(pkt.pktcmd));
item.SubItems.Add('正确的');
end;

end;
end;

procedure TfrmMain.idsvrExecute(AThread: TIdPeerThread);
var
pkt:Packet;
begin
if AThread.Connection.Connected and not AThread.Terminated then
begin
AThread.Connection.ReadTimeout:=5000;
AThread.Connection.ReadBuffer(pkt,SizeOf(pkt));

case pkt.pktcmd of
CMD_Message:{begin.................end};
CMD_Process:{begin.................end};
CMD_ExitPrc:{begin.................end};
end;

end.
...全文
112 2 打赏 收藏 转发到动态 举报
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
od4ys 2008-05-04
  • 打赏
  • 举报
回复
原先代码有问题,现在修改了放上来:
unit UnitMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, StdCtrls, IdThreadMgr, IdThreadMgrDefault,
IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent, IdTCPServer,
WinSkinStore, WinSkinData;

const
PackVer =$2008; //版本和标志
Packflg =$1121;

CMD_Message =$2001;
CMD_Process =$2002;
CMD_ExitPrc =$2003;

type
Packet=packed record
pktflg:DWORD;
pktcmd:DWORD;
pkterr:DWORD;
pktlen:DWORD;
pktbuf:array[0..100] of Char;
end;
type
PClient=^TClient;
TClient=record
LocalName:string[20];
Athread:Pointer;
end;

type
TfrmMain = class(TForm)
statBar: TStatusBar;
grp: TGroupBox;
lvRight: TListView;
spl1: TSplitter;
lvError: TListView;
idsvr: TIdTCPServer;
idntfrz1: TIdAntiFreeze;
idthrdmgrdflt1: TIdThreadMgrDefault;
skndt1: TSkinData;
sknstr1: TSkinStore;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure idsvrConnect(AThread: TIdPeerThread);
procedure idsvrExecute(AThread: TIdPeerThread);
procedure syncerr;
procedure syncrig;
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;
Clients:TThreadList;

implementation

{$R *.dfm}



procedure TfrmMain.FormCreate(Sender: TObject);
begin
idsvr.DefaultPort:=7890;
idsvr.Active:=True;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
idsvr.Active:=False;
end;

procedure TfrmMain.syncerr;
var
item:TListItem;
begin
item:=lvError.Items.Add;
item.Caption:= 'fck';
item.SubItems.Add('Error IP');
end;

procedure TfrmMain.syncrig;
var
item:TListItem;
begin
item:=lvError.Items.Add;
item.Caption:= 'ok';
item.SubItems.Add('ok IP');
end;

procedure TfrmMain.idsvrConnect(AThread: TIdPeerThread);
var
pkt:Packet;
item:TListItem;
NewClient: PClient;
begin
if AThread.Connection.Connected and not AThread.Terminated then
begin
AThread.Connection.ReadTimeout:=15000;
AThread.Connection.ReadBuffer(pkt,SizeOf(pkt));

if pkt.pktflg <> PackVer then //当有连接过来时候,把数据放入pkt结构
begin //判断pkt的标志是否是预定的,如果不是就在listview显示错误
AThread.Synchronize(syncerr);
AThread.Connection.Disconnect;
Exit;
end else
begin //这是正确的包
GetMem(NewClient, SizeOf(TClient));
NewClient.LocalName := AThread.Connection.LocalName;
NewClient.Athread := AThread;

AThread.Data:= TObject(NewClient);
try
Clients.LockList.Add(NewClient);
finally
Clients.UnlockList;
end;

AThread.Synchronize(syncrig);
end;

end;
end;

procedure TfrmMain.idsvrExecute(AThread: TIdPeerThread);
var
pkt:Packet;
begin
if AThread.Connection.Connected and not AThread.Terminated then
begin
AThread.Connection.ReadTimeout:=5000;
AThread.Connection.ReadBuffer(pkt,SizeOf(pkt));

case pkt.pktcmd of
CMD_Message:{begin.................end};
CMD_Process:{begin.................end};
CMD_ExitPrc:{begin.................end};
end;
end;
end;

end.


od4ys 2008-05-03
  • 打赏
  • 举报
回复
还有
我想在connect事件中判断是否使自己的包,是,就加入列表,不是就加入错误的列表.
但在connect必须接受pkt包,但在Execute却不是这个包了,怎么解决/??

1,593

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 网络通信/分布式开发
社区管理员
  • 网络通信/分布式开发社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧