09-13-2005, 01:37 AM
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.
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:
'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