
Originally Posted by
Officer Barbrady
Last time I tried to set it up it didn't work out so well :s
Wrote a nice protocol & example:

You can keep this if you like. It's actually a good starting point. I probably won't finish it or work on it.
Server:
Simba Code:
{$I SRL/SRL.Simba}
const
SERVER_IP = '127.0.0.1';
SERVER_PORT = '27015';
SERVER_ID = '-1';
CLIENT_DISCONNECT = '-2';
SERVER_DISCONNECT = '-3';
type TPacket = record
ToID: String;
FromID: String;
Data: String;
end;
{------------------------------------------------------------------------------}
var
Socket: Integer;
Clients: TIntegerArray;
Function CreateServerSocket(IP, Port: String): Integer;
begin
Result := CreateSocket;
BindSocket(Result, IP, Port);
ListenSocket(Result);
AddOnTerminate('TerminateServerSocket');
end;
Procedure TerminateServerSocket;
begin
CloseSocket(Socket);
FreeSocket(Socket);
end;
Procedure TerminateClientSockets;
var
I: Integer;
begin
For I := 0 To High(Clients) do
begin
try
CloseSocket(Clients[I]);
except end;
try
FreeSocket(Clients[I]);
except end;
end;
end;
Function ReadPacket(Socket: Integer): TPacket;
begin
Result.ToID := RecvSocket(Socket);
SendSocket(Socket, ';;;');
Result.FromID := RecvSocket(Socket);
SendSocket(Socket, ';;;');
Result.Data := RecvSocket(Socket);
SendSocket(Socket, ';;;');
if (Result.Data = '#') then Result.Data := '';
end;
Procedure WritePacket(Socket: Integer; Packet: TPacket);
begin
SendSocket(Socket, Packet.ToID);
RecvSocket(Socket);
SendSocket(Socket, Packet.FromID);
RecvSocket(Socket);
if (Packet.Data = '') then Packet.Data := '#';
SendSocket(Socket, Packet.Data);
RecvSocket(Socket);
end;
Procedure PrintPacket(Packet: TPacket);
begin
writeln('ToID: ' + Packet.ToID);
writeln('FromID: ' + Packet.FromID);
writeln('Data: ' + Packet.Data);
writeln('');
end;
var
Packet: TPacket;
Client: Integer;
IP, Port: String;
begin
Socket := CreateServerSocket(SERVER_IP, SERVER_PORT);
repeat
try
Client := AcceptSocket(Socket);
Packet := ReadPacket(Client);
if ((Packet.ToID = SERVER_ID) And (Packet.FromID = SERVER_ID)) then
begin
SocketInfo(Client, IP, Port);
Packet.FromID := CompressString(MD5(IP + Port));
end;
Packet.Data := '';
WritePacket(Client, Packet);
FreeSocket(Client);
except
FreeSocket(Client);
end;
Sleep(100);
until(False);
end.
Client:
Simba Code:
{$I SRL/SRL.Simba}
const
SERVER_IP = '127.0.0.1';
SERVER_PORT = '27015';
SERVER_ID = '-1';
CLIENT_DISCONNECT = '-2';
SERVER_DISCONNECT = '-3';
type TPacket = record
ToID: String;
FromID: String;
Data: String;
end;
{------------------------------------------------------------------------------}
var
Socket: Integer;
Clients: TIntegerArray;
Function CreateServerSocket(IP, Port: String): Integer;
begin
Result := CreateSocket;
BindSocket(Result, IP, Port);
ListenSocket(Result);
AddOnTerminate('TerminateServerSocket');
end;
Procedure TerminateServerSocket;
begin
CloseSocket(Socket);
FreeSocket(Socket);
end;
Procedure TerminateClientSockets;
var
I: Integer;
begin
For I := 0 To High(Clients) do
begin
try
CloseSocket(Clients[I]);
except end;
try
FreeSocket(Clients[I]);
except end;
end;
end;
Function ReadPacket(Socket: Integer): TPacket;
begin
Result.ToID := RecvSocket(Socket);
SendSocket(Socket, ';;;');
Result.FromID := RecvSocket(Socket);
SendSocket(Socket, ';;;');
Result.Data := RecvSocket(Socket);
SendSocket(Socket, ';;;');
if (Result.Data = '#') then Result.Data := '';
end;
Procedure WritePacket(Socket: Integer; Packet: TPacket);
begin
SendSocket(Socket, Packet.ToID);
RecvSocket(Socket);
SendSocket(Socket, Packet.FromID);
RecvSocket(Socket);
if (Packet.Data = '') then Packet.Data := '#';
SendSocket(Socket, Packet.Data);
RecvSocket(Socket);
end;
Procedure PrintPacket(Packet: TPacket);
begin
writeln('ToID: ' + Packet.ToID);
writeln('FromID: ' + Packet.FromID);
writeln('Data: ' + Packet.Data);
writeln('');
end;
var
Form: TForm;
ClientImage: TImage;
ServerImage: TImage;
HistoryBox: TMemo;
SendBox: TMemo;
ClientBox: TListBox;
SendButton: TButton;
Params: TVariantArray;
Terminate: Boolean;
Packet: TPacket;
Procedure OnFormShow(Sender: TObject);
begin
try
SetLength(Clients, Length(Clients) + 1);
Clients[0] := CreateSocket;
HistoryBox.Text := HistoryBox.Text + 'Connecting To Server..' + #13#10;
ConnectSocket(Clients[0], SERVER_IP, SERVER_PORT);
Packet.FromID := SERVER_ID;
Packet.ToID := SERVER_ID;
WritePacket(Clients[0], Packet);
Packet := ReadPacket(Clients[0]);
CloseSocket(Clients[0]);
HistoryBox.Text := HistoryBox.Text + 'Connection Successful.' + #13#10#13#10;
except
ClearDebug;
Clients[0] := -1;
HistoryBox.Text := HistoryBox.Text + 'Error Connection Failed: Server Unavailable.' + #13#10;
end;
end;
Procedure OnFormClose(Sender: TObject; var Action: TCloseAction);
begin
Terminate := True;
end;
Procedure OnSendClicked(Sender: TObject);
begin
if (Clients[0] <> -1) then
begin
try
if (SendBox.Text <> '') then
begin
Packet.Data := SendBox.Text;
ConnectSocket(Clients[0], SERVER_IP, SERVER_PORT);
WritePacket(Clients[0], Packet);
CloseSocket(Clients[0]);
SendBox.Clear;
HistoryBox.Text := HistoryBox.Text + 'Sent: ' + Packet.Data + #13#10;
end;
except
HistoryBox.Text := HistoryBox.Text + 'Error Sending Message.' + #13#10;
end;
end else
HistoryBox.Text := HistoryBox.Text + 'Server Unavailable.' + #13#10;
end;
Procedure OnSendKeyPressed(Sender: TObject; var Key: Char);
begin
if ((Key = Chr(VK_ENTER)) And (Not IsKeyDown(VK_SHIFT))) then
begin
if (Clients[0] <> -1) then
begin
try
if (SendBox.Text <> '') then
begin
Packet.Data := SendBox.Text;
ConnectSocket(Clients[0], SERVER_IP, SERVER_PORT);
WritePacket(Clients[0], Packet);
CloseSocket(Clients[0]);
SendBox.Clear;
HistoryBox.Text := HistoryBox.Text + 'Sent: ' + Packet.Data + #13#10;
end;
except
HistoryBox.Text := HistoryBox.Text + 'Error Sending Message.' + #13#10;
end;
end else
HistoryBox.Text := HistoryBox.Text + 'Server Unavailable.' + #13#10;
end;
end;
Procedure OnSendKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if ((Key = VK_ENTER) And (SendBox.Text = '')) then
Key := 0;
end;
procedure InitialiseForm;
var
X, Y: Integer;
begin
Form := TForm.Create(nil);
Form.OnShow := @OnFormShow;
Form.OnClose := @OnFormClose;
Form.SetBounds(256, 256, 725, 500);
Form.Caption := 'Client';
X := 10; Y := 25;
ClientImage := TImage.Create(Form);
ClientImage.Parent := Form;
ClientImage.Center := True;
ClientImage.Stretch := True;
ClientImage.Picture.Bitmap.Assign(GetMufasaBitmap(BitmapFromClient(0, 0, 96, 96)).ToTBitmap);
ClientImage.SetBounds(X, Y, 106, 106);
ClientImage.Visible := True;
ServerImage := TImage.Create(Form);
ServerImage.Parent := Form;
ServerImage.Center := True;
ServerImage.Stretch := True;
ServerImage.Picture.Bitmap.Assign(GetMufasaBitmap(BitmapFromClient(0, 0, 96, 96)).ToTBitmap);
ServerImage.SetBounds(X, 256, 106, 106);
ServerImage.Visible := True;
HistoryBox := TMemo.Create(Form);
HistoryBox.Parent := Form;
HistoryBox.SetBounds(X + ClientImage.Width + 15, 25, 450, ServerImage.Top + ServerImage.Height - 25);
HistoryBox.Enabled := False;
HistoryBox.Visible := True;
SendBox := TMemo.Create(Form);
SendBox.Parent := Form;
SendBox.SetBounds(X, ServerImage.Top + ServerImage.Height + 15, HistoryBox.Left + HistoryBox.Width - 10, 110);
SendBox.OnKeyPress := @OnSendKeyPressed;
SendBox.OnKeyDown := @OnSendKeyDown;
SendBox.Visible := True;
ClientBox := TListBox.Create(Form);
ClientBox.Parent := Form;
ClientBox.SetBounds(HistoryBox.Left + HistoryBox.Width + 10, HistoryBox.Top, 125, HistoryBox.Top + HistoryBox.Height - 25);
ClientBox.Visible := True;
SendButton := TButton.Create(Form);
SendButton.Parent := Form;
SendButton.Caption := 'Send Message';
SendButton.SetBounds(SendBox.Left + SendBox.Width + 10, SendBox.Top, ClientBox.Width, SendBox.Height);
SendButton.OnClick := @OnSendClicked;
SendBox.Visible := True;
Form.ShowModal;
end;
begin
ThreadSafeCall('InitialiseForm', Params);
Terminate := False;
Form.Close;
Form.Free;
end.