11-01-2005, 12:48 AM
This is a greatly revised version of my original FreeBASIC Winsock Tutorial/Chat Program. It ONLY works with version 0.15 of FB, and will not function correctly with earlier versions including 0.14.
The code is much simpler and more straightforward than in the original, and no longer uses the more complicated Thread method, now that a bug from FB 0.14 has been corrected. As such it should be easier for beginners to understand.
Any questions or comments are as always welcome
The code is much simpler and more straightforward than in the original, and no longer uses the more complicated Thread method, now that a bug from FB 0.14 has been corrected. As such it should be easier for beginners to understand.
Any questions or comments are as always welcome
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
'socket sand 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
Declare Sub GetMyIp
Declare Sub Generr
Common shared s as socket, r as socket, q as socket
Common Shared sa as sockaddr_in, sb as sockaddr_in, sc As sockaddr_in, sd as sockaddr_in
Common Shared inmessage As zString*316, outmessage As zString *316
Common Shared myname$,remotename$,c,p,textline,chatfinished
Common Shared fdset As fd_set, tv As timeval
Common Shared hostname as string * 256, hostentry as HOSTENT ptr
Common Shared pinaddr as pin_addr, localip as zstring ptr, ipparser as ubyte ptr
Const NEWLINE = "\r\n"
Dim wsad as WSAData
Dim addy as String
Dim inip As Integer
inip=sizeof(sc)
tv.tv_Sec = 0: tv.tv_Usec = 1000
myname$="User"
MenuStart:
'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
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"
Makeachoice:
Sleep
choice$=inkey$:choice=Val(choice$)
if choice$=chr$(27) then choice=4
If choice<1 Or choice>4 Then GoTo Makeachoice
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 MenuStart
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 MenuStart
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 and 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 'If the user selected SERVER MODE
Call GetMyIp 'This is a helpful but totally optional Sub
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
FD_ZERO (@fdset)
FD_SET_ (s,@fdset)
nRet = selectsocket( 3, @fdset, NULL, NULL, @tv )
if nret>0 then exit do
loop
if esclause=1 then esclause=0:closesocket (s):goto MenuStart
'****************
'**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)
'*******
'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 '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 MenuStart
end if
color 7,0
' CLIENT MODE now completed. Two-way connection established and ready.
GoTo beginchat
End If 'for If Mode = 1, up the screen
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
'Set up the chat screen
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
'This is where the chat begins, and incoming and outgoing messages
'are processed. It's a two-part infinite loop that runs continuously,
'with Part 1 checking for, receiving, and printing incoming messages,
'and Part 2 checking for, printing, and sending outgoing messages,
'over, and over, and over again.
Normalstate:
textline=4
c=22:p=1
Do
'Part 1 of 2, Incoming Message Check
FD_ZERO(@fdset)
FD_SET_ (s,@fdset)
if (selectsocket( 3, @fdset, NULL, NULL, @tv ))>0 then
'Basic syntax for RECV command
brec=recv(s,@inmessage,316,0)
If brec<1 Then chatfinished=2:exit do
View Print 3 To 18
If textline>18 Then
Locate 18,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
End If ' The SelectSocket Check
'Part 2 of 2, Outgoing Text/Message Check
k$=Inkey$
If k$<>"" then
locate c,p
'If User types a valid alphanumeric key
If k$<>Chr$(8) And k$<>chr$(13) and k$<>chr$(27) and InStr(k$,Chr$(255))=0 Then
Locate c,p
Print k$;
tempmessage$=tempmessage$+k$
End If
'If User hits backspace
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
tempmessage$=Left$(tempmessage$,Len(tempmessage$)-1)
end If
if (len(tempmessage$)=79 or len(tempmessage$)=158 or len(tempmessage$)=237) and k$<>chr$(8) then locate (csrlin+1),1
if len(tempmessage$)=315 then k$=chr$(13) 'Force end of message
c=CsrLin:p=pos
'If User hits escape
if k$=chr$(27) then chatfinished=1:exit do
'If User hits Enter (print and send the message)
If k$=Chr$(13) and trim$(tempmessage$)<>"" Then
outmessage=tempmessage$
tempmessage$=""
c=22:p=1
View Print 3 To 18
If textline>18 Then
Locate 18,1:Print ""
textline=18
End If
locate textline,1
Color 10,0
?myname$;": ";
color 14,0
?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);
'Basic syntax for SEND command
bsent=send (s, @outmessage,316,0)
if bsent=-1 then closesocket(s):generr
End If 'for If User hits Enter
End If 'For User hits a key
Loop
'End of main chat section
'Section handles chat termination by either side
chatover:
closesocket(s)
View Print 3 To 18
If textline>18 Then
Locate 18,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
chatfinished=0
view print 1 to 25
closesocket(s)
wsacleanup
goto MenuStart
Sub GetMyIP
'***This subroutine attempts to determine user's IP Address
'automatically, using two methods. First uses the direct Gethostname
'method, and as a backup, checks a website to get the public IP if
'it's different from local. Entirely optional.
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
ghn=GetHostName(@hostname, 256)
hostentry = gethostbyname( hostname )
'Standard Winsock method of getting IP Address from hostentry:
pinaddr=hostentry->h_addr
localip=inet_ntoa(*pinaddr)
myip$=*localip
'Alternate method of getting IP Address from hostentry. To use this
'method, comment the above three active code lines, and uncomment
'the two here below:
'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 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:"
?""
?"Error code ";WSAGetLastError
?""
closesocket(s)
wsacleanup
?"Hit any key to exit the program..."
color 7,0
Sleep
end
end sub
![[Image: style4,TheDarkJay.png]](http://www.sloganizer.net/en/style4,TheDarkJay.png)
[/url]
![[Image: sig.php]](http://josh.whtiger.net/images/sig.php)
