type
TCommBlock = record // the Communication Block used in both parts (Server+Client)
Command,
MyUserName, // the sender of the message
Msg, // the message itself
ReceiverName: string[100]; // name of receiver
end;
//上面是定义的消息块
//下面是程序
{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence }
{ Team Coherence is Copyright 2002 by Quality Software Components }
{ }
{ For further information / comments, visit our WEB site at }
{ http://www.TeamCoherence.com }
{**********************************************************************}
{}
{ $Log: 110641: ServerFrmMainUnit.pas
{
{ Rev 1.0 25/10/2004 23:14:14 ANeillans Version: 9.0.17
{ Verified
}
{-----------------------------------------------------------------------------
Demo Name: ServerFrmMainUnit
Author: Helge Jung (helge@eco-logic-software.de)
Copyright: Indy Pit Crew
Purpose:
History: Improvements supplied by: Enver ALTIN
-----------------------------------------------------------------------------
Notes:
Demonstration on how to use TIdTCPServer and TIdTCPClient
with using Threads and WriteBuffer/ReadBuffer
Verified:
Indy 9:
D7: 25th Oct 2004 by Andy Neillans
}
type
PClient = ^TClient;
TClient = record // Object holding data of client (see events)
DNS : String[20]; { Hostname }
Connected, { Time of connect }
LastAction : TDateTime; { Time of last transaction }
Thread : Pointer; { Pointer to thread }
end;
begin
if not AThread.Terminated and AThread.Connection.Connected then
begin
AThread.Connection.ReadBuffer (CommBlock, SizeOf (CommBlock));
ActClient := PClient(AThread.Data);
ActClient.LastAction := Now; // update the time of last action
if (CommBlock.Command = 'MESSAGE') or (CommBlock.Command = 'DIALOG') then
begin // 'MESSAGE': A message was send - forward or broadcast it
// 'DIALOG': A dialog-window shall popup on the recipient's screen
// it's the same code for both commands...
if CommBlock.ReceiverName = '' then
begin // no recipient given - broadcast
Protocol.Lines.Add (TimeToStr(Time)+' Broadcasting '+CommBlock.Command+': "'+CommBlock.Msg+'"');
NewCommBlock := CommBlock; // nothing to change ;-))
with Clients.LockList do
try
for i := 0 to Count-1 do // iterate through client-list
begin
RecClient := Items[i]; // get client-object
RecThread := RecClient.Thread; // get client-thread out of it
RecThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), True); // send the stuff
end;
finally
Clients.UnlockList;
end;
end
else
begin // receiver given - search him and send it to him
NewCommBlock := CommBlock; // again: nothing to change ;-))
Protocol.Lines.Add(TimeToStr(Time)+' Sending '+CommBlock.Command+' to "'+CommBlock.ReceiverName+'": "'+CommBlock.Msg+'"');
with Clients.LockList do
try
for i := 0 to Count-1 do
begin
RecClient:=Items[i];
if RecClient.DNS=CommBlock.ReceiverName then // we don't have a login function so we have to use the DNS (Hostname)
begin
RecThread:=RecClient.Thread;
RecThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), True);
end;
end;
finally
Clients.UnlockList;
end;
end;
end
else
begin // unknown command given
Protocol.Lines.Add (TimeToStr(Time)+' Unknown command from "'+CommBlock.MyUserName+'": '+CommBlock.Command);
NewCommBlock.Command := 'DIALOG'; // the message should popup on the client's screen
NewCommBlock.MyUserName := '[Server]'; // the server's username
NewCommBlock.Msg := 'I don''t understand your command: "'+CommBlock.Command+'"'; // the message to show
NewCommBlock.ReceiverName := '[return-to-sender]'; // unnecessary
AThread.Connection.WriteBuffer (NewCommBlock, SizeOf (NewCommBlock), true); // and there it goes...
end;
end;
end;
procedure TServerFrmMain.ServerDisconnect(AThread: TIdPeerThread);
var
ActClient: PClient;
begin
ActClient := PClient(AThread.Data);
Protocol.Lines.Add (TimeToStr(Time)+' Disconnect from "'+ActClient^.DNS+'"');
try
Clients.LockList.Remove(ActClient);
finally
Clients.UnlockList;
end;
FreeMem(ActClient);
AThread.Data := nil;
end;
procedure TServerFrmMain.FormCreate(Sender: TObject);
begin
Clients := TThreadList.Create;
end;
procedure TServerFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Server.Active := False;
Clients.Free;
end;