关于IdTCPServer和IdTCPClient组件(50分)

  • 主题发起人 主题发起人 meilixueshan200
  • 开始时间 开始时间
M

meilixueshan200

Unregistered / Unconfirmed
GUEST, unregistred user!
1、IdTCPServer做的服务器端如何向IdTCPClient做的客户端发送信息？（能否实现，如果不能，那怎么解决呀）
2、服务器端如何检测客户端是否在线？（可能因为网络中断，停电，非正常退出了）。
3、如果客户端程序中也加入IdTCPServer服务器控件，和服务器端加入IdTCPClient客户端组件，那么会怎么样？
 
其实，你这个问题在indy 9的demos里均可以找到答案。
 
不会吧
又是这个例子？
我这里有，看过了
如果非常退出的话，就检测不了
而且服务器也无法向客户端发送信息呀？
它只是客户端向服务器发送信息时，服务器返回一个信息。
我想知道服务器如何根据一个ip列表，主动向这些IP的客户端发送信息呀？
 
算了，我还是把我早期编写的代码贴出来，不是很完善，楼主可以参考一下：
顺带说一下，此时的ip列表是虚的，要根据建立的套接字连接来发送消息，请参看BroadcastMessage过程。

unit frmLog;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, IdBaseComponent,
IdComponent, IdTCPServer, IdAntiFreezeBase, IdAntiFreeze,
IdServerIOHandler, IdServerIOHandlerSocket, IdIOHandler,
IdIOHandlerSocket, IdIntercept, IdTCPConnection, IdTCPClient, SyncObjs,
IdThreadMgr, IdThreadMgrDefault, Menus, ActnList, ImgList,
IdThreadMgrPool, Buttons ;

type
TCommBlock = record // 数据通讯块 (Server+Client)
ComputerPort:integer; //发送端TCP/IP端口
CommDateTime:TDateTime;//通讯时间
Command:string[32]; // 通讯命令
// LOGIN、LOGOUT、ERROR、DOWNLOAD、CLOSE、ONLINE
ComputerIP:string[32]; // 发送端计算机IP
ComputerName:string[32]; // 发送端计算机名称
Msg:string[255]; // 发送消息
SendMsgUserName:string[32]; // 发送消息的用户
ReceiverMsgUserName: string[32]; // 接收消息的用户
end;

TSimpleClient=class(TObject)
CommBlock:TCommBlock;
ConnectedDateTime,
LastActionDateTime:TDateTime;
ListLink:word;
Thread:Pointer;
end;

TSaveMethod = procedure (const FileName: String; ASaveAll: Boolean) of object;

