FreeBASIC Winsock TCP Chat Program

[cenozoite]

This is a small and simple, direct client-to-client two-way simultaneous chat program using Winsock TCP in FreeBASIC for Windows. Posted in order to help anyone learning Basic TCP for the first time, as I have been.

Notes:

1. It ONLY works well under the current STABLE release of FreeBasic, version 0.14b. There have been changes made in development versions of 0.15b that adversely affect the scrolling of the screen.

2. It is by no means a complete tutorial, but can be used as a reference guide for getting the syntax right for the Winsock system calls. I have tried to highlight the relevant sections for learning TCP and seperate them from the window dressing, bells and whistles.

3. Methods used for sending and receiving data were chosen for simplicity of grasp, rather than efficiency. There are other/better ways.

4. I've used threads to handle incoming and outgoing messages, which is not the simplest or most straightforward method for a beginner. There are far simpler ways of sending data back and forth, and this technique was just chosen to facilitate smooth simultaneous printing of incoming and outgoing messages. Once a bug with the INKEY$ command is fixed in the next stable FB release, the thread section won't even be as necessary.

5. I overhauled the program massively while commenting and updating it for this post, so there may still be bugs within it. Let me know if you discover any and I'll edit the source code in this post to fix them. Thanks!

6. Edit: The program works fine as a "paste-and-go" into any IDE, despite the illusion of wrapped/truncated lines in the message board version.

Code: Select all

'This is an example of a small, direct client-to-client two-way
'simultaneous chat program using Winsock TCP in FreeBASIC. The
'important segments are the ones illustrating the syntax for opening
'sockets and establishing connections either as the connection
'initiator (client) or connection acceptor (server). The specific
'subsequent methods for sending and receiving data are more flexible,
'and the ones presented here have been chosen for simplicity rather
'than efficiency.

'The basic steps to follow for each choice (client or server) are:
'Client                         Server
'1. Open socket                 1. Open socket
'2. Define socket details       2. Define socket details
'3. Connect socket              3. Bind socket to socket details
'                               4. Listen on socket
'                               5. Accept connection on socket
'
'Once each side has completed its steps successfully and the
'connection is established, they are ready to Send and Receive
'data back and forth, both ways. The steps above are highlighted
'in code below where they occur.


'Preliminary declarations and definitions

#include "win\winsock.bi"       'Header to include for Winsock function
option Escape
Width 80,25
Locate ,,0
const NEWLINE = "\r\n"
dim wsad as WSAData
Declare Sub Generr
Declare Function brint$()
Declare sub mythread ( byval num as integer )
common shared inmessage As zString*316, outmessage As zString *316
Common Shared myname$,remotename$,c,p,textline,chatfinished
Common shared s as SOCKET, r as socket, q as socket
dim addy as String
dim sa as sockaddr_in, sb as sockaddr_in, sc As sockaddr_in, sd as sockaddr_in
Dim inip As Integer
inip=sizeof(sc)
Dim fdset As fd_set
Dim tv As timeval
tv.tv_Sec = 0: tv.tv_Usec = 0
dim hostname as string * 256
dim hostentry as HOSTENT ptr

Common shared trafficlight      'The trafficlight system will
const green=0                   'be used to regulate the flow of
const yellow=1                  'printing operations on the screen.
const red=2                     'Not strictly relevant to Winsock/TCP.

myname$="User"


s3:
'WSAStartup must first be called to intitalize Winsock
'Tries Winsock version 1 if version 2 isn't found
if (WSAStartup(&h202, @wsad))=-1 then
      if (WSAStartup(&h101, @wsad))=-1 then generr
end if


trafficlight=green:chatfinished=0

'Main menu. Lets user change his display name, and most importantly
'select either Client or Server mode, for estabslishing a connection
Cls
Color 15,1
Print space$(79)
locate 1,1
Print "Client-Server Chat Test Program, by Cenozoite"
Color 7,0
Locate 2,1
Print space$(79)
Print "Enter choice below:"
Print String$(50,Chr$(196))
Print"(1) Client Mode (Initiate remote connection)"
Print"(2) Server Mode (Wait for remote connection)"
Print"(3) Set name (Currently set to ";
Color 15:Print myname$;
Color 7:Print")"
PRINT"(4) Exit"


s2:Sleep
choice$=inkey$:choice=Val(choice$)
if choice$=chr$(27) then choice=4
If choice<1 Or choice>4 Then GoTo s2

If choice=4 Then
wsacleanup    'This shuts down Winsock if the user quits
End 1
end if

If choice=3 Then
For x=3 To 8
Locate x,1
Print Space$(79)
Next x
Locate 3,1
Print "Enter new display name (or hit Enter to leave as ";
Color 15:Print myname$;
Color 7:Print"): ";
Input "",mn$
If Trim$(mn$)<>"" Then myname$=Left$(Trim$(mn$),12)
For x=3 To 8
Locate x,1
Print Space$(79)
Next x

GoTo s3
End If


If choice=1 Then    'User specifies a remote IP to connect to here
For x=3 To 8
Locate x,1
Print Space$(79)
Next x
Locate 3,1
Input "Enter remote dot-format IP ADDRESS to connect: ",addy
addy=Trim$(addy)
If addy="" Then GoTo s3
mode=1
End If


If choice=2 Then
For x=3 To 8
Locate x,1
Print Space$(79)
Next x
Locate 2,1
mode=2
End If

'***** STEP 1 for both ClIENT OR SERVER modes: Open the socket
'This socket will be opened the same way for either mode, so
'it's done up front as follows.
s = opensocket( AF_INET, SOCK_STREAM, IPPROTO_TCP )
if s <= 0  Then generr  'If there's an error, quit
'******


If mode=2 then  'This is if the user selected SERVER MODE
locate 3,1
color 15,0
Print"Entering SERVER Mode..."
Print""
Print"Attempting to determine local IP address, one moment please..."
Print""
color 7,0

'***The following is mostly window dressing. Program attempts to
'determine user's IP Address automatically, using two methods. Uses
'the direct Gethostname method, and as a backup, checks a website
'to get the public IP if it's different from local. This section is
'not part of the "Basic Steps" mentioned above.

GetHostName(@hostname, 256)
hostentry = gethostbyname( hostname )

dim ipparser as ubyte ptr
ipparser=hostentry->h_addr
myip$=str(ipparser[0])+"."+str(ipparser[1])+"."+str(ipparser[2])+"."+str(ipparser[3])

q = opensocket( AF_INET, SOCK_STREAM, IPPROTO_TCP )

    sd.sin_port         = htons( 80 )
   sd.sin_family      = AF_INET
   sd.sin_addr.S_addr  = inet_addr("63.208.196.105")

if ( connect( q, @sd, len( sd )) = SOCKET_ERROR ) then closesocket( q )

outmessage = "GET /" + " HTTP/1.0" + NEWLINE + "Host: " +  NEWLINE +"Connection: close" + NEWLINE + "User-Agent: GetHTTP 0.0" + NEWLINE + NEWLINE
             
if ( send( q, @outmessage , len(outmessage), 0 )) = SOCKET_ERROR  then closesocket( q )
   
do
       bytes = recv( q, @inmessage , 316, 0 )
       if( bytes <= 0 ) then exit do
       wholemessage$=wholemessage$+inmessage
loop
closesocket(q)

beg=instr(wholemessage$,"Address: ")
en=instr(wholemessage$,"</body>")
altip$=mid$(wholemessage$,beg+9,(en-1)-(beg+8))
if val(altip$)>0 and (val(altip$)-int(val(altip$)))>0 and altip$<>myip$ then myip$=altip$

color 15,0
if val(myip$)>0 then
print "Your Local IP Address Is: ";
color 10,0:Print trim(myip$):color 15,0:Print ""
Print "Remote party should enter that address after selecting ";
color 10,0:Print "Client Mode.":color 15,0:Print ""   

else
color 15,0
Print "Your Local IP Address could not be determined automatically. Please use an"
Print "appropriate Internet Web Site or other service to determine your Local IP."
Print ""

