Обмен информацией по TCP/IP-протоколу

Server.Active := True;
Protocol.Lines.Add('=== Запуск сервера ====');

Server.Active := False;
Protocol.Lines.Add('=== Сервер остановлен====');

var
NewClient: PClient;

begin
GetMem(NewClient, SizeOf(TClient));

NewClient.DNS := AThread.Connection.LocalName;
NewClient.Connected := Now;
NewClient.LastAction := NewClient.Connected;
NewClient.Thread := AThread;

AThread.Data:=TObject(NewClient);

try
Clients.LockList.Add(NewClient);
finally
Clients.UnlockList;
end;

Protocol.Lines.Add(TimeToStr(Time)+' Соединение компьютера: "'+NewClient.DNS+'"');

end;

var
ActClient: PClient;
ConnN: integer;

begin
ActClient := PClient(AThread.Data);
Protocol.Lines.Add (TimeToStr(Time)+' Отсоединение компьютера: "'+ActClient^.DNS+'"');
try
Clients.LockList.Remove(ActClient);
finally
Clients.UnlockList;
end;
FreeMem(ActClient);
AThread.Data := nil;
end;

var
ActClient, RecClient: PClient;
CommBlock, NewCommBlock: TCommBlock;
RecThread: TIdPeerThread;
i, ConnN: Integer;
itmp: integer;

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 (RusUpperCase(CommBlock.Command) = RusUpperCase(cmRegisterComp)) then
begin
Protocol.Lines.Add(' Регистрация компьютера: '+RusUpperCase(CommBlock.ComputerName));
meConnected.Lines.Add(RusUpperCase(CommBlock.ComputerName));
RefreshConnected;
RefreshConnectedComps;
RefreshGolosProcess;
// AThread.Connection.WriteBuffer (NewCommBlock, SizeOf (NewCommBlock), true); // and there it goes...
end

// Удаление компьютера
else if (RusUpperCase(CommBlock.Command) = RusUpperCase(cmUnRegisterComp)) then
begin
Protocol.Lines.Add(' Удаление компьютера: '+RusUpperCase(CommBlock.ComputerName));ConnN

:=FindConnComp(RusUpperCase(CommBlock.ComputerName));
if ConnN<>-1
then meConnected.Lines.Delete(ConnN);

RefreshConnected;
RefreshConnectedComps;
RefreshGolosProcess;
// AThread.Connection.WriteBuffer (NewCommBlock, SizeOf (NewCommBlock), true); // and there it goes...
end

// Регистрация ответов
else if (RusUpperCase(CommBlock.Command) = RusUpperCase(cmAnswerQuest)) then
begin
if mdGolos.Locate('CompName',RusUpperCase(CommBlock.Msg),[loCaseInsensitive]) then
begin
mdGolos.Edit;
mdGolosCONN.Value:=True;
mdGolos.Post;
end;

RefreshGolosProcess;
// AThread.Connection.WriteBuffer (NewCommBlock, SizeOf (NewCommBlock), true); // and there it goes...
end

// Различные сообщения
else if (CommBlock.Command = {'MESSAGE'}cmMess) 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)+' Получение сообщения от '
+CommBlock.MyUserName+' '+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)+' Посылка '+CommBlock.Command+' к "'+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;

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
ComputerName: String[100]; // Название компьютера, посылающего сообщение
end;

IncomingMessages.Lines.Add('===Подключение к серверу===');
Client.Host:=DBInfo.IBaseServerName;
Client.Connect(10000); // in Indy < 8.1 leave the parameter away

ClientHandleThread := TClientHandleThread.Create(True);
ClientHandleThread.Cli:=Client;
ClientHandleThread.EventMest:=FEventMess;
ClientHandleThread.Str:=IncomingMessages.Lines;
ClientHandleThread.FreeOnTerminate:=True;
ClientHandleThread.Resume;

RegComp;

