Network Chat Code
The main code of NetworkChat
/////////////////////////////////////////////////////////////////////////////// /// /// /// 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?