end if
'******End of automatic IP determining procedure. Back to main section

Print "Awaiting remote connection... hit ESCAPE to cancel..."
color 7,0   
   
'***** STEP 2 for SERVER MODE: Define the socket details
    sa.sin_port         = htons( 8501 )
   sa.sin_family      = AF_INET
   sa.sin_addr.S_addr   = inaddr_any
'*********

'*** STEP 3 for SERVER MODE: Bind the socket to the socket details
nbit = bind( s, @sa, len(sa))
if nbit=socket_error Then closesocket(s):generr
'*********

'**** STEP 4 for SERVER MODE: Listen on the socket
nlis= listen( s, somaxconn)
if nlis = SOCKET_ERROR  Then closesocket( s ):generr
       

''** This could be called step 4a. It's not needed, but stops the
'socket from blocking while it's waiting to accept, and gives the user
'the option of aborting by hitting Escape
do
if inkey$=chr$(27) then esclause=1:exit do
fdset.fd_count=1
fdset.fd_array(0)=s

nRet = selectsocket( 3, @fdset, NULL, NULL, @tv )
if nret>0 then exit do
sleep 1000
loop
if esclause=1 then esclause=0:closesocket (s):goto s3
'****************

'**STEP 5 for SERVER MODE: Accept incoming connection on the socket
r = accept( s, null, null )                  
If    r = socket_error Then closesocket(r):closesocket(s):generr
swap s,r
Closesocket(r)
'*******

'SERVER MODE now completed. Two-way connection established and ready.
GoTo beginchat
End If ' for If mode=2, way way up the screen


If mode=1 then   'This is if the user selected CLIENT MODE

'******* STEP 2 for CLIENT MODE: Define the socket details
    sa.sin_port         = htons( 8501 )
   sa.sin_family      = AF_INET
   sa.sin_addr.S_addr   = inet_addr(addy)
'*********************

color 15,0   
Print ""
Print "Connecting... hit ESCAPE to cancel...";
try=1

do
'****STEP 3 for CLIENT MODE: Connect the socket to the remote host
ncon = Connect( s, @sa, Len( sa ) )
If ncon<>socket_error then exit Do
'*****************
if inkey$=chr$(27) then try=31
try=try+1
if try>30 then exit do
Loop
 
if try>30 then
closesocket(s)
Print "Failed to connect. Hit any key to return."
sleep
goto s3
end if
color 7,0


'***** CLIENT MODE now completed. Two-way connection established and ready.
GoTo beginchat

End If 'for If Mode = 1
 

Beginchat:

If (myname$="User" or myname$="ServerUser") And mode=1 Then myname$="ClientUser"
If (myname$="User" or myname$="ClientUser") And mode=2 Then myname$="ServerUser"

'Tell the remote machine my display name and get its display name
outmessage=myname$
bsent=send (s, @outmessage,316,0)
if bsent=-1 then closesocket(s):generr

brec=recv(s,@inmessage,316,0)
If brec <=0 Then closesocket(s):generr
remotename$=Trim$(inmessage)

'Get remote IP Address
gpn=getpeername(s,@sc,@inip)
If gpn<>-1 then
ipparser=@sc.sin_addr.s_addr
remoteip$=str(ipparser[0])+"."+str(ipparser[1])+"."+str(ipparser[2])+"."+str(ipparser[3])
End if


Cls
Locate 1,1
Color 15,2:Print space$(79):locate 1,1
Print "Now chatting with "+remotename$+" ("+remoteip$+")"
Color 2,0
Print String$(79,Chr$(196))
Color 7,0

Locate 20,1:Print String$(79,Chr$(196))
Locate 21,1
Color 0,7:Print Space$(79)
Locate 21,1
Print "Type message below and hit ENTER to send. Hit ESCAPE to end chat."
Color 7,0

'create the thread to handle and print incoming messages
i = threadcreate( @mythread, i )


'This section handles outgoing messages
Normalstate:
textline=4

Do
c=22:p=1
Locate c,p
outmessage=brint$ 'brint$ is a function, see below
if chatfinished>0 then goto chatover

