請問各位大大： 當Client啟動後，如何得知有多少Server連在線上 |
|
尚未結案
|
|
steven_df2008
一般會員   發表：8 回覆：15 積分：4 註冊：2003-10-22 發送簡訊給我 |
|
|
Chance36
版主  發表：31 回覆：1033 積分：792 註冊：2002-12-31 發送簡訊給我 |
引言: 當Client啟動後，如何得知有多少Server連在線上?steven_df2008 你好 網路程式,基本上是一個[請求/回應]的Client/Server架構程式,由Client端提出請求的需求,由Server端來回應CLient的請求，所以要達到你的需求，必須有一個Server有提供所有連線Server列表的功能,因此只要有個Server有提供此功能，就可以在CLient啟動時，向該Server請求[所有連線Server的列表]，然後你就可以得知[有多少Server連在線上]。 然而，真正問題在這個Server要如何提供這個服務? 1.有多少Server連在線上?：什麼樣的Server?WebServer、FTPServer、MailServer.....或是自行開發的TCPServer? 2.若許可用逐個IP用ping IP再偵測某個Port的方式來確定連線Server再予以總,總要知道那個網域或IP區段的Server ,那時效與正確性呢? 3.或是如許多遊戲所使用的技術一般，設置一個總Server及數個Proxy Server,然後每個遊戲Server啟動後皆須向這個總Server或Proxy Server註冊，並隨時報告本身的健康狀態，如此總Server即可隨時得知所有Server的連線列表,再由總Server發佈到各Proxy Server 之後就提供這個服務了。這個方法僅針對自行發的Server有效，或有提供相關功能API的server才可行。 |
|
steven_df2008
一般會員 發表：8 回覆：15 積分：4 註冊：2003-10-22 發送簡訊給我 |
真的對不起哦，這麼久都沒回復。
應該算是TCPServer.
您所說的“必須有一個Server有提供所有連線Server列表的功能,因此只要有個Server有提供此功能，就可以在CLient啟動時，向該Server請求[所有連線Server的列表]”，如果這樣的話這個Server該如何做，client又如何向他請求？
我這有個想法是否可行？
server端以廣播方式 UDP--據說它不區分Clinet and Server.
Use UDP to tell the client IP address or PC name.
當client 得知IP address後,使用TCPclient and TCPserver 進行通訊。
如果可行的話，請問如何實現？
謝謝! 多來一次KTOP多學一些Delphi
|
|
Chance36
版主 發表：31 回覆：1033 積分：792 註冊：2002-12-31 發送簡訊給我 |
steven_df2008 你好 你提到用廣播的方式,基本上應該可以達到你要的功能,但是我個人覺得有幾點要考慮的問題 1.每個Server啟動後必須定時送出廣播的訊息,不管Client端是否有用到(或啟動)都一樣,那麼要隔多久才送出一次呢?10Secs、100Secs..太長會失去其意義,太短則Server的負荷是否會過重(雖說它可能是一瞬間的事)或做了太多無謂的事(浪費)。 2.Server的廣播即有間隔,Client端就有可能在廣播後才上線,卻收不到Server的訊息,必須等到下一次的廣播才會知道該Server的存在 3.採用 udp廣播方式,好像不能跨網域(同一個ip的區段),這部份我也不是很清楚 總之，UDP廣播方式，我沒實作過，前述三點是否真是如此，我不敢肯定 ps:如果用我說的方法,確實是複雜了一點,滿像三層式架構(或說根本就是三層式架構),實作起來是有點困難，但我的想法是眼光放大點，從大處著眼，小處著手，對於系統的擴充性及延展性才有幫助,不會造成未來的遺憾甚至於變成未來災難都有可能。 以上幾點意見供你參考 發表人 - chance36 於 2004/04/15 00:08:15
|
|
steven_df2008
一般會員 發表：8 回覆：15 積分：4 註冊：2003-10-22 發送簡訊給我 |
在indy的主頁上download了一chat例程，我想這個應該和QQ差不多吧。一個Server下面若干的client登錄後，相互進行通訊。Server那有一個list,然後client方則向server提出列表請求。
那個程序整體思路可以明白，但有些細節部分不是很了解。
server部分：
(***********************************************************)
(** Chat room demo **)
(***********************************************************)
(** Created by: Jeremy Darling webmaster@eonclash.com **)
(** Created on: Sept. 21st 2000 **)
(** Origional Indy Version: 8.005B **)
(***********************************************************)
(** Updates **)
(***********************************************************)
(** Sept. 25th 2000 Jeremy Darling **)
(** Added functionality that is commonly wanted in a **)
(** chat program. **)
(** 1) Added send client list on request **)
(** 2) Added ability to add system commands **)
(** **)
(***********************************************************) unit MainForm; interface uses
Windows, Messages, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls,
ExtCtrls, ToolWin, ImgList, Spin, Menus, SysUtils, Classes, IdBaseComponent,
IdComponent, IdTCPServer, IdThreadMgr, IdThreadMgrDefault; type
TSimpleClient = class(TObject)
DNS,
Name : String;
ListLink : Integer;
Thread : Pointer;
end; TfrmMain = class(TForm)
StatusBar1: TStatusBar;
Panel1: TPanel;
Panel2: TPanel;
lbClients: TListBox;
PageControl1: TPageControl;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
ImageList1: TImageList;
Label3: TLabel;
lblDNS: TLabel;
tcpServer: TIdTCPServer;
lblSocketVer: TLabel;
Label5: TLabel;
Label4: TLabel;
seBinding: TSpinEdit;
IdThreadMgrDefault1: TIdThreadMgrDefault;
Label6: TLabel;
memEntry: TMemo;
Label7: TLabel;
memEMotes: TMemo;
Label8: TLabel;
Label9: TLabel;
lblClientName: TLabel;
lblClientDNS: TLabel;
puMemoMenu: TPopupMenu;
Savetofile1: TMenuItem;
Loadfromfile1: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
ToolBar1: TToolBar;
btnServerUp: TToolButton;
ToolButton1: TToolButton;
btnKillClient: TToolButton;
btnClients: TToolButton;
btnPM: TToolButton;
Label12: TLabel;
edSyopName: TEdit;
procedure btnServerUpClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure seBindingChange(Sender: TObject);
procedure tcpServerConnect(AThread: TIdPeerThread);
procedure tcpServerDisconnect(AThread: TIdPeerThread);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Savetofile1Click(Sender: TObject);
procedure Loadfromfile1Click(Sender: TObject);
procedure tcpServerExecute(AThread: TIdPeerThread);
procedure btnClientsClick(Sender: TObject);
procedure btnPMClick(Sender: TObject);
procedure btnKillClientClick(Sender: TObject);
procedure lbClientsClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Clients : TList;
procedure UpdateBindings;
procedure UpdateClientList;
procedure BroadcastMessage( WhoFrom, TheMessage : String );
end; var
frmMain: TfrmMain; implementation {$R *.DFM} uses
IdSocketHandle; // This is where the IdSocketHandle class is defined. procedure TfrmMain.UpdateBindings;
var
Binding : TIdSocketHandle;
begin
{ Set the TIdTCPServer's port to the chosen value }
tcpServer.DefaultPort := seBinding.Value;
{ 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 := seBinding.Value;
end; procedure TfrmMain.btnServerUpClick(Sender: TObject);
begin
try
{ Check to see if the server is online or offline }
tcpServer.Active := not tcpServer.Active;
btnServerUp.Down := tcpServer.Active;
if btnServerUp.Down then
begin
{ Server is online }
btnServerUp.ImageIndex := 1;
btnServerUp.Hint := 'Shut down server';
end
else
begin
{ Server is offline }
btnServerUp.ImageIndex := 0;
btnServerUp.Hint := 'Start up server';
end;
{ Setup GUI buttons }
btnClients.Enabled:= btnServerUp.Down;
seBinding.Enabled := not btnServerUp.Down;
edSyopName.Enabled:= not btnServerUp.Down;
except
{ If we have a problem then rest things }
btnServerUp.Down := false;
seBinding.Enabled := not btnServerUp.Down;
btnClients.Enabled:= btnServerUp.Down;
edSyopName.Enabled:= not btnServerUp.Down;
end;
end; procedure TfrmMain.FormCreate(Sender: TObject);
begin
{ Initalize our clients list }
Clients := TList.Create;
{ Call updatebindings so that the servers bindings are correct }
UpdateBindings;
{ Get the local DNS entry for this computer }
lblDNS.Caption := tcpServer.LocalName;
{ Display the current version of indy running on the system }
lblSocketVer.Caption := tcpServer.Version;
end; procedure TfrmMain.seBindingChange(Sender: TObject);
begin
UpdateBindings;
end; procedure TfrmMain.tcpServerConnect(AThread: TIdPeerThread);
var
Client : TSimpleClient;
begin
{ Send a welcome message, and prompt for the users name }
AThread.Connection.WriteLn('ISD Connection Established...');
AThread.Connection.WriteLn('Please send valid login sequence...');
AThread.Connection.WriteLn('Your Name:');
{ Create a client object }
Client := TSimpleClient.Create;
{ Assign its default values }
Client.DNS := AThread.Connection.LocalName;
Client.Name := 'Logging In';
Client.ListLink := lbClients.Items.Count;
{ Assign the thread to it for ease in finding }
Client.Thread := AThread;
{ Add to our clients list box }
lbClients.Items.Add(Client.Name);
{ Assign it to the thread so we can identify it later }
AThread.Data := Client;
{ Add it to the clients list }
Clients.Add(Client);
end; procedure TfrmMain.tcpServerDisconnect(AThread:TIdPeerThread);
var
Client : TSimpleClient;
begin
{ Retrieve Client Record from Data pointer }
Client := Pointer(AThread.Data);
{ Remove Client from the Clients TList }
Clients.Delete(Client.ListLink);
{ Remove Client from the Clients List Box }
lbClients.Items.Delete(lbClients.Items.IndexOf(Client.Name));
BroadcastMessage('System', Client.Name + ' has left the chat.');
{ Free the Client object }
Client.Free;
AThread.Data := nil; end; procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (Clients.Count > 0) and
(tcpServer.Active) then
begin
Action := caNone;
ShowMessage('Can''t close CBServ while server is online.');
end
else
Clients.Free;
end; procedure TfrmMain.Savetofile1Click(Sender: TObject);
begin
if not (puMemoMenu.PopupComponent is TMemo) then
exit; if SaveDialog1.Execute then
begin
TMemo(puMemoMenu.PopupComponent).Lines.SaveToFile(SaveDialog1.FileName);
end;
end; procedure TfrmMain.Loadfromfile1Click(Sender: TObject);
begin
if not (puMemoMenu.PopupComponent is TMemo) then
exit; if OpenDialog1.Execute then
begin
TMemo(puMemoMenu.PopupComponent).Lines.LoadFromFile(OpenDialog1.FileName);
end;
end; procedure TfrmMain.UpdateClientList;
var
Count : Integer;
begin
{ Loop through all the clients connected to the system and set their names }
for Count := 0 to lbClients.Items.Count -1 do
if Count < Clients.Count then
lbClients.Items.Strings[Count] := TSimpleClient(Clients.Items[Count]).Name;
end; procedure TfrmMain.tcpServerExecute(AThread: TIdPeerThread);
var
Client : TSimpleClient;
Com, // System command
Msg : String;
begin
{ Get the text sent from the client }
Msg := AThread.Connection.ReadLn;
{ Get the clients package info }
Client := Pointer(AThread.Data);
{ Check to see if the clients name has been assigned yet }
if Client.Name = 'Logging In' then
begin
{ if not, assign the name and announce the client }
Client.Name := Msg;
UpdateClientList;
BroadcastMessage('System', Msg + ' has just logged in.');
AThread.Connection.WriteLn(memEntry.Lines.Text);
end
else
{ If name is set, then send the message }
if Msg[1] <> '@' then
begin
{ Not a system command }
BroadcastMessage(Client.Name, Msg);
end
else
begin
{ System command }
Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2)));
Msg := UpperCase(Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg))));
if Com = 'CLIENTS' then
AThread.Connection.WriteLn( '@' + 'clients:' +
lbClients.Items.CommaText);
end;
end; procedure TfrmMain.BroadcastMessage( WhoFrom, TheMessage : String );
var
Count: Integer;
List : TList;
EMote,
Msg : String;
begin
Msg := Trim(TheMessage); EMote := Trim(memEMotes.Lines.Values[Msg]); if WhoFrom <> 'System' then
Msg := WhoFrom + ': ' + Msg; if EMote <> '' then
Msg := Format(Trim(EMote), [WhoFrom]); List := tcpServer.Threads.LockList;
try
for Count := 0 to List.Count -1 do
try
TIdPeerThread(List.Items[Count]).Connection.WriteLn(Msg);
except
TIdPeerThread(List.Items[Count]).Stop;
end;
finally
tcpServer.Threads.UnlockList;
end;
end; procedure TfrmMain.btnClientsClick(Sender: TObject);
begin
UpdateClientList;
end; procedure TfrmMain.btnPMClick(Sender: TObject);
var
Msg : String;
Client : TSimpleClient;
begin
Msg := InputBox('Private Message', 'What is the message', '');
Msg := Trim(Msg);
Msg := edSyopName.Text + '> ' + Msg;
if (Msg <> '') and
(lbClients.ItemIndex <> -1) then
begin
Client := Clients.Items[lbClients.ItemIndex];
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
end;
end; procedure TfrmMain.btnKillClientClick(Sender: TObject);
var
Msg : String;
Client : TSimpleClient;
begin
Msg := InputBox('Disconnect message', 'Enter a reason for the disconnect', '');
Msg := Trim(Msg);
Msg := edSyopName.Text + '> ' + Msg;
if (Msg <> '') and
(lbClients.ItemIndex <> -1) then
begin
Client := Clients.Items[lbClients.ItemIndex];
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
TIdPeerThread(Client.Thread).Connection.Disconnect;
Clients.Delete(lbClients.ItemIndex);
lbClients.Items.Delete(lbClients.ItemIndex);
end;
end; procedure TfrmMain.lbClientsClick(Sender: TObject);
var
Client : TSimpleClient;
begin
btnPM.Enabled := lbClients.ItemIndex <> -1;
btnKillClient.Enabled := btnPM.Enabled;
if lbClients.ItemIndex = -1 then
exit;
Client := Clients.Items[lbClients.ItemIndex];
lblClientName.Caption := Client.Name;
lblClientDNS.Caption := Client.DNS;
end; end. Client部分： unit MainForm; interface uses
Windows, Messages, Graphics, Controls, Forms, Dialogs, ToolWin, ComCtrls,
Menus, Buttons, Spin, SysUtils, Classes, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, ExtCtrls, StdCtrls; type
TForm1 = class(TForm)
Label1: TLabel;
edUserName: TEdit;
Label2: TLabel;
edServer: TEdit;
Label3: TLabel;
lbClients: TListBox;
Label4: TLabel;
memLines: TMemo;
Label5: TLabel;
edMessage: TEdit;
SpeedButton1: TSpeedButton;
IdTCPClient1: TIdTCPClient;
Timer1: TTimer;
Label6: TLabel;
sePort: TSpinEdit;
Button1: TButton;
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure IdTCPClient1Connected(Sender: TObject);
procedure edMessageKeyPress(Sender: TObject; var Key: Char);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1; implementation {$R *.DFM} procedure TForm1.FormShow(Sender: TObject);
begin
width := width + 1;
end; procedure TForm1.Timer1Timer(Sender: TObject);
var
Com,
Msg : String;
begin
if not IdTcpClient1.Connected then
exit; Msg := IdTCPClient1.ReadLn('', 5); if Msg <> '' then
if Msg[1] <> '@' then
begin
{ Not a system command }
memLines.Lines.Add(Msg);
end
else
begin
{ System command }
Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2)));
Msg := UpperCase(Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg))));
if Com = 'CLIENTS' then
lbClients.Items.CommaText := Msg;
end; end; procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if (edUserName.Text <> '') and
(edServer.Text <> '') and
SpeedButton1.Down then
begin
IdTCPClient1.Host := edServer.Text;
IdTCPClient1.Port := sePort.Value;
if SpeedButton1.Down then
IdTCPClient1.Connect;
end
else
begin
if (edUserName.Text = '') or
(edServer.Text = '') then
ShowMessage('You must put in a User Name and server name to connect.');
SpeedButton1.Down := false;
end;
end; procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
IdTCPClient1.WriteLn(edUserName.Text);
end; procedure TForm1.edMessageKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
begin
IdTCPClient1.WriteLn(edMessage.Text);
edMessage.Text := '';
end;
end; procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPClient1.WriteLn('@' + 'CLIENTS:REQUEST');
end; end.
|
|
steven_df2008
一般會員 發表：8 回覆：15 積分：4 註冊：2003-10-22 發送簡訊給我 |
在indy的主頁上download了一chat例程，我想這個應該和QQ差不多吧。一個Server下面若干的client登錄後，相互進行通訊。Server那有一個list,然後client方則向server提出列表請求。
那個程序整體思路可以明白，但有些細節部分不是很了解。
server部分：
(***********************************************************)
(** Chat room demo **)
(***********************************************************)
(** Created by: Jeremy Darling webmaster@eonclash.com **)
(** Created on: Sept. 21st 2000 **)
(** Origional Indy Version: 8.005B **)
(***********************************************************)
(** Updates **)
(***********************************************************)
(** Sept. 25th 2000 Jeremy Darling **)
(** Added functionality that is commonly wanted in a **)
(** chat program. **)
(** 1) Added send client list on request **)
(** 2) Added ability to add system commands **)
(** **)
(***********************************************************) unit MainForm; interface uses
Windows, Messages, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls,
ExtCtrls, ToolWin, ImgList, Spin, Menus, SysUtils, Classes, IdBaseComponent,
IdComponent, IdTCPServer, IdThreadMgr, IdThreadMgrDefault; type
TSimpleClient = class(TObject)
DNS,
Name : String;
ListLink : Integer;
Thread : Pointer;
end; TfrmMain = class(TForm)
StatusBar1: TStatusBar;
Panel1: TPanel;
Panel2: TPanel;
lbClients: TListBox;
PageControl1: TPageControl;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
ImageList1: TImageList;
Label3: TLabel;
lblDNS: TLabel;
tcpServer: TIdTCPServer;
lblSocketVer: TLabel;
Label5: TLabel;
Label4: TLabel;
seBinding: TSpinEdit;
IdThreadMgrDefault1: TIdThreadMgrDefault;
Label6: TLabel;
memEntry: TMemo;
Label7: TLabel;
memEMotes: TMemo;
Label8: TLabel;
Label9: TLabel;
lblClientName: TLabel;
lblClientDNS: TLabel;
puMemoMenu: TPopupMenu;
Savetofile1: TMenuItem;
Loadfromfile1: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
ToolBar1: TToolBar;
btnServerUp: TToolButton;
ToolButton1: TToolButton;
btnKillClient: TToolButton;
btnClients: TToolButton;
btnPM: TToolButton;
Label12: TLabel;
edSyopName: TEdit;
procedure btnServerUpClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure seBindingChange(Sender: TObject);
procedure tcpServerConnect(AThread: TIdPeerThread);
procedure tcpServerDisconnect(AThread: TIdPeerThread);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Savetofile1Click(Sender: TObject);
procedure Loadfromfile1Click(Sender: TObject);
procedure tcpServerExecute(AThread: TIdPeerThread);
procedure btnClientsClick(Sender: TObject);
procedure btnPMClick(Sender: TObject);
procedure btnKillClientClick(Sender: TObject);
procedure lbClientsClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Clients : TList;
procedure UpdateBindings;
procedure UpdateClientList;
procedure BroadcastMessage( WhoFrom, TheMessage : String );
end; var
frmMain: TfrmMain; implementation {$R *.DFM} uses
IdSocketHandle; // This is where the IdSocketHandle class is defined. procedure TfrmMain.UpdateBindings;
var
Binding : TIdSocketHandle;
begin
{ Set the TIdTCPServer's port to the chosen value }
tcpServer.DefaultPort := seBinding.Value;
{ 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 := seBinding.Value;
end; procedure TfrmMain.btnServerUpClick(Sender: TObject);
begin
try
{ Check to see if the server is online or offline }
tcpServer.Active := not tcpServer.Active;
btnServerUp.Down := tcpServer.Active;
if btnServerUp.Down then
begin
{ Server is online }
btnServerUp.ImageIndex := 1;
btnServerUp.Hint := 'Shut down server';
end
else
begin
{ Server is offline }
btnServerUp.ImageIndex := 0;
btnServerUp.Hint := 'Start up server';
end;
{ Setup GUI buttons }
btnClients.Enabled:= btnServerUp.Down;
seBinding.Enabled := not btnServerUp.Down;
edSyopName.Enabled:= not btnServerUp.Down;
except
{ If we have a problem then rest things }
btnServerUp.Down := false;
seBinding.Enabled := not btnServerUp.Down;
btnClients.Enabled:= btnServerUp.Down;
edSyopName.Enabled:= not btnServerUp.Down;
end;
end; procedure TfrmMain.FormCreate(Sender: TObject);
begin
{ Initalize our clients list }
Clients := TList.Create;
{ Call updatebindings so that the servers bindings are correct }
UpdateBindings;
{ Get the local DNS entry for this computer }
lblDNS.Caption := tcpServer.LocalName;
{ Display the current version of indy running on the system }
lblSocketVer.Caption := tcpServer.Version;
end; procedure TfrmMain.seBindingChange(Sender: TObject);
begin
UpdateBindings;
end; procedure TfrmMain.tcpServerConnect(AThread: TIdPeerThread);
var
Client : TSimpleClient;
begin
{ Send a welcome message, and prompt for the users name }
AThread.Connection.WriteLn('ISD Connection Established...');
AThread.Connection.WriteLn('Please send valid login sequence...');
AThread.Connection.WriteLn('Your Name:');
{ Create a client object }
Client := TSimpleClient.Create;
{ Assign its default values }
Client.DNS := AThread.Connection.LocalName;
Client.Name := 'Logging In';
Client.ListLink := lbClients.Items.Count;
{ Assign the thread to it for ease in finding }
Client.Thread := AThread;
{ Add to our clients list box }
lbClients.Items.Add(Client.Name);
{ Assign it to the thread so we can identify it later }
AThread.Data := Client;
{ Add it to the clients list }
Clients.Add(Client);
end; procedure TfrmMain.tcpServerDisconnect(AThread:TIdPeerThread);
var
Client : TSimpleClient;
begin
{ Retrieve Client Record from Data pointer }
Client := Pointer(AThread.Data);
{ Remove Client from the Clients TList }
Clients.Delete(Client.ListLink);
{ Remove Client from the Clients List Box }
lbClients.Items.Delete(lbClients.Items.IndexOf(Client.Name));
BroadcastMessage('System', Client.Name + ' has left the chat.');
{ Free the Client object }
Client.Free;
AThread.Data := nil; end; procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (Clients.Count > 0) and
(tcpServer.Active) then
begin
Action := caNone;
ShowMessage('Can''t close CBServ while server is online.');
end
else
Clients.Free;
end; procedure TfrmMain.Savetofile1Click(Sender: TObject);
begin
if not (puMemoMenu.PopupComponent is TMemo) then
exit; if SaveDialog1.Execute then
begin
TMemo(puMemoMenu.PopupComponent).Lines.SaveToFile(SaveDialog1.FileName);
end;
end; procedure TfrmMain.Loadfromfile1Click(Sender: TObject);
begin
if not (puMemoMenu.PopupComponent is TMemo) then
exit; if OpenDialog1.Execute then
begin
TMemo(puMemoMenu.PopupComponent).Lines.LoadFromFile(OpenDialog1.FileName);
end;
end; procedure TfrmMain.UpdateClientList;
var
Count : Integer;
begin
{ Loop through all the clients connected to the system and set their names }
for Count := 0 to lbClients.Items.Count -1 do
if Count < Clients.Count then
lbClients.Items.Strings[Count] := TSimpleClient(Clients.Items[Count]).Name;
end; procedure TfrmMain.tcpServerExecute(AThread: TIdPeerThread);
var
Client : TSimpleClient;
Com, // System command
Msg : String;
begin
{ Get the text sent from the client }
Msg := AThread.Connection.ReadLn;
{ Get the clients package info }
Client := Pointer(AThread.Data);
{ Check to see if the clients name has been assigned yet }
if Client.Name = 'Logging In' then
begin
{ if not, assign the name and announce the client }
Client.Name := Msg;
UpdateClientList;
BroadcastMessage('System', Msg + ' has just logged in.');
AThread.Connection.WriteLn(memEntry.Lines.Text);
end
else
{ If name is set, then send the message }
if Msg[1] <> '@' then
begin
{ Not a system command }
BroadcastMessage(Client.Name, Msg);
end
else
begin
{ System command }
Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2)));
Msg := UpperCase(Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg))));
if Com = 'CLIENTS' then
AThread.Connection.WriteLn( '@' + 'clients:' +
lbClients.Items.CommaText);
end;
end; procedure TfrmMain.BroadcastMessage( WhoFrom, TheMessage : String );
var
Count: Integer;
List : TList;
EMote,
Msg : String;
begin
Msg := Trim(TheMessage); EMote := Trim(memEMotes.Lines.Values[Msg]); if WhoFrom <> 'System' then
Msg := WhoFrom + ': ' + Msg; if EMote <> '' then
Msg := Format(Trim(EMote), [WhoFrom]); List := tcpServer.Threads.LockList;
try
for Count := 0 to List.Count -1 do
try
TIdPeerThread(List.Items[Count]).Connection.WriteLn(Msg);
except
TIdPeerThread(List.Items[Count]).Stop;
end;
finally
tcpServer.Threads.UnlockList;
end;
end; procedure TfrmMain.btnClientsClick(Sender: TObject);
begin
UpdateClientList;
end; procedure TfrmMain.btnPMClick(Sender: TObject);
var
Msg : String;
Client : TSimpleClient;
begin
Msg := InputBox('Private Message', 'What is the message', '');
Msg := Trim(Msg);
Msg := edSyopName.Text + '> ' + Msg;
if (Msg <> '') and
(lbClients.ItemIndex <> -1) then
begin
Client := Clients.Items[lbClients.ItemIndex];
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
end;
end; procedure TfrmMain.btnKillClientClick(Sender: TObject);
var
Msg : String;
Client : TSimpleClient;
begin
Msg := InputBox('Disconnect message', 'Enter a reason for the disconnect', '');
Msg := Trim(Msg);
Msg := edSyopName.Text + '> ' + Msg;
if (Msg <> '') and
(lbClients.ItemIndex <> -1) then
begin
Client := Clients.Items[lbClients.ItemIndex];
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
TIdPeerThread(Client.Thread).Connection.Disconnect;
Clients.Delete(lbClients.ItemIndex);
lbClients.Items.Delete(lbClients.ItemIndex);
end;
end; procedure TfrmMain.lbClientsClick(Sender: TObject);
var
Client : TSimpleClient;
begin
btnPM.Enabled := lbClients.ItemIndex <> -1;
btnKillClient.Enabled := btnPM.Enabled;
if lbClients.ItemIndex = -1 then
exit;
Client := Clients.Items[lbClients.ItemIndex];
lblClientName.Caption := Client.Name;
lblClientDNS.Caption := Client.DNS;
end; end. Client部分： unit MainForm; interface uses
Windows, Messages, Graphics, Controls, Forms, Dialogs, ToolWin, ComCtrls,
Menus, Buttons, Spin, SysUtils, Classes, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, ExtCtrls, StdCtrls; type
TForm1 = class(TForm)
Label1: TLabel;
edUserName: TEdit;
Label2: TLabel;
edServer: TEdit;
Label3: TLabel;
lbClients: TListBox;
Label4: TLabel;
memLines: TMemo;
Label5: TLabel;
edMessage: TEdit;
SpeedButton1: TSpeedButton;
IdTCPClient1: TIdTCPClient;
Timer1: TTimer;
Label6: TLabel;
sePort: TSpinEdit;
Button1: TButton;
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure IdTCPClient1Connected(Sender: TObject);
procedure edMessageKeyPress(Sender: TObject; var Key: Char);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1; implementation {$R *.DFM} procedure TForm1.FormShow(Sender: TObject);
begin
width := width + 1;
end; procedure TForm1.Timer1Timer(Sender: TObject);
var
Com,
Msg : String;
begin
if not IdTcpClient1.Connected then
exit; Msg := IdTCPClient1.ReadLn('', 5); if Msg <> '' then
if Msg[1] <> '@' then
begin
{ Not a system command }
memLines.Lines.Add(Msg);
end
else
begin
{ System command }
Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2)));
Msg := UpperCase(Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg))));
if Com = 'CLIENTS' then
lbClients.Items.CommaText := Msg;
end; end; procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if (edUserName.Text <> '') and
(edServer.Text <> '') and
SpeedButton1.Down then
begin
IdTCPClient1.Host := edServer.Text;
IdTCPClient1.Port := sePort.Value;
if SpeedButton1.Down then
IdTCPClient1.Connect;
end
else
begin
if (edUserName.Text = '') or
(edServer.Text = '') then
ShowMessage('You must put in a User Name and server name to connect.');
SpeedButton1.Down := false;
end;
end; procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
IdTCPClient1.WriteLn(edUserName.Text);
end; procedure TForm1.edMessageKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
begin
IdTCPClient1.WriteLn(edMessage.Text);
edMessage.Text := '';
end;
end; procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPClient1.WriteLn('@' + 'CLIENTS:REQUEST');
end; end.
|
|
Chance36
版主 發表：31 回覆：1033 積分：792 註冊：2002-12-31 發送簡訊給我 |
引言:
steven_df2008 你好 由於TIdTCPServer對於每一個Client端的連線(Socket)，它會自動建立一個執行緒物件包裝起來，讓事件的程式部份可以不用管[這是那一個連線所觸發的]，而這個執行緒物件就是你所提到的物件(如上綠色的參數部份), 在程式碼中我己加上簡短說明，希望可以了解；上述紅色部份是server端管理Client的列表的鍵部份，主要就是在新的客戶端連線進來時，增加列表內容，而在客戶端離去時除去列表內容，所以客戶端的列表是由Server端的程式所掌管的。 至於你說的[IdThreadMgrDefault1]是否是線程管理，這個元件我沒用過，不敢亂說，不過以字面來看確實與執行緒的管理有關，但是使用方法我就不知了。
|
|
steven_df2008
一般會員 發表：8 回覆：15 積分：4 註冊：2003-10-22 發送簡訊給我 |
|
|
Ktop_Robot
站務副站長 發表：0 回覆：3511 積分：0 註冊：2007-04-17 發送簡訊給我 |
發表時間：2004-03-10 21:39:41
IP:66.98.xxx.xxx 未訂閱
系統時間：2024-05-11 23:01:08
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |