unit Server;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Sockets, ServerThread;
type
{ TForm1 }
TForm1 =
class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
public
procedure handle(ID,
message:
String);
end;
var
Form1: TForm1;
threads:
Array[1..4]
of TServerThread;
serverSocket: Longint;
clientSocket: Longint;
serverAddr: TInetSockAddr;
opt: Integer = 1;
addrSize: Longint;
clientCount: Integer = 0;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
repeat
serverSocket:= fpSocket(AF_INET, SOCK_STREAM, 0);
if fpSetSockOpt(serverSocket, SOL_SOCKET, SO_REUSEADDR, @opt, sizeOf(opt)) = SOCKET_ERROR
then showMessage('
Server : Multi : ' + intToStr(socketError));
if serverSocket = SOCKET_ERROR
then showMessage('
Server : Socket : ' + intToStr(socketError));
serverAddr.sin_family:= AF_INET;
serverAddr.sin_port:= htons(50000);
serverAddr.sin_addr.s_addr:= htonl($7F000001);
if fpBind(serverSocket, @serverAddr, sizeOf(serverAddr)) = SOCKET_ERROR
then showMessage('
Server : Bind : ' + intToStr(socketError));
if fpListen(serverSocket, 4) = SOCKET_ERROR
then showMessage('
Server : Listen : ' + intToStr(socketError));
showMessage('
Waiting for connect from Client...');
addrSize:= sizeOf(serverAddr);
clientSocket:= fpaccept(serverSocket, @serverAddr, @addrSize);
if clientSocket = SOCKET_ERROR
then showMessage('
Server : Accept : ' + intToStr(socketError))
else clientCount:= clientCount + 1;
threads[clientCount]:= TServerThread.create(true, clientSocket);
threads[clientCount].start;
until clientCount = 4;
end;
procedure TForm1.handle(ID,
message:
String);
var
i, toTerminate: Integer;
MyCriticalSection: TRTLCriticalSection;
begin
InitCriticalSection(MyCriticalSection);
EnterCriticalSection(MyCriticalSection);
try
for i:= 1
to clientCount
do
begin
threads.send(ID + '
: ' +
message);
if threads.getID = ID
then toTerminate:= i;
end;
if message = '
ciao'
then
begin
threads[toTerminate].send('
ciao');
threads[toTerminate].close;
clientCount:= clientCount - 1;
for i:= toTerminate
to clientCount
do threads:= threads[i + 1];
end;
finally
LeaveCriticalSection(MyCriticalSection);
end;
end;
end.
unit ServerThread;
{$mode objfpc}{$H+}
interface
uses Classes, Dialogs, Sockets, SysUtils;
type
TServerThread =
class(TThread)
private
ID:
String;
clientSocket: Longint;
protected
procedure execute;
override;
public
constructor create(createSuspended: Boolean; client: Longint);
procedure send(msg:
String);
function getID:
String;
procedure close;
end;
var
buffer:
String[255];
count: Longint;
implementation
uses Server;
constructor TServerThread.create(createSuspended: Boolean; client: Longint);
begin
freeOnTerminate:= true;
inherited create(createSuspended);
clientSocket:= client;
end;
procedure TServerThread.execute;
begin
count:= fprecv(clientSocket, @buffer[1], 255, 0);
if (count <> SOCKET_ERROR)
and (count > 0)
then
begin
setLength(buffer, count);
ID:= buffer;
end;
buffer:= '
Herzlich willkommen im Chat, ' + ID;
count:= length(buffer);
if fpsend(clientSocket, @buffer[1], count, 0) = count
then
begin
repeat
count:= fprecv(clientSocket, @buffer[1], 255, 0);
if (count <> SOCKET_ERROR)
and (count > 0)
then
begin
setLength(buffer, count);
Form1.handle(ID, buffer);
end;
until (count = SOCKET_ERROR)
or (count = 0);
end;
end;
procedure TServerThread.send(msg:
String);
begin
fpsend(clientSocket, @msg[1], length(msg), 0);
end;
function TServerThread.getID:
String;
begin
result:= ID;
end;
procedure TServerThread.close;
begin
closeSocket(clientSocket);
end;
end.
unit Client;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Sockets, ClientThread;
type
{ TForm1 }
TForm1 =
class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure handle(msg:
String);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
thread: TClientThread;
serverAddr: TInetSockAddr;
serverSocket: Longint;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
serverSocket:= fpSocket(AF_INET, SOCK_STREAM, 0);
if serverSocket = SOCKET_ERROR
then showMessage('
Client : Socket : ' + intToStr(socketError));
serverAddr.sin_family:= AF_INET;
serverAddr.sin_port:= htons(50000);
serverAddr.sin_addr.s_addr:= htonl($7F000001);
//funktioniert beim zweiten Client nicht, da kein Error, obwohl die Verbindung nicht zustande kommt (fpaccept reagiert nicht)
if fpconnect(serverSocket, @serverAddr, sizeOf(serverAddr)) = SOCKET_ERROR
then showMessage('
Client : Connect : ' + intToStr(socketError));
thread:= TClientThread.create(true, serverSocket);
thread.start;
buffer:= Edit1.Text;
fpsend(serverSocket, @buffer[1], length(buffer), 0);
Button2.Enabled:= true;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
buffer:
String;
begin
buffer:= Edit2.Text;
fpsend(serverSocket, @buffer[1], length(buffer), 0);
end;
procedure TForm1.Edit1Change(Sender: TObject);
begin
if length(Edit1.Text) > 0
then Button1.Enabled:= true
else Button1.Enabled:= false;
end;
procedure TForm1.handle(msg:
String);
begin
if msg = '
ciao'
then closeSocket(serverSocket)
else Memo1.Lines.Add(msg);
end;
end.
unit ClientThread;
{$mode objfpc}{$H+}
interface
uses Classes, Dialogs, Sockets, SysUtils;
type
TClientThread =
class(TThread)
private
serverSocket: Longint;
protected
procedure execute;
override;
public
constructor create(createSuspended: Boolean; server: Longint);
end;
var
buffer:
String[255];
count, i: Longint;
implementation
uses Client;
constructor TClientThread.create(createSuspended: Boolean; server: Longint);
begin
freeOnTerminate:= true;
inherited create(createSuspended);
serverSocket:= server;
end;
procedure TClientThread.execute;
begin
repeat
count:= fprecv(serverSocket, @buffer[1], 255, 0);
if count <> SOCKET_ERROR
then
begin
setLength(buffer, count);
Form1.handle(buffer);
end;
until buffer = '
ciao';
closeSocket(serverSocket);
end;
end.