求多线程思路 找服装进销存管理系统
销售管理软件版1楼: 各位朋友，请看以下两个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 := ＇＇I don＇＇＇＇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 Terminated do //线程执行部分 永远不停的执行
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: Exception do 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 := ＇＇I don＇＇＇＇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 Terminated do //线程执行部分 永远不停的执行
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: Exception do 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.
2楼: 哥儿们，谁有那么多时间，一点一点看你的代码啊
只说说思路应该还可以 如设备维修管理软件
3楼: 二楼的朋友，能告诉一个思路吗？请告知，多谢！！！！
4楼: 服务器端启动一个UDP接收端口
客户端周期性的向服务器发送UDP包
这个UDP包中可以含有希望知道的数据
这样就可以很简单的
发送的时候可以使用队列，将要发送的内容排列
5楼: 楼上的大虾，具体怎样实现呢？有没相关的例子呢？
6楼: 解决问题的思路：
在SERVER端对所有联接的CLIENT建立一个数据结构，
如
TClientData Packed Record
IP:String;
Port:WOrd;
Flags:Integer
end
Flags存放一个整数，我一般定为5
客户端有一个线程，每隔10秒或你不定时的发，但间隔时间不要超过服务器设定时间*Flags，比如说你比较忙的时候，可以长一点再发，网络比较忙时，可以隔一段时间再发等，由程序而定、对服务器发一个keepalive包，这个包可以比较短一点，甚至是一个字节（最好加一个时间，或增大的流水号，防止有人编程对你的SERVER DOS）。
服务器收到这个keep alive包后，就判断，如果是5则不变，如果小于5，则加一次。（这里注意同步）。
服务端有一个线程，每15秒对于所有的TClientData这样扫描一次，每扫描一次，把Flags-1，如果发现这个Flags数值=0了，就对IP:Port发送一次退出指令（不管收不收得到），同时把这个结构体清除，表示不在线了。也就是说，如果客户端15*5秒（时间可以改的啦）=45秒没有与服务器联系的话，表示离线。
用DELPHI里的线程可以解决这些问题，但是要注意同步，因为两个线程都要读的数是共享区，因此你要建立一个标志。当然可以放在Record里面。这是后话。
销售管理软件版7楼: 这个用C与S控件，如
在S端广播一个包说：“你们哪些在线，在线的站出来！” 网卡地址为（FFFFFFFF）
在C端听到这个包说：“我在这儿，你给我怎么搞！”（发送一个响应包到服务器端）
然后服务器端就可以接管了！
具体代码www.delphibox.com上有！！！
8楼: 楼上的朋友，高高高，但DelphiBox哪一个例子是对应的源码呢？请赐教，多谢！！！
9楼: 我来接分了，散吧
10楼: 想通了，结贴！！！
11楼: 散分了
12楼: 请楼主详细说一下思路，最好把代码给发上 来看看，谢谢 如服装进销存管理系统
联系我们