except
on E: Exception do MessageDlg ('Ошибка подключения:'+#13+E.Message, mtError, [mbOk], 0);
end;

if Client.Connected then
begin
ClientHandleThread.Terminate;
Client.Disconnect;
end;

TEvent_Mesto = procedure(Sender: TObject) of object;
....

TClientHandleThread = class(TThread)
private
procedure HandleInput;
public
Str: TStrings;
Cli: TIdTCPClient;
protected
procedure Execute; override;
public
CB: TCommBlock;
FEventMest: TEvent_Mesto;
published
property EventMest: TEvent_Mesto read FEventMest write FEventMest;
end;
....

var
ClientHandleThread: TClientHandleThread; // variable (type see above)
....

procedure TClientHandleThread.Execute;
begin
while not Terminated do
begin
if not Cli.Connected then
Terminate
else
try
Cli.ReadBuffer(CB, SizeOf (CB));
Synchronize(HandleInput);
except
end;
end;
end;
....

procedure TClientHandleThread.HandleInput;
begin
if Assigned(EventMest) then EventMest(Self);

// Обработка команд
if RusCompare(CB.Command,'MESSAGE') Or (RusCompare(CB.Command,cmdSendPrav)) or (RusCompare(CB.Command, cmdAskPrav)) or
(RusCompare(CB.Command,cmdNewGame)) or (RusCompare(CB.Command,cmdEndGame)) or
(RusCompare(CB.Command,cmdNewTur)) or (RusCompare(CB.Command,cmdEndTur)) or
(RusCompare(CB.Command,cmdRunShellAll)) or (RusCompare(CB.Command,cmdRunShell)) or
(RusCompare(CB.Command,cmdSendActiveWinAll)) or (RusCompare(CB.Command,cmdSendActiveWin)) or
(RusCompare(CB.Command,cmdMinimizeWin)) or (RusCompare(CB.Command,cmdMinimizeWinAll)) or
(RusCompare(CB.Command,cmdCloseWin)) or (RusCompare(CB.Command,cmdCloseWinAll)) or
(RusCompare(CB.Command,cmdSendUserName)) or (RusCompare(CB.Command,cmdSendPassword)) or
(RusCompare(CB.Command,cmdNextGolos)) or (RusCompare(CB.Command,cmdGolosSended)) or
(RusCompare(CB.Command,cmdGolosEkspert)) or (RusCompare(CB.Command,cmdRefreshInfo)) or
(RusCompare(CB.Command,cmdRefreshInfoAll)) or (RusCompare(CB.Command,cmdSendMessage)) or
(RusCompare(CB.Command,cmdSendMessageAll)) or (RusCompare(CB.Command,cmdSendMessageAdmin)) or
(RusCompare(CB.Command,cmdClearMessages)) or (RusCompare(CB.Command,cmdClearMessgesAll)) or
(RusCompare(CB.Command,cmdReconnected)) or (RusCompare(CB.Command,cmdReconnectedAll))
or (RusCompare(CB.Command,cmdSetOcenk))

or RusCompare(CB.Command, cmdRegComp)

then Str.Add (CB.MyUserName + ': ' + CB.Msg)
else
if RusCompare(CB.Command,'DIALOG') then
MessageDlg ('"'+CB.MyUserName+'" посылаем сообение:'+#13+CB.Msg, mtInformation, [mbOk], 0)
else // unknown command
MessageDlg('Команда "'+CB.Command+'" содержит это сообщение:'+#13+CB.Msg, mtError, [mbOk], 0);
end;
...

var
CommBlock : TCommBlock;

begin
inherited;

// Команда, которую мы посылаем
CommBlock.Command := RusUpperCase(EditCommand.Text);

// Названеи компьютера
CommBlock.MyUserName := Client.LocalName;

// Текст сообщения
CommBlock.Msg := EditMessage.Text;

// Название компьютера, которому мы посылаем сообщение
CommBlock.ReceiverName := EditRecipient.Text;

// Название компьютера, который посылает сообщение
CommBlock.ComputerName := RusUpperCase(Client.LocalName);

Client.WriteBuffer (CommBlock, SizeOf (CommBlock), true);
end;