Network Chat Code

///////////////////////////////////////////////////////////////////////////////
///                                                                         ///
///                  NETWORK CHAT  (UNIX/LINUX UPDATE)                      ///
///                         by Max Foster                                   ///
///                                                                         ///
///////////////////////////////////////////////////////////////////////////////

{
   Copyright (c) 2011-2013 Max Foster

    Licensed under the Apache License, Version 2.0 (the 'License'); you may not
    use this file except in compliance with the License, as described at
    http://www.apache.org/licenses/ and http://www.pp4s.co.uk/licenses/
}
{
!!! This program has been updated so that it works well with Unix/Linux terminals !!!

This is a chat program that can work over a network. A server is started (which is
included as one of the conversation members), and then clients can connect to it
using an IP address.

Users are notified when other users enter and leave the conversation, and there is
a list on the right hand side of users that are connected. To chat, type a message
and press enter. There is a 32 character limit to messages. The message is then sent
to everyone in the conversation. To quit, press escape.

This program has only been tested over LANs, but this program can theoretically be
used over the internet. This will require port forwarding on the server side, however.
Port forwarding basically allows a certain computer in your LAN to receive connections
on a certain port despite being masked by a external IP address which is provided by your
Internet Service Provider. This is required for ANY type of server to work, not just
this program's one!
Please go to http://www.portforward.com and http://en.wikipedia.org/wiki/Port_forwarding
for more information on this subject.

This program uses the 'SuperMaximo SDL AppEngine', which I made. It offers a layer of
abstraction from pure SDL, making the creation of programs using SDL much easier and
faster. The included units includes the SDL initialisation and networking from SDL_NET.
The AppNetworking unit hides the complicated parts of networking from the programmer
and gives them subroutines to set up a connection and send data quickly and easily!
This program only uses the TCP parts of the engine, as we want to make sure every
message we send gets to the other side! UDP is faster, but can be unreliable. TCP
is fast enough for a chat program like this.

Many subroutines in this program are from the engine. I will indicate which these are
by typing '//***' after the declaration. Multiple '//***'s indicate multiple subroutines
from the engine on the same line.

Now onto the code!
}
program NetworkChat;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils, CRT, AppSDL, AppNetworking;

const
  PORT = 5164;  //The port used to connect to. This can be any number above 1023, excluding 8080
  MAX_CLIENTS = 8;   //The maximum number of clients that can connect to the server
  TCP_DATA_SIZE = 46;   //The maximum amount of bytes being sent and received
  MSG_SIZE = 32;     //The maximum length of messages in characters

var
  newmessage, newestmessage : string[48];  //The messages being handled at any moment
  messages : array[0 .. 16] of string[48];   //The messages displayed on screen
  clientnames : array[0 .. MAX_CLIENTS - 1] of string[14];  //The names of the clients connected to the server
  myname, servername : string[14];      //The client name and server name
  key : char;     //The key currently being pressed
  willsend : boolean;    //A flag to say whether to send the message or not

function AnyServers : boolean;
//Checks for servers based on an IP address entered
var
  addr : string;
begin
  Result := false;
  Write('Enter an address to connect to. Type "server" to start a chat server: ');
  readln(addr);
  if addr = 'server' then
    exit;
  //Starts a client and attempts to connect to a server at the address and port provided
  StartClient(pchar(addr), PORT);//***
  Result := ConnectToServer(false);//***
  if not Result then
    CloseClient;//***
end;

procedure DrawFrame;
//Draws the chat screen
var
  i : integer;
begin
  TextBackground(white);
  ClrScr;
  GotoXY(7, 2);
  TextColor(blue);
  Write('***  Network Chat by Max  ***');
  GotoXY(1, 3);
  TextColor(brown);
  for i := 1 to 50 do
    Write('_');
  GotoXY(1, 21);
  for i := 1 to 50 do
    Write('_');
  for i := 1 to 24 do
    begin
      GotoXY(51, i);
      Write('|');
    end;
  GotoXY(53, 2);
  TextColor(blue);
  Write('Users in chat');
