Everyone is forgetting one thing.. Sockets in Simba is pretty garbage..
1. You cannot poll/select simba sockets.
2. You cannot accept clients without blocking.
3. Every operation in Simba's sockets block.
Server.Simba:
{$I Sockets.Simba}
procedure onSocketConnect(sock, id: Int32);
var
str: String;
begin
if (id <> -1) then
while(true) do
begin
Str := ReadSocket(sock);
if (Length(Str) > 0) then
writeln('Received from client: ', str);
WriteSocket(sock, 'hello client');
if (Not Server_PollClient(sock)) then
break;
Sleep(100);
end;
end;
begin
SocketSetup;
Server_AcceptClients;
end.
Client.Simba:
{$I Sockets.Simba}
procedure onSocketConnect(sock, id: Int32);
var
Data: String;
begin
ClearDebug;
writeln('Connected to server..');
while(true) do
begin
WriteSocket(sock, 'hello server');
Data := ReadSocket(sock);
if (Length(Data) > 0) then
writeln('Received from server: ', Data);
if (Not Server_PollClient(sock)) then
break;
Sleep(100);
end;
end;
begin
SocketSetup;
end.
The above uses:
Sockets.Simba:
{$IFDEF RIDDLER}
{$loadlib Riddler}
{$ENDIF}
var
sockets_shutdown: boolean;
server_socket: Int32;
client_sockets: TIntegerArray;
procedure onSocketConnect(socket, id: Int32); forward;
procedure Client_Connect(var sock: Int32);
begin
sock := CreateSocket;
SetSocketTimeout(sock, 10);
try
ConnectSocket(sock, '127.0.0.1', '27016');
except
writeln('Server not running..');
FreeSocket(sock);
sock := -1;
end;
end;
procedure Server_Listen(var sock: Int32);
begin
sock := CreateSocket;
SetSocketTimeout(sock, 10);
try
BindSocket(sock, '127.0.0.1', '27016');
ListenSocket(sock);
except
writeln('Server Port in use..');
FreeSocket(sock);
sock := -1;
end;
end;
function Server_PollClient(sock: Int32): boolean;
begin
Result := True;
try
SendSocket(sock, #0#0 + 'Ping' + #0#0);
except
Result := False;
end;
end;
procedure Server_ClearDisconnectedClients;
var
I, J: Integer;
begin
For I := 0 To High(client_sockets) Do
If (Not Server_PollClient(client_sockets[I])) Then
begin
try
CloseSocket(client_sockets[I]);
FreeSocket(client_sockets[I]);
except
try
FreeSocket(client_sockets[I]);
except
end;
end;
For J := I To High(client_sockets) - 1 Do
swap(client_sockets[J], client_sockets[J + 1]);
SetLength(client_sockets, High(client_sockets));
end;
end;
procedure Server_AcceptClients;
var
sock: Int32;
begin
while(Not sockets_shutdown) do
begin
sock := -1;
Server_ClearDisconnectedClients;
sock := AcceptSocket(server_socket);
if (sock <> - 1) then
begin
SetLength(client_sockets, Length(client_sockets) + 1);
client_sockets[Length(client_sockets) - 1] := sock;
onSocketConnect(sock, Length(client_sockets));
Server_ClearDisconnectedClients;
end;
end;
end;
Function ReadSocket(sock: Int32): String;
begin
try
Result := RecvSocket(sock);
except
writeln('Read operation timed out.');
end;
If (Result = #0#0 + 'Ping' + #0#0) Then
Result := '';
end;
Procedure WriteSocket(sock: Int32; Data: String);
begin
try
SendSocket(sock, Data);
except
writeln('Write operation timed out.');
end;
end;
procedure ShutdownSockets;
var
I, L: Int32;
begin
sockets_shutdown := true;
if (server_socket <> -1) then
begin
try
CloseSocket(server_socket);
FreeSocket(server_socket);
except
FreeSocket(server_socket);
end;
end;
L := High(client_sockets);
For I := 0 To L do
begin
try
CloseSocket(client_sockets[I]);
FreeSocket(client_sockets[I]);
except
FreeSocket(client_sockets[I]);
end;
end;
end;
procedure SocketSetup;
begin
AddOnTerminate('ShutdownSockets');
Server_Listen(server_socket);
if (server_socket = -1) then
begin
SetLength(client_sockets, 1);
Client_Connect(client_sockets[0]);
onSocketConnect(client_sockets[0], 0);
end else
onSocketConnect(server_socket, -1);
if ((server_socket = -1) and (length(client_sockets) = 0)) then
TerminateScript;
end;
The problem is when you have to accept more than one client.. That's when you're in trouble. Otherwise it is easy to write back and forth using a single socket.. If OP plans on using multiple clients then the above will not be very good for him. Otherwise if it is just two Simba's talking to eachother then the above will work.