Y
yjpya
Unregistered / Unconfirmed
GUEST, unregistred user!
各位朋友,请看以下两个Unit的代码,两段代码的原来功能分别一个是负责接收信息,一个负责发送信息,请问,假如我想实现类似PcAnyWhere的监控功能,下面的两段代码该如何修改?即代码二的程序作为Server端,代码一的程序也作为Client端,Client端在启动的时候就不停向Server端发出数据包,Server端可以获得所有Client发送过来的数据包,而且知道哪些Client是在线的?请各位朋友赐教,多谢!!!
代码一:
unit pop;
interface
uses
Unit2,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdThreadMgr, IdThreadMgrDefault, StdCtrls, IdBaseComponent,
IdComponent, IdTCPServer;
type
PClient = ^TClient;
TClient = record // Object holding data of client (see events)
CIP,
DNS : String[20];
{ Hostname }
Connected, { Time of connect }
LastAction : TDateTime;
{ Time of last transaction }
Thread : Pointer;
{ Pointer to thread }
end;
type
TForm1 = class(TForm)
Server: TIdTCPServer;
Memo1: TMemo;
IdThreadMgrDefault1: TIdThreadMgrDefault;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure ServerConnect(AThread: TIdPeerThread);
procedure ServerDisconnect(AThread: TIdPeerThread);
procedure ServerExecute(AThread: TIdPeerThread);
private
RecMsg: string;
procedure ShowMsg;
public
end;
var
Form1: TForm1;
Clients: TThreadList;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Clients := TThreadList.Create;
Server.Active :=True;
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Server.Active := False;
Clients.Free;
end;
procedure TForm1.ServerConnect(AThread: TIdPeerThread);
var //连接时自动建立一个线程Athread
NewClient: PClient;
begin
GetMem(NewClient, SizeOf(TClient));
//申请内存
NewClient.CIP := ATHread.Connection.Socket.Binding.PeerIP;
NewClient.DNS := NewClient.CIP;
NewClient.Connected := Now;
NewClient.LastAction := NewClient.Connected;
NewClient.Thread := AThread;
AThread.Data:=TObject(NewClient);
try
Clients.LockList.Add(NewClient);
//加入到全局变量:clients列表线程列表中
finally
Clients.UnlockList;
end;
end;
procedure TForm1.ServerDisconnect(AThread: TIdPeerThread);
var //Athread为断开的那个连接对应的线程
ActClient: PClient;
begin
ActClient := PClient(AThread.Data);
try
Clients.LockList.Remove(ActClient);
finally
Clients.UnlockList;
end;
FreeMem(ActClient);
AThread.Data := nil;
end;
procedure TForm1.ServerExecute(AThread: TIdPeerThread);
var //client端发送数据过来 即执行
CommBlock, NewCommBlock: TCommBlock;//server端和client端传递的数据结构TCommBlock
begin
if not AThread.Terminated and AThread.Connection.Connected then
begin
AThread.Connection.ReadBuffer (CommBlock, SizeOf (CommBlock));
recmsg:='From:'+CommBlock.CIp+#13+'Message:'+CommBlock.Msg;
// RecMsg := Format('From: %s, Msg: %s, Cmd: %d',[CommBlock.CIp,CommBlock.Msg,CommBlock.Command]);
AThread.Synchronize(ShowMsg);
if CommBlock.Command = 1 then
begin
NewCommBlock.Command := 0;
NewCommBlock.Msg := '收到命令'+inttostr(CommBlock.Command)+':'+CommBlock.Msg;
//do anything
end
else
// unknown command given
begin
NewCommBlock.Command := -1;
NewCommBlock.Msg := 'Ido
n''t understand your command: "'
+inttostr(CommBlock.Command)+'"';
end;
AThread.Connection.WriteBuffer (NewCommBlock, SizeOf (NewCommBlock),true);
end;
end;
procedure TForm1.ShowMsg;
begin
Memo1.Lines.Add(RecMsg);
end;
end.
代码二:
unit send;
interface
uses
Unit2,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
StdCtrls;
type
TClientHandleThread = class(TThread)
private
CB: TCommBlock;
procedure HandleInput;
protected
procedure Execute;
override;
end;
type
TForm1 = class(TForm)
btnSend: TButton;
Memo1: TMemo;
edtIPAddr: TEdit;
Client: TIdTCPClient;
procedure btnSendClick(Sender: TObject);
private
procedure SendMsg(Msg: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
ClientHandleThread: TClientHandleThread;
implementation
{$R *.dfm}
{ TClientHandleThread }
procedure TClientHandleThread.Execute;
begin
inherited;
while not Terminateddo
//线程执行部分 永远不停的执行
begin
if not Form1.Client.Connected then
Terminate
else
try
Form1.Client.ReadBuffer(CB, SizeOf (CB));
//将idtcpclient接收到的消息读入到线程对象的CB块
Synchronize(HandleInput);
//解析消息执行动作
if (cb.command=0) or (cb.command=-1) then
Terminate;
except
// null exceptions...
end;
end;
end;
procedure TClientHandleThread.HandleInput;
begin
Form1.Client.Disconnect;
if cb.command=0 then
showmessage('发送成功。'+cb.Msg)
else
if cb.command=-1 then
showmessage('发送失败。'+cb.Msg)
else
showmessage('未知返回值');
end;
{ TForm1 }
procedure TForm1.SendMsg(Msg: string);
var
CommBlock : TCommBlock;
begin
if not client.Connected then
try
client.Host:=edtIPAddr.Text;
Client.Connect(10000);
// in Indy < 8.1 leave the parameter away
ClientHandleThread := TClientHandleThread.Create(True);//开启客户端 启动全局线程
ClientHandleThread.FreeOnTerminate:=True;
ClientHandleThread.Resume;
// assign the data that's should be sended
CommBlock.Command := 1;
CommBlock.CIp := Client.Socket.Binding.IP;
CommBlock.CHost:= Client.LocalName;
CommBlock.Msg := Msg;
Client.WriteBuffer(CommBlock, SizeOf (CommBlock), true);
//发送数据
except
on E: Exceptiondo
begin
MessageDlg ('连接服务器失败:'+#13+E.Message+#13+'请检查服务器是否正常运行',
mtError, [mbOk], 0);
exit;
end;
end
else
showmessage('上一次向服务器请求的命令还未完成,请稍等');
end;
procedure TForm1.btnSendClick(Sender: TObject);
begin
SendMsg(Memo1.Lines.Text);
end;
end.
代码一:
unit pop;
interface
uses
Unit2,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdThreadMgr, IdThreadMgrDefault, StdCtrls, IdBaseComponent,
IdComponent, IdTCPServer;
type
PClient = ^TClient;
TClient = record // Object holding data of client (see events)
CIP,
DNS : String[20];
{ Hostname }
Connected, { Time of connect }
LastAction : TDateTime;
{ Time of last transaction }
Thread : Pointer;
{ Pointer to thread }
end;
type
TForm1 = class(TForm)
Server: TIdTCPServer;
Memo1: TMemo;
IdThreadMgrDefault1: TIdThreadMgrDefault;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure ServerConnect(AThread: TIdPeerThread);
procedure ServerDisconnect(AThread: TIdPeerThread);
procedure ServerExecute(AThread: TIdPeerThread);
private
RecMsg: string;
procedure ShowMsg;
public
end;
var
Form1: TForm1;
Clients: TThreadList;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Clients := TThreadList.Create;
Server.Active :=True;
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Server.Active := False;
Clients.Free;
end;
procedure TForm1.ServerConnect(AThread: TIdPeerThread);
var //连接时自动建立一个线程Athread
NewClient: PClient;
begin
GetMem(NewClient, SizeOf(TClient));
//申请内存
NewClient.CIP := ATHread.Connection.Socket.Binding.PeerIP;
NewClient.DNS := NewClient.CIP;
NewClient.Connected := Now;
NewClient.LastAction := NewClient.Connected;
NewClient.Thread := AThread;
AThread.Data:=TObject(NewClient);
try
Clients.LockList.Add(NewClient);
//加入到全局变量:clients列表线程列表中
finally
Clients.UnlockList;
end;
end;
procedure TForm1.ServerDisconnect(AThread: TIdPeerThread);
var //Athread为断开的那个连接对应的线程
ActClient: PClient;
begin
ActClient := PClient(AThread.Data);
try
Clients.LockList.Remove(ActClient);
finally
Clients.UnlockList;
end;
FreeMem(ActClient);
AThread.Data := nil;
end;
procedure TForm1.ServerExecute(AThread: TIdPeerThread);
var //client端发送数据过来 即执行
CommBlock, NewCommBlock: TCommBlock;//server端和client端传递的数据结构TCommBlock
begin
if not AThread.Terminated and AThread.Connection.Connected then
begin
AThread.Connection.ReadBuffer (CommBlock, SizeOf (CommBlock));
recmsg:='From:'+CommBlock.CIp+#13+'Message:'+CommBlock.Msg;
// RecMsg := Format('From: %s, Msg: %s, Cmd: %d',[CommBlock.CIp,CommBlock.Msg,CommBlock.Command]);
AThread.Synchronize(ShowMsg);
if CommBlock.Command = 1 then
begin
NewCommBlock.Command := 0;
NewCommBlock.Msg := '收到命令'+inttostr(CommBlock.Command)+':'+CommBlock.Msg;
//do anything
end
else
// unknown command given
begin
NewCommBlock.Command := -1;
NewCommBlock.Msg := 'Ido
n''t understand your command: "'
+inttostr(CommBlock.Command)+'"';
end;
AThread.Connection.WriteBuffer (NewCommBlock, SizeOf (NewCommBlock),true);
end;
end;
procedure TForm1.ShowMsg;
begin
Memo1.Lines.Add(RecMsg);
end;
end.
代码二:
unit send;
interface
uses
Unit2,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
StdCtrls;
type
TClientHandleThread = class(TThread)
private
CB: TCommBlock;
procedure HandleInput;
protected
procedure Execute;
override;
end;
type
TForm1 = class(TForm)
btnSend: TButton;
Memo1: TMemo;
edtIPAddr: TEdit;
Client: TIdTCPClient;
procedure btnSendClick(Sender: TObject);
private
procedure SendMsg(Msg: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
ClientHandleThread: TClientHandleThread;
implementation
{$R *.dfm}
{ TClientHandleThread }
procedure TClientHandleThread.Execute;
begin
inherited;
while not Terminateddo
//线程执行部分 永远不停的执行
begin
if not Form1.Client.Connected then
Terminate
else
try
Form1.Client.ReadBuffer(CB, SizeOf (CB));
//将idtcpclient接收到的消息读入到线程对象的CB块
Synchronize(HandleInput);
//解析消息执行动作
if (cb.command=0) or (cb.command=-1) then
Terminate;
except
// null exceptions...
end;
end;
end;
procedure TClientHandleThread.HandleInput;
begin
Form1.Client.Disconnect;
if cb.command=0 then
showmessage('发送成功。'+cb.Msg)
else
if cb.command=-1 then
showmessage('发送失败。'+cb.Msg)
else
showmessage('未知返回值');
end;
{ TForm1 }
procedure TForm1.SendMsg(Msg: string);
var
CommBlock : TCommBlock;
begin
if not client.Connected then
try
client.Host:=edtIPAddr.Text;
Client.Connect(10000);
// in Indy < 8.1 leave the parameter away
ClientHandleThread := TClientHandleThread.Create(True);//开启客户端 启动全局线程
ClientHandleThread.FreeOnTerminate:=True;
ClientHandleThread.Resume;
// assign the data that's should be sended
CommBlock.Command := 1;
CommBlock.CIp := Client.Socket.Binding.IP;
CommBlock.CHost:= Client.LocalName;
CommBlock.Msg := Msg;
Client.WriteBuffer(CommBlock, SizeOf (CommBlock), true);
//发送数据
except
on E: Exceptiondo
begin
MessageDlg ('连接服务器失败:'+#13+E.Message+#13+'请检查服务器是否正常运行',
mtError, [mbOk], 0);
exit;
end;
end
else
showmessage('上一次向服务器请求的命令还未完成,请稍等');
end;
procedure TForm1.btnSendClick(Sender: TObject);
begin
SendMsg(Memo1.Lines.Text);
end;
end.