'Basic syntax for SEND command
bsent=send (s, @outmessage,316,0)

if bsent=-1 then closesocket(s):generr
trafficlight=yellow
View Print 3 To 18

If textline>18 Then
Locate 19,1:Print ""
Locate 19,1:Print ""
textline=18
End If

locate textline,1
Color 10,0
Print myname$;": ";
Color 14
Print Trim$(outmessage)
Color 7,0
textline=CsrLin+1
View Print 1 To 25
Locate 22,1:Print Space$(79);
Locate 23,1:Print Space$(79);
Locate 24,1:Print Space$(79);
Locate 25,1:Print Space$(79);
trafficlight=green
Loop


'Section handles chat termination by either side
chatover:
closesocket(s)
View Print 3 To 18

If textline>18 Then
Locate 19,1:Print ""
Locate 19,1:Print ""
textline=18
End If

locate textline,1
color 12
if chatfinished=1 then ?"Chat terminated. Hit ESCAPE to end session."
if chatfinished=2 then ?"Chat terminated by other side. Hit ESCAPE to end session."
while inkey$<>chr$(27):wend
trafficlight=green
while trafficlight=red:wend
chatfinished=0:trafficlight=green
view print 1 to 25
closesocket(s)
wsacleanup
goto s3



'This whole brint$ function just facilitates simultaneous typing of
'outgoing messages and receiving of incoming ones. It avoids the INPUT
'command which locks the program and all its threads.
function brint$()
tbrint$=""

Do
10:k$=inkey: if k$="" and chatfinished=0 then goto 10   
While trafficlight=red:Wend:if chatfinished=2 then exit function
trafficlight=yellow
If k$=Chr$(13) Then Exit Do
if k$=chr$(27) then chatfinished=1:goto chatover

if k$<>Chr$(8) And InStr(k$,Chr$(255))=0 Then
?k$;
tbrint$=tbrint$+k$
End If

if k$=chr$(8) Then

if pos=1 and csrlin<>22 then locate csrlin-1,80
Locate CsrLin, Pos-1:Print " ";
locate csrlin, pos-1
tbrint$=Left$(tbrint$,Len(tbrint$)-1)
end If
       
c=CsrLin:p=pos
if (len(tbrint$)=79 or len(tbrint$)=158 or len(tbrint$)=237) and k$<>chr$(8) then locate (csrlin+1),1
if len(tbrint$)=315 then exit do
trafficlight=green
Loop
brint$=tbrint$
trafficlight=green
End Function



'This sub thread handles and prints incoming messages
Sub mythread ( byval num as integer )
textline=4
Do
Locate c,p
trafficlight=green

'Basic syntax for RECV command
brec=recv(s,@inmessage,316,0)

While trafficlight=yellow:wend
trafficlight=red
If brec<1 Then chatfinished=2:trafficlight=green:exit sub
View Print 3 To 18

If textline>18 Then
Locate 19,1:Print ""
Locate 19,1:Print ""
textline=18
End If

locate textline,1
Color 9,0
Print remotename$;": ";
Color 15,0
Print Trim$(inmessage)
Color 7,0
textline=CsrLin+1
View Print 1 To 25
Loop   
End Sub


'Error section
Sub Generr
cls
Locate 10,0
color 15,0
?"There was a General Error of a General Nature, and the program"
?"could not continue. Because this is only a test program, specific"
?"error trapping has not been implemented. However for your interest,"
?"Winsock said:"
?""
?WSAGetLastError
?""
closesocket(s)
wsacleanup
?"Hit any key to exit the program..."
color 7,0
Sleep
end
end sub 

[Chronos]

I've modified the program a little bit to remember your chosen username. On first launch, the program asks you for your chosen username (though you can leave it as User if you want). It then opens a file (tcpchat.ini) and stores the username in that. On future loadings of the program it then retrieves your username. You can still change it in the usual manner (option 3), but this method makes it possible to allow users to have a consistient username.

If you want to see the modified code, please look in the topic I have started for my mod.

[cenozoite]

