unit ServerMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Web.Win.Sockets, Vcl.ExtCtrls,
Vcl.StdCtrls, Generics.Collections, System.SyncObjs;
type
TDataType = (dtConnect, dtDisconnect, dtCoords);
TCoords = record
X, Y:Integer;
end;
TData = record
DataType:TDataType;
ClientId:Integer;
Coords:TCoords;
end;
TClientState = (csConnect, csActive, csDisconnect, csRemove);
TClient = class
State:TClientState;
Id:Integer;
Coords:TCoords;
Changed:Boolean;
Socket:TCustomIpClient;
function Send(var ABuffer;ASize:Integer):Integer;
end;
TClientList = TList<TClient>;
TForm1 = class(TForm)
Memo1: TMemo;
Timer1: TTimer;
TcpServer1: TTcpServer;
procedure TcpServer1Accept(Sender: TObject; ClientSocket: TCustomIpClient);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Clients:TClientList;
Sect:TCriticalSection;
CurrentId:Integer;
function GenerateId:Integer;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function TClient.Send(var ABuffer;ASize:Integer):Integer;
var ReadReady, WriteReady, ExceptionHappened:Boolean;
begin
Result := 0;
Socket.Select(@ReadReady, @WriteReady, @ExceptionHappened);
if WriteReady and (not ExceptionHappened) then begin
Result := Socket.SendBuf(ABuffer, ASize);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CurrentId := 0;
Sect := TCriticalSection.Create;
Sect.Acquire;
Clients := TClientList.Create;
Sect.Release;
Memo1.Lines.Add('Server started: ' + String(TcpServer1.LocalHost) + ':' + String(TcpServer1.LocalPort));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Sect.Acquire;
FreeAndNil(Clients);
Sect.Release;
FreeAndNil(Sect);
end;
function TForm1.GenerateId:Integer;
begin
Result := CurrentId;
Inc(CurrentId);
end;
procedure TForm1.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var Client:TClient;Buffer:TData;
begin
Client := nil;
if Assigned(Sect) then begin
Sect.Acquire;
if Assigned(Clients) then begin
Client := TClient.Create;
Client.State := csConnect;
Client.ID := GenerateId;
Client.Socket := ClientSocket;
Clients.Add(Client);
end;
Sect.Release;
end;
if not Assigned(Client) then Exit;
while ClientSocket.WaitForData(-1) do begin
if ClientSocket.ReceiveBuf(Buffer, SizeOf(Buffer)) = SizeOf(Buffer) then begin
if Buffer.DataType = dtCoords then begin
if (Buffer.Coords.X <> Client.Coords.X) or
(Buffer.Coords.Y <> Client.Coords.Y)
then begin
if Assigned(Sect) then begin
Sect.Acquire;
Client.Coords := Buffer.Coords;
Client.Changed := True;
Sect.Release;
end;
end;
end;
end;
end;
if Assigned(Sect) then begin
Sect.Acquire;
if Client.State = csConnect then begin
Client.State := csRemove;
end
else begin
Client.State := csDisconnect;
end;
Client.Socket := nil;
Sect.Release;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var Client1, Client2:TClient;Buffer:TData;
ClientsToRemove:TClientList;Flag:Boolean;
begin
ClientsToRemove := TClientList.Create;
Sect.Acquire;
if Assigned(Clients) then begin
for Client1 in Clients do begin
FillChar(Buffer, SizeOf(Buffer), 0);
Buffer.ClientId := Client1.Id;
case Client1.State of
csConnect:begin
Buffer.DataType := dtConnect;
Flag := True;
for Client2 in Clients do begin
if Client1.Id <> Client2.Id then begin
Flag := Flag and (Client2.Send(Buffer, SizeOf(Buffer)) = SizeOf(Buffer));
end;
end;
for Client2 in Clients do begin
if Client1.Id <> Client2.Id then begin
Buffer.DataType := dtConnect;
Buffer.ClientId := Client2.Id;
Flag := Flag and (Client1.Send(Buffer, SizeOf(Buffer)) = SizeOf(Buffer));
Buffer.DataType := dtCoords;
Buffer.Coords := Client2.Coords;
Flag := Flag and (Client1.Send(Buffer, SizeOf(Buffer)) = SizeOf(Buffer));
end;
end;
if Flag then begin
Memo1.Lines.Add('Client Id = ' + IntToStr(Client1.Id) + ' connected from ' +
String(Client1.Socket.RemoteHost) + ':' + String(Client1.Socket.RemotePort));
Client1.State := csActive;
end;
end;
csActive:begin
if Client1.Changed then begin
Buffer.DataType := dtCoords;
Buffer.Coords := Client1.Coords;
Flag := True;
for Client2 in Clients do begin
if Client1.Id <> Client2.Id then begin
Flag := Flag and (Client2.Send(Buffer, SizeOf(Buffer)) = SizeOf(Buffer));
end;
end;
if Flag then begin
Client1.Changed := False;
end;
end;
end;
csDisconnect:begin
Buffer.DataType := dtDisconnect;
Flag := True;
for Client2 in Clients do begin
if Client1.Id <> Client2.Id then begin
Flag := Flag and (Client2.Send(Buffer, SizeOf(Buffer)) = SizeOf(Buffer));
end;
end;
if Flag then begin
Memo1.Lines.Add('Client Id = ' + IntToStr(Client1.Id) + ' disconnected');
Client1.State := csRemove;
end;
end;
csRemove:begin
ClientsToRemove.Add(Client1);
end;
end;
end;
end;
Sect.Release;
Sect.Acquire;
if Assigned(Clients) then begin
for Client1 in ClientsToRemove do begin
Clients.Remove(Client1);
Client1.Free;
end;
end;
Sect.Release;
ClientsToRemove.Free;
end;
end.
Recent