end;

procedure ClearMessageBox;
var
  i : integer;
begin
  GotoXY(2, 22);
  for i := 1 to 49 do
    Write(' ');
  GotoXY(2, 22);
end;

procedure HandleUserMessages;
{Allows the user to type a message. '`' is reserved for messages sent by the program
automatically that are to be computed instead of read by a human}
begin
  if (Ord(key) >= 33) and (Ord(key) <= 126) and (key <> #96) then
  begin
    newmessage += key;
  end
else
  begin
    case key of
      #8 : if Length(newmessage) > 0 then
             SetLength(newmessage, Length(newmessage) - 1);
      #32 : newmessage += ' ';
      #13 : willsend := true;
    end;
  end;
  if Length(newmessage) > MSG_SIZE then
    SetLength(newmessage, MSG_SIZE);
  ClearMessageBox;
  TextColor(black);
  Write(newmessage);
end;

procedure ProcessMessage(themessage : string);
{Displays a message on the screen. This is also useful for debugging as using writeln
is unpredictable (as the window refreshes and redraws itself a lot)}
var
  i, j : integer;
  resort : boolean; //re-sort as in sort it again, not resort as in a holiday resort
begin
  TextColor(black);
  if themessage = '' then
    exit;  //Don't process blank messages
  resort := false;
  for i := 0 to 16 do
    begin
      if messages[i] = '' then
        begin
          messages[i] := themessage; //Replace an empty line which are present at the beginning with the message
          break;
        end
      else
        begin
          if i = 16 then
            resort := true; //The new message won't fit on, so will need to rejig the messages displayed
        end;
    end;
  if resort then
    begin
      for i := 0 to 16 do
        begin
          //Shift all the messages up and put the new message at the bottom
          if i < 16 then
            messages[i] := messages[i + 1]
          else
            messages[i] := themessage;
        end;
    end;
  for i := 0 to 16 do
    begin
      //Redraw the messages
      if messages[i] <> '' then
        begin
          GotoXY(2, 4 + i);
          for j := 0 to 48 do
            Write(' ');
          GotoXY(2, 4 + i);
          if RightStr(messages[i], 2)[1] = #96 then   //If the message is a message that needs to be coloured in then...
            begin
              case RightStr(messages[i], 1)[1] of  //Check which colour is needed and apply the colour
                'G': TextColor(green);
                'R': TextColor(red);
              end;
              Write(messages[i][1 .. Length(messages[i]) - 2]);
            end
          else
            begin
              TextColor(black);
              Write(messages[i]);
            end;
        end;
    end;
  GotoXY(2, 22);  //Go back to the position where you want to type a message
end;

procedure SendMessage;
var
  i : integer;
begin
  willsend := false;
  if newmessage = '' then
    exit;
  if ClientStarted then
    SendStrTCP(newmessage, 0, false, TCP_DATA_SIZE)  //*** //***
  else
    begin
      //Do the following for a server
      newmessage := myname + ': ' + newmessage;  //Put the server's name in front of the message so we know who it's from
      for i := 0 to MAX_CLIENTS - 1 do
        begin
          if ClientExists(i) then
            SendStrTCP(newmessage, i, true, TCP_DATA_SIZE);  //*** //***
        end;
      ProcessMessage(newmessage);
    end;
  newmessage := '';
  GotoXY(2, 22);
  for i := 1 to 49 do
    Write(' ');
  GotoXY(2, 22);
end;

procedure DrawUserList;
//Draws a list of the people in the conversation on the right hand side
var
  i, j : integer;
begin
  for i := 0 to MAX_CLIENTS do   //Clear out the previously drawn list
    begin
      GotoXY(53, 3 + i);
      for j := 0 to 12 do
        write(' ');
    end;
  TextColor(black);
  GotoXY(53, 3);
  write(servername); //Write the list, making sure there are no gaps (when, for example, a person disconnects)
  j := 0;
  for i := 0 to MAX_CLIENTS - 1 do
    begin
      GotoXY(53, 4 + j);
      if clientnames[i] <> '' then
        begin
          write(clientnames[i]);
          j += 1;
        end;
    end;
  if ServerStarted then
  begin
    GotoXY(53, 21);
    Write('You are the server.');
    GotoXY(53, 22);
    Write('Your address is:');
    GotoXY(53, 23);
    GotoXY(53, 23);
    TextColor(blue);
    Write(GetLocalAddress); //*** //Displays the address of the server which can be used by clients as an IP address to connect to
    TextColor(black);
  end;
  GotoXY(2, 22);
end;

procedure SetUpConnection;
begin
  if AnyServers then        //If it connects to a server then...
    begin
      SendStrTCP(#96 + 'MY NAME IS ' + myname, 0, false, TCP_DATA_SIZE);  //*** //Send the name of the client to the server
      repeat
        servername := RecvStrTCP(0, false, TCP_DATA_SIZE);    //*** //Receive the name of the server
        if servername = 'DISCONNECTED' then       //If the connection has been lost then quit
          begin
            CloseClient;       //***
            QuitAppSDL;        //***
            Halt;
          end;
        //If the correct message containing the name of the server is found then continue, otherwise ask for the name again
        if servername <> '' then
          begin
            if LeftStr(servername, 3) = #96 + 'SN' then
              servername := RightStr(servername, Length(servername) - 3)
            else
              servername := '';
          end
        else
          begin
            SendStrTCP(#96 + 'NEEDNAME', 0, false, TCP_DATA_SIZE);  //***
          end;
      until servername <> '';
      DrawUserList;
    end
  else
    StartServer(MAX_CLIENTS, PORT);  //*** //If there is no server to connect to then start the server
end;

procedure ReceiveMessages;
var
  i, j, client : integer;
begin
  if ServerStarted then  //***
    begin
      for i := 0 to MAX_CLIENTS - 1 do    //Loop through all clients that might exist
        begin
          if ClientExists(i) then   //*** //If there is a client connected with the ID of i
            begin
              newestmessage := RecvStrTCP(i, true, TCP_DATA_SIZE);   //***
              if newestmessage = 'DISCONNECTED' then     //If the client has disconnected then...
                begin
                  KickClient(i);  //Kick the client from the server. This MUST be called when a client disconnects
                  ClearMessageBox;
                  newestmessage := '';
                  for j := 0 to MAX_CLIENTS - 1 do
                    begin
                      if ClientExists(j) then  //***
                        begin
                          SendStrTCP(#96 + 'C~' + clientnames[i], j, true, TCP_DATA_SIZE); //*** //Tell all the other clients that they've disconnected
                        end;
                    end;
                  ProcessMessage('*' + clientnames[i] + ' disconnected*' + #96 + 'R');
                  clientnames[i] := '';
                  DrawUserList;
                end;
              if LeftStr(newestmessage, 1) = #96 then
                begin
                  if newestmessage = #96 + 'NEEDNAME' then //If the client hasn't received the server's name, then send it again
                    begin
                      while RecvStrTCP(i, true, TCP_DATA_SIZE) <> '' do begin end; // Unix / Linux update - TCP buffer fix
                      SendStrTCP(#96 + 'SN' + myname, i, true, TCP_DATA_SIZE);  //***
                      Wait(20);
                      SendStrTCP(#96 + 'N~' + clientnames[i], i, true, TCP_DATA_SIZE);  //***
                      for j := 0 to Length(clientnames) do
                        begin
                          if (clientnames[j] <> '') and (j <> i) then
                            SendStrTCP(#96 + 'N~' + clientnames[j], i, true, TCP_DATA_SIZE);  //***
                        end;
                    end;
                  newestmessage := '';
                end;
              if newestmessage <> '' then  //Break from the loop if the server has received a valid message
                begin
                  client := i;
                  break;
                end;
            end;
        end;
      if newestmessage <> '' then
        begin
          newestmessage := clientnames[client] + ': ' + newestmessage; //Put the client's name in front so we know who the message is from
          for i := 0 to MAX_CLIENTS - 1 do  //Send the message to everyone (including the client that sent it)
            begin
              if ClientExists(i) then
                SendStrTCP(newestmessage, i, true, TCP_DATA_SIZE);  //*** //***
            end;
        end;
    end
  else
    begin
      newestmessage := RecvStrTCP(0, false, TCP_DATA_SIZE);  //***
      if newestmessage = 'DISCONNECTED' then  //If the client has lost connection to the server then quit
        begin
          key := #27;
          exit;
        end;
      if LeftStr(newestmessage, 1) = #96 then   //If the message is a hidden message then...
        begin
          if LeftStr(newestmessage, 3) = #96 + 'N~' then  //If the hidden message is a notice that a new user has joined then...
            begin
              for i := 0 to MAX_CLIENTS - 1 do
                begin
                  if clientnames[i] = '' then
                    begin
                      clientnames[i] := RightStr(newestmessage, Length(newestmessage) - 3);  //Add the new user's name to the list
                      break;
                    end;
                end;
              ProcessMessage('*' + clientnames[i] + ' has joined*' + #96 + 'G');   //Show that the user has connected, indicating that the message is green
            end;
          if LeftStr(newestmessage, 3) = #96 + 'C~' then  //If the hidden message is a notice that a user has disconnected then...
            begin
              for i := 0 to MAX_CLIENTS - 1 do
                begin
                  if clientnames[i] = RightStr(newestmessage, Length(newestmessage) - 3) then
                    begin
                      ProcessMessage('*' + clientnames[i] + ' disconnected*' + #96 + 'R');  //Show that the user has disconnected, indicating that the message is red
                      clientnames[i] := '';       //Remove their name from the list of names
                      break;
                    end;
                end;
            end;
          //If the server needs the client's name then send it
          if newestmessage = #96 + 'NEEDCLIENTNAME' then
            SendStrTCP(#96 + 'MY NAME IS ' + myname, 0, false, TCP_DATA_SIZE); //***
          DrawUserList;
          newestmessage := '';
        end;
    end;
end;

procedure DealWithNewClients;
var
  i, newclient : integer;
  newname : string;
begin
  newclient := CheckForNewClient(false);  //***
  if newclient < 0 then
    exit
  else
    SendStrTCP(#96 + 'SN' + servername, newclient, true, TCP_DATA_SIZE);  //*** //Send the server's name to the connected client
  repeat  //Repeat until a valid name for the client has been received
    DrawFrame;
    newname := RecvStrTCP(newclient, true, TCP_DATA_SIZE);  //*** //Receive a message (hopefully) containing the client's name
    if newname <> '' then
      begin
        if newname = 'DISCONNECTED' then
          KickClient(newclient) //*** //If the connection to the client has been lost then kick them
        else
          begin
            if Length(newname) > 12 then
              begin
                if LeftStr(newname, 12) = #96 + 'MY NAME IS ' then  //If the message is valid then...
                  begin
                    clientnames[newclient] := '';
                    for i := 13 to Length(newname) do
                      clientnames[newclient] += newname[i];
                    for i := 0 to MAX_CLIENTS - 1 do
                      begin
                        if ClientExists(i) then  //*** //Send a message indication that a new client has conncted to the other clients
                          begin
                            SendStrTCP(#96 + 'N~' + clientnames[newclient], i, true, TCP_DATA_SIZE);  //***
                          end;
                      end;
                    for i := 0 to Length(clientnames) do  //Send a list of all the clients currently in the conversation to the new client
                      begin
                        if (clientnames[i] <> '') and (i <> newclient) then
                          SendStrTCP(#96 + 'N~' + clientnames[i], newclient, true, TCP_DATA_SIZE); //***
                      end;
                    ProcessMessage('*' + clientnames[newclient] + ' has joined*' + #96 + 'G'); //Display a message that a new client has connected on the server's screen
                    DrawUserList;
                  end
                else
                  newname := '';
              end
            else
              newname := '';
          end;
      end;
    if newname = '' then
      SendStrTCP(#96 + 'NEEDCLIENTNAME', newclient, true, TCP_DATA_SIZE); //If the server hasn't received a name from the client then request it
  until newname <> '';
end;

procedure StopServer;
var
  i : integer;
begin
  for i := 0 to MAX_CLIENTS - 1 do
    begin
      if ClientExists(i) then
        KickClient(i);  //*** //***
    end;
  CloseServer;  //***
end;

procedure Instructions;
//Instructions that appear after the user has entered a username
begin
  Writeln('Hello ', myname, ', welcome to Network Chat!');
  Writeln;
  Writeln('(Press enter to continue...)');
  Readln;
  Writeln('In a moment you will have to enter the address of the chat server you want');
  Writeln('to connect to.');
  Writeln('This can be a regular IP address, or the number that appears in the bottom');
  Writeln('right hand corner of the server window.');
  Writeln('Then you will be connected to the server, and you can start chatting!');
  Writeln('If you are unable to connect (if a server is not open at the address');
  Writeln('specified, for example) then you will automatically become the server.');
  Writeln('If you would like to be the server without checking an address, then just');
  Writeln('type "server" instead of an address.');
  Writeln;
  Writeln('(Press enter to continue...)');
  Readln;
  Writeln('When you are in the chat window, simply type a message (which will appear');
  Writeln('in the box at the bottom of the screen), press enter, and');
  Writeln('hey presto! You''ve sent a message!');
  Writeln('To exit, just press escape. If you are the server then all the clients will');
  Writeln('disconnect and close automatically!');
  Writeln;
  Writeln('Enjoy!');
  Writeln;
  Writeln('(Press enter to continue...)');
  Readln;
end;

procedure Init;
var
  i : integer;
  tempname : string;
begin
  tempname := '';
  while (Length(tempname) < 1) or (Length(tempname) > 14) do  //Loop until a favourable name is entered
    begin
      Write('Enter a chat username (maximum 14 characters): ');
      Readln(tempname);
      if Length(tempname) < 1 then
        Writeln('You must enter a chat username!');
      if Length(tempname) > 14 then
        Writeln('Your chat username is too long!');
      Writeln;
    end;
  myname := tempname;

  Instructions;
  SetUpConnection;

  //Initialise some variables
  newmessage := '';
  for i := 0 to 16 do
    messages[i] := '';
  for i := 0 to MAX_CLIENTS - 1 do
    clientnames[i] := '';
  willsend := false;

  DrawFrame;
  GotoXY(2, 22);
  TextColor(black);
  DrawUserList;

  if ServerStarted then   //***
    begin
      servername := myname;
      DrawUserList;
    end;
end;

{$IFDEF WINDOWS}{$R NetworkChat.rc}{$ENDIF}

begin
  InitAppSDL;
  InitAppNetworking;
  Init;

  if ServerStarted then
    ProcessMessage('*' + myname + ' has joined*' + #96 + 'G'); //***

  repeat   //The main loop
    if ServerStarted then
      DealWithNewClients; //***

    newestmessage := '';
    if keypressed then
      begin
        key := Readkey;
        HandleUserMessages;
      end;

    if willsend then
      SendMessage;
    ReceiveMessages;
    ProcessMessage(newestmessage);
  until key = #27;    //Until escape is pressed

  if ClientStarted then
    CloseClient;  //*** //***
  if ServerStarted then
    StopServer;   //*** //***
  QuitAppNetworking;   //***
  QuitAppSDL;    //***

  // Unix/Linux update - terminal refresh
  TextBackground(black);
  TextColor(White);
  clrscr;
end.

Remarks

Could you write networking code that uses routines in the AppNetworking unit?