Hey Chronos,

Thanks for the reply.. I'll respond to your other question from earlier as well, which I'm guessing you edited out because you thought this was the wrong place to ask it, but I don't see a problem so here goes..

Remembering User names: Yes, probably a good idea for future convenience. I had considered using a random file to store the name, and perhaps the chatlog, and names and IP Addresses of recently-chatted-with friends, but decided for this release to keep it simple for tutorial purposes by not referencing any external files. If I thought/think anyone would actually use it to chat rather than just learn I'd reconsider all those features for sure ;)

Multi-user chat: Yes, that is possible as well. You'd just have to have a new socket opened for each chatter on each computer, and either a new thread for each socket to check them each independetly as in the current program, or else put all the sockets in that one existing thread and use SelectSocket to check them all sequentially for incoming messages. Outgoing messages would be sent to all open chat sockets sequentially as well.

Alternatively, one chatter could act as the "main switchboard" and relay any messages to all other chatters connected to him, but that makes that user act more like a genuine server, and if his connection is lost then all other chatters lose their connections to each other, which is not ideal.

Either way it is done, I would first have two users form a connection as is done currently, then let either one "invite" another person at another IP Address to join the chat, making it a three-person chat, and so on from there to as many as desired.

If anyone wants to add those features, go ahead and give it a shot, or wait for me to do it eventually...

[Rufus]

Thank you for making this tutorial available.

I would like to see more of this type of 'handholding' tutorial posted by FreeBASIC users who have already mastered using one or other of the many goodies which can be used with FB.

[cenozoite]

My pleasure... some aspects of FB can be mastered just by reading the docs, while other external goodies like API headers, which obviously can't be covered as extensively, require much trial and error to get right. If I can save other beginners some of that time and process, I'm glad...

[Rufus]

The Docs are not yet as extensive as they might be and will probably become.

I have mentioned the desirability of 'handholding' tutorials before. In that case it was with respect to using Insight + gdb. By putting together all the bits of information from a lot of different posts I eventually sorted it out, but I felt I was just re-inventing the wheel.

Getting it working with FB meant I could get it working with FreePascal which was a bonus.

[mjs]

1. It ONLY works well under the current STABLE release of FreeBasic, version 0.14b. There have been changes made in development versions of 0.15b that adversely affect the scrolling of the screen.

I'll fix this ASAP.

BTW: Nothing against you in person but the code is a mess. You MUST NOT use a GOTO to jump out of a FUNCTION! The results are unpredictable and will most likely cause stack/execution problems.

Regards,
Mark

[cenozoite]

I'll fix this ASAP.

I'm not exactly sure whether it's something you want to fix, or something you already did fix in 0.15b, and my program was just dependent on the "unfixed" previous version. Basically when I use "VIEW PRINT 3 to 18", under the old version it still lets me print on imaginary line 19 to cause a screen scroll. Under the new version imaginary line 19 just defaults to the first available line (3 in this case) and prints there. Like I said, not sure which behavior is considered more desirable, but I used the latter because it worked under 0.14b.

You MUST NOT use a GOTO to jump out of a FUNCTION! The results are unpredictable and will most likely cause stack/execution problems.

Ahhh.... that's one of those bugs I missed in the overhaul. The label that goto was calling (Chatover) used to be a label within that very same function, so it wasn't exiting the function when called. That label then did some things and exited the function properly. I'll fix that ASAP.

EDIT: Fixed, program code above now exits function properly rather than using GOTO.

[mjs]

To fix this, I threw away all those old crap for PRINT on Win32 and completely rewrote this stuff. You application now works as expected. It'll also fix some problems regarding embeeded CR, LF, or other control characters and VIEW PRINT.

Please wait a few hours until anonymous CVS on SF.net gets updated.

BTW: There are at least two more bugs in the source above:

Code: Select all

'**STEP 5 for SERVER MODE: Accept incoming connection on the socket
r = accept( s, null, null )                 
If    r = socket_error Then closesocket(r):closesocket(s):generr
swap s,r
Close(r)
'*******

should be:

Code: Select all