TMainForm = class(TForm)
Panel1: TPanel;
SaveDialogMain: TSaveDialog;
MainPageControl: TPageControl;
LogTabSheet: TTabSheet;
ClearBtn: TButton;
TxtOutBtn: TButton;
TxtINBtn: TButton;
OpenDialogMain: TOpenDialog;
TCPServer: TIdTCPServer;
IdServerIOHandlerSocket: TIdServerIOHandlerSocket;
IdAntiFreeze: TIdAntiFreeze;
MainActionList: TActionList;
MainImageList: TImageList;
SendMessageAction: TAction;
SendMessagePopupMenu: TPopupMenu;
SendMessageMenu: TMenuItem;
OnLineAccountTabSheet: TTabSheet;
AccountListBox: TListBox;
SendMessageAllAction: TAction;
SendMessageAllMenu: TMenuItem;
SendRebootAction: TAction;
RebootMenu: TMenuItem;
LogMemo: TMemo;
AccountLabel: TLabel;
RecordLabel: TLabel;
IdThreadMgrPool1: TIdThreadMgrPool;
PortEdit: TEdit;
Label1: TLabel;
ActiveBtn: TBitBtn;
CloseBtn: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure TCPServerConnect(AThread: TIdPeerThread);
procedure TCPServerExecute(AThread: TIdPeerThread);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure ClearBtnClick(Sender: TObject);
procedure TxtOutBtnClick(Sender: TObject);
procedure TxtINBtnClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TCPServerDisconnect(AThread: TIdPeerThread);
procedure SendMessageActionExecute(Sender: TObject);
procedure SendMessagePopupMenuPopup(Sender: TObject);
procedure SendMessageAllActionExecute(Sender: TObject);
procedure SendRebootActionExecute(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ActiveBtnClick(Sender: TObject);
procedure CloseBtnClick(Sender: TObject);
private
{ Private declarations }
vChwiseERPLogMutexMess:Cardinal;
function myMessageHandle(var Message: TMessage):Boolean;
public
{ Public declarations }
OnConnectCS,OnDisConnectCS,OnAddCS,ConnectCS,DisConnectCS,UpdateListCS,BroadcastCS: TCriticalSection;
CommBlock:TCommBlock;
Clients:TList;
BadClientCount:integer;
procedure OnConnect;
procedure OnDisConnect;
procedure OnAdd;

procedure UpdateClientList;
procedure BroadcastMessage(msgCommBlock:TCommBlock);
procedure CloseLog;
procedure ActiveLog;
end;

var
MainForm: TMainForm;

implementation

{$R *.dfm}
uses IdSocketHandle,frmMessage,IniFiles;

procedure TMainForm.ActiveLog;
var
ServerIni: TIniFile;
Path:string;
vPort:integer;
Binding: TIdSocketHandle;
begin
CloseLog;

try
TCPServer.DefaultPort:=StrToInt(PortEdit.Text);
except
TCPServer.DefaultPort:=9000;
end;
{ Remove all bindings that currently exist }
TCPServer.Bindings.Clear;
{ Create a new binding }
Binding := TCPServer.Bindings.Add;
{ Assign that bindings port to our new port }
Binding.Port := TCPServer.DefaultPort;


try
TCPServer.Active:=True;
except
on e:Exception do
begin
Application.MessageBox(pchar('激活出错。'+#13#10+e.Message),'提示');
end;
end;

try
vPort:=StrToInt(trim(PortEdit.Text));
except
vPort:=9000;
end;

Path:=ExtractFilePath(Application.ExeName);
ServerIni := TIniFile.Create(Path+'ERPLog.ini');
ServerIni.WriteInteger('System','Port',vPort);
ServerIni.UpdateFile;
ServerIni.Free;

end;

procedure TMainForm.CloseLog;
var i:integer;
List : TList;
begin
List := tcpServer.Threads.LockList;
try
if List.Count>0 then
for i:=0 to List.Count-1 do
begin
try
TIdPeerThread(List.Items[0]).Connection.Disconnect;
except
end;
end;
finally
tcpServer.Threads.Clear;
tcpServer.Threads.UnlockList;
end;
for i:=1 to 5 do
begin
try
TCPServer.Active:=false;
except
{
on e:Exception do
begin
Application.MessageBox(pchar('关闭出错。'+#13#10+e.Message),'提示');
end;
}
end;
sleep(100);
end;
end;

function TMainForm.myMessageHandle(var Message: TMessage):Boolean;
begin
if (message.Msg=vChwiseERPLogMutexMess) then
Begin
SetForegroundWindow(Application.Handle);
Application.MainForm.Show;
Application.Restore;
Application.RestoreTopMosts;
Application.BringToFront;
result:=true;
End
else
result:=false;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
ServerIni: TIniFile;
Path:string;
vPort:integer;
begin
Path:=ExtractFilePath(Application.ExeName);
ServerIni := TIniFile.Create(Path+'ERPLog.ini');
try
vPort:=ServerIni.ReadInteger('System','Port',9000);
// Application.MessageBox(pchar(Path+'ERPLog.ini'),pchar(inttostr(vport)));
except
vPort:=9000;
end;
ServerIni.Free;
PortEdit.Text:=trim(IntToStr(vPort));

BadClientCount:=0;
OnConnectCS := TCriticalSection.Create;
OnDisConnectCS := TCriticalSection.Create;
OnAddCS := TCriticalSection.Create;
ConnectCS := TCriticalSection.Create;
DisConnectCS := TCriticalSection.Create;
UpdateListCS:=TCriticalSection.Create;
BroadcastCS:=TCriticalSection.Create;

vChwiseERPLogMutexMess:=RegisterWindowMessage('ERPLogMutex');
Application.HookMainWindow(myMessageHandle);

Clients:=TList.Create;
// TCPServer.Active:=True;

ActiveLog;

MainPageControl.ActivePageIndex:=OnLineAccountTabSheet.TabIndex;
end;

procedure TMainForm.TCPServerConnect(AThread: TIdPeerThread);
var Client:TSimpleClient;
msgCommBlock:TCommBlock;
begin
ConnectCS.Enter;
try
AThread.Connection.ReadBuffer(CommBlock,SizeOf(CommBlock));
try
CommBlock.Command:=uppercase(trim(CommBlock.Command));
except
CommBlock.Command:='';
end;

Client:=TSimpleClient.Create;
Client.CommBlock.SendMsgUserName:='LOGGING IN';
Client.ListLink:=AThread.ThreadID;
Client.Thread:=AThread;
Client.CommBlock.SendMsgUserName:=CommBlock.SendMsgUserName;
AccountListBox.Items.Add(Client.CommBlock.SendMsgUserName);
AThread.Data:=Client;
Clients.Add(Client);

// UpdateClientList;

msgCommBlock:=Client.CommBlock;
msgCommBlock.Command:='@LOGIN';
msgCommBlock.CommDateTime:=now;
msgCommBlock.Msg:='登陆本系统';
msgCommBlock.SendMsgUserName:=Client.CommBlock.SendMsgUserName;

// BroadcastMessage(msgCommBlock);

AThread.Synchronize(OnConnect);

except
end;
AccountLabel.Caption:='在线用户共有'+IntToStr(AccountListBox.Items.count)+'人 ';
ConnectCS.Leave;
end;

procedure TMainForm.TCPServerDisconnect(AThread: TIdPeerThread);
var Client:TSimpleClient;
begin
DisConnectCS.Enter;
try
Client:=Pointer(AThread.Data);
Clients.Delete(Clients.IndexOf(Client));
AccountListBox.Items.Delete(AccountListBox.Items.IndexOf(Client.CommBlock.SendMsgUserName));
Client.Free;
AThread.Data:=nil;
// UpdateClientList;
except
end;
AccountLabel.Caption:='在线用户共有'+IntToStr(AccountListBox.Items.count)+'人 ';
DisConnectCS.Leave;
end;

procedure TMainForm.UpdateClientList;
var i:integer;
begin
UpdateListCS.Enter;
try
for i:= 0 to AccountListBox.Items.count-1 do
if i<Clients.Count then
AccountListBox.Items.Strings:=TSimpleClient(Clients.Items).CommBlock.SendMsgUserName;
except
end;
AccountLabel.Caption:='在线用户共有'+IntToStr(AccountListBox.Items.count)+'人 ';
UpdateListCS.Leave;
end;

procedure TMainForm.TCPServerExecute(AThread: TIdPeerThread);
var Client:TSimpleClient;
msgCommBlock:TCommBlock;
begin

if not AThread.Terminated and AThread.Connection.Connected then
begin
try
AThread.Connection.ReadBuffer(CommBlock,SizeOf(CommBlock));
try
CommBlock.Command:=uppercase(trim(CommBlock.Command));
except
CommBlock.Command:='';
end;
Client:=Pointer(AThread.Data);
if Client.ListLink=AThread.ThreadID then
begin
if Client.CommBlock.SendMsgUserName='LOGGING IN' then
begin
Client.CommBlock.SendMsgUserName:=CommBlock.SendMsgUserName;
// UpdateClientList;
end;
end;
if not (CommBlock.Command='') then
begin
if SameText(CommBlock.Command,'ONLINE') then
begin
AThread.Synchronize(OnAdd);
msgCommBlock:=Client.CommBlock;
msgCommBlock.Command:='@ONLINE';
msgCommBlock.CommDateTime:=now;
msgCommBlock.Msg:='';
msgCommBlock.SendMsgUserName:=Client.CommBlock.SendMsgUserName;
// UpdateClientList;
// BroadcastMessage(msgCommBlock);
AThread.Connection.WriteBuffer(msgCommBlock,SizeOf(msgCommBlock));
AThread.Connection.WriteLn(MainForm.AccountListBox.Items.CommaText);
end else
if SameText(CommBlock.Command,'LOGOUT') then
begin
msgCommBlock:=Client.CommBlock;
msgCommBlock.Command:='@LOGOUT';
msgCommBlock.CommDateTime:=now;
msgCommBlock.Msg:='离开本系统';
msgCommBlock.SendMsgUserName:=Client.CommBlock.SendMsgUserName;
// BroadcastMessage(msgCommBlock);
AThread.Synchronize(OnDisConnect);
AThread.Connection.Disconnect;
end else
if SameText(CommBlock.Command,'LOGIN') then
begin
{
msgCommBlock:=Client.CommBlock;
msgCommBlock.Command:='@LOGIN';
msgCommBlock.CommDateTime:=now;
msgCommBlock.Msg:='登陆本系统';
msgCommBlock.SendMsgUserName:=Client.CommBlock.SendMsgUserName;
BroadcastMessage(msgCommBlock);
AThread.Synchronize(OnConnect);
}

end
else
begin
msgCommBlock:=Client.CommBlock;
msgCommBlock.Command:='@ONLINE';
msgCommBlock.CommDateTime:=now;
msgCommBlock.Msg:='';
msgCommBlock.SendMsgUserName:=Client.CommBlock.SendMsgUserName;
AThread.Connection.WriteBuffer(msgCommBlock,SizeOf(msgCommBlock));
AThread.Connection.WriteLn(MainForm.AccountListBox.Items.CommaText);
AThread.Synchronize(OnAdd);
end;
end;
except
//
end;
end;
end;

procedure TMainForm.BroadcastMessage(msgCommBlock:TCommBlock);
var
i: Integer;
List : TList;
Flag:boolean;
begin
BroadcastCS.Enter;
List := tcpServer.Threads.LockList;
try
for i := 0 to List.Count -1 do
try

if SameText(msgCommBlock.Command,'@LOGIN') then
begin
TIdPeerThread(List.Items).Connection.WriteBuffer(msgCommBlock,SizeOf(msgCommBlock));
TIdPeerThread(List.Items).Connection.WriteLn(MainForm.AccountListBox.Items.CommaText);
end;
if SameText(msgCommBlock.Command,'@LOGOUT') then
begin
TIdPeerThread(List.Items).Connection.WriteBuffer(msgCommBlock,SizeOf(msgCommBlock));
TIdPeerThread(List.Items).Connection.WriteLn(MainForm.AccountListBox.Items.CommaText);
end;
if SameText(msgCommBlock.Command,'@ONLINE') then
begin
// TIdPeerThread(List.Items).Connection.WriteBuffer(msgCommBlock,SizeOf(msgCommBlock));
// TIdPeerThread(List.Items).Connection.WriteLn(MainForm.AccountListBox.Items.CommaText);
end;
except
TIdPeerThread(List.Items).Stop;
BadClientCount:=BadClientCount+1;
end;
{
Flag:=True;
while Flag do
begin
Flag:=False;
for i:=0 to List.Count-1 do
begin
if TIdPeerThread(List.Items).Stopped then
begin
try
TIdPeerThread(List.Items).Connection.Disconnect;
TIdPeerThread(List.Items).Terminate;
TIdPeerThread(List.Items).Free;
except
end;
Flag:=True;
abort;
end
end;
end;
}
finally
tcpServer.Threads.UnlockList;
end;
BroadcastCS.Leave;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
{
if (Application.MessageBox('您真的希望退出本系统吗 ?','提示',
MB_DEFBUTTON2+MB_ICONQUESTION+MB_YESNO) = mrYES) then CanClose:=true
else CanClose:=false;
}

end;

procedure TMainForm.ClearBtnClick(Sender: TObject);
begin
if (Application.MessageBox('您真的希望清除日志记录吗 ?','提示',
MB_DEFBUTTON2+MB_ICONQUESTION+MB_YESNO) = mrYES) then
begin
LogMemo.Lines.Clear;
RecordLabel.Caption:='记录总数 '+IntToStr(LogMemo.Lines.Count)+' 条 ';
end;
end;

procedure TMainForm.TxtOutBtnClick(Sender: TObject);
begin
with SaveDialogMain do
begin
DefaultExt := 'txt';
Filter := 'txt 文件 (*.txt)|*.txt';
FileName := DateToStr(Now)+'ERP日志';
if Execute then
begin
LogMemo.Lines.SaveToFile(FileName);
end;
end;
end;

procedure TMainForm.TxtINBtnClick(Sender: TObject);
begin
with OpenDialogMain do
begin
DefaultExt := 'txt';
Filter := 'txt 文件 (*.txt)|*.txt';
FileName := DateToStr(Now)+'ERP日志';
if Execute then
begin
LogMemo.Lines.LoadFromFile(FileName);
end;
end;
end;

{
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
var msgCommBlock:TCommBlock;
i:integer;
begin
msgCommBlock.Command:='@CLOSE';
msgCommBlock.CommDateTime:=now;
msgCommBlock.Msg:='关闭系统日志';
msgCommBlock.SendMsgUserName:='系统消息';
BroadcastMessage(msgCommBlock);
for i:=0 to 20 do
begin
try
TCPServer.Active:=false;
except
end;
if not TCPServer.Active then abort;
sleep(50);
end;
Clients.Free;
end;
}


procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseLog;
Clients.Free;
ExitProcess(0);
end;


procedure TMainForm.SendMessageActionExecute(Sender: TObject);
var Client:TSimpleClient;
begin
try
try
if SendMessageForm<>nil then
begin
SendMessageForm.Free;
SendMessageForm:=nil;
end;
except
end;
finally
SendMessageForm:=nil;
end;

Application.CreateForm(TSendMessageForm,SendMessageForm);
SendMessageForm.Visible:=False;
try
try
if (SendMessageForm.ShowModal=mrOK) then
begin
SendMessageForm.MsgMemo.Lines.CommaText:=trim(SendMessageForm.MsgMemo.Lines.CommaText);
if SendMessageForm.MsgMemo.Lines.CommaText<>'' then
begin
if AccountListBox.ItemIndex<>-1 then
begin
Client:=Clients.Items[AccountListBox.ItemIndex];
if SendMessageForm.DialogCheckBox.Checked then
CommBlock.Command:='@DIALOG'
else CommBlock.Command:='@MESSAGE';

CommBlock.Msg:=SendMessageForm.MsgMemo.Lines.CommaText;
CommBlock.SendMsgUserName:='系统管理员';
TIdPeerThread(Client.Thread).Connection.WriteBuffer(CommBlock,SizeOf(CommBlock));
end;
end;
end;
except
end;
finally
SendMessageForm.Free;
SendMessageForm:=nil;
end;

end;

procedure TMainForm.SendMessagePopupMenuPopup(Sender: TObject);
begin
//
end;

procedure TMainForm.SendMessageAllActionExecute(Sender: TObject);
begin
//
end;

procedure TMainForm.SendRebootActionExecute(Sender: TObject);
var CommBlock:TCommBlock;
Client:TSimpleClient;
i:integer;
begin
for i:=0 to AccountListBox.Items.Count-1 do
begin
if AccountListBox.Selected then
begin
Client:=Clients.Items[AccountListBox.ItemIndex];
CommBlock.Command:='@REBOOT';
CommBlock.Msg:='系统重新启动消息';
CommBlock.SendMsgUserName:='系统管理员';
TIdPeerThread(Client.Thread).Connection.WriteBuffer(CommBlock,SizeOf(CommBlock));
end;
end;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
FreeAndNil(OnConnectCS);
FreeAndNil(OnDisConnectCS);
FreeAndNil(OnAddCS);
FreeAndNil(ConnectCS);
FreeAndNil(DisConnectCS);
FreeAndNil(UpdateListCS);
FreeAndNil(BroadcastCS);
end;

procedure TMainForm.OnConnect;
begin
OnConnectCS.Enter;
LogMemo.Lines.Add('['+DateTimeToStr(now)+']登陆: '+
CommBlock.ComputerName+', '+
CommBlock.ComputerIP+', '+
IntToStr(CommBlock.ComputerPort)
);
RecordLabel.Caption:='记录总数 '+IntToStr(LogMemo.Lines.Count)+' 条, '+
'BadClientCount='+IntToStr(BadClientCount)+' 条';

OnConnectCS.Leave;
end;

procedure TMainForm.OnDisConnect;
begin
OnDisConnectCS.Enter;
LogMemo.Lines.Add('['+DateTimeToStr(now)+']注销: '+
CommBlock.ComputerName+', '+
CommBlock.ComputerIP+', '+
IntToStr(CommBlock.ComputerPort)
);
RecordLabel.Caption:='记录总数 '+IntToStr(LogMemo.Lines.Count)+' 条, '+
'BadClientCount='+IntToStr(BadClientCount)+' 条';

OnDisConnectCS.Leave;
end;

procedure TMainForm.OnAdd;
begin
OnAddCS.Enter;
LogMemo.Lines.Add('['+DateTimeToStr(now)+']操作: '+
CommBlock.ComputerName+', '+
CommBlock.ComputerIP+', '+
IntToStr(CommBlock.ComputerPort)+', '+
CommBlock.Msg
);
RecordLabel.Caption:='记录总数 '+IntToStr(LogMemo.Lines.Count)+' 条, '+
'BadClientCount='+IntToStr(BadClientCount)+' 条';
OnAddCS.Leave;
end;

procedure TMainForm.ActiveBtnClick(Sender: TObject);
begin
ActiveLog;
end;

procedure TMainForm.CloseBtnClick(Sender: TObject);
begin
CloseLog;
end;

end.
 
接受答案了.
 
那不可以在刚运行程序时就把所有以前可能打开的东西都清理一下，然后再监听和连接的吗……
 
您必须登录或注册才可回复。

Similar threads

Ray
[转]终于可以发布Delphi下收点OSGI精髓皮毛而设计的插件框架WisdomPluginFramework
回复
4
查看
4K
chlkuei
C
S
INDY控件封装了代理功能，不知道怎么使用？？？IDTCPSERVER IDTCPCLIENT(0分)
回复
1
查看
162
lisom
L
W
用indy的idtcpserver及idtcpclient是的问题(200分)
回复
5
查看
221
whitelion
W
L
socket 服务器出错！(50分)
回复
1
查看
147
sxd781017
S
C
socket问题(100分)
回复
4
查看
192
张无忌
张
后退
顶部