'**STEP 5 for SERVER MODE: Accept incoming connection on the socket
r = accept( s, null, null )                 
If    r = socket_error Then closesocket(s):generr
swap s,r
Closesocket(r)
'*******

It's a good idea to always turn on error checking (compiler switch -exx).

Regards,
Mark

[cenozoite]

Actually I compile directly from within FBIDE so it does tell me if there are any errors. Strangely it didn't react at all to the Close(r) rather than Closesocket(r). Not sure why.

But why did you remove the closesocket(r) from the other line? Closing a socket that's already closed/never-opened doesn't actually cause any trouble, so I often leave those commands in for reduncancy. It could never actually cause a bug/error.

As for the print stuff, do you mean you completely rewrote how the PRINT command itself works? Or just its complimentary commands like View Print etc?

Speaking of printing issues, one thing I noticed, which may or may not be intentional, is that in QB if you print something like:

Code: Select all

PRINT "Hello"+chr$(13)   'the carriage return
PRINT "There"

It will print those words on two different lines, meaning chr$(13) executes a line feed as well as a carriage return. In FB however, you also have to add a seperate line feed character, otherwise the cursor will just return to the beginning of the current line, and print over whatever's already there.

[mjs]

But why did you remove the closesocket(r) from the other line? Closing a socket that's already closed/never-opened doesn't actually cause any trouble, so I often leave those commands in for reduncancy. It could never actually cause a bug/error.

It will silently fail ... but it will fail to close an alrady closed socket.

As for the print stuff, do you mean you completely rewrote how the PRINT command itself works? Or just its complimentary commands like View Print etc?

I rewrote the way PRINT works on Win32. BTW: Using LOCATE to move the cursor to a row outside the screen (or the bounds set by VIEW PRINT) is a bug in your application. But I don't know why I don't get a run time error ... seems to be one more bug in the compiler I'll have to fix.

It will print those words on two different lines, meaning chr$(13) executes a line feed as well as a carriage return. In FB however, you also have to add a seperate line feed character, otherwise the cursor will just return to the beginning of the current line, and print over whatever's already there.

I guess that it's intentional. I assume that FBC works this way on all platforms.

Regards,
Mark

[cenozoite]

It will silently fail ... but it will fail to close an alrady closed socket.

Okay, that's what I thought. Since it doesn't actually create any error, I've left it as-is, in the source code. But anyone who prefers it gone can take note and remove it manually. It's on line 244 of the program.

BTW: Using LOCATE to move the cursor to a row outside the screen (or the bounds set by VIEW PRINT) is a bug in your application.

Hehe, if it doesn't produce an error it's not a bug, it's a quirk ;) If the next release of FB causes a bug when that's done, I'll change the code to use a different method. For now I'll leave my disclaimer in the notes that this version of the program only works for sure with stable 0.14b.

[mjs]

LOCATE can now throw an error. Changes are in CVS.

Regards,
Mark

[cenozoite]

LOCATE can now throw an error. Changes are in CVS.

Hehehehe.... certainly didn't let any grass grow under your feet implementing that change, did you? ;P

[Chronos]

OK, I guess it's official, I've been modding the tutorial, adding things as they popped into my head. Since they're based entirely on the tutorial source, though, I figured here was the place to post them. My eventual goal is to create a chat application that will support roleplaying through chat (much like IRC, but a bit more stylized and a lot simpler in function). I realise that I should really create my own application from information learned in the tutorial, but your tutorial actually does the things I was shooting for (simultanious chat/recieve primarily--I hadn't figured out a way to implement this effectively, and here you have--reinventing the wheel just feels like a waste, even if the core of the program is not my own). This is also why I was wondering about multi-user chat. For those that are interested, I've implemented a few IRC-like commands:

/roll (usually only available through a ChanServ bot, now built in) and
/me (emote functionality, using the standard "action delimiter" '*')

I guess, instead of just posting the code immediately, should I make my mod of this tutorial into a separate project? (It doesn't seem right for me to post my mods in this thread when my mods are for a practical application of the tutorial's functionality.)