RichardRussell
Full Member
Joined: 28 Jan 2012
Posts: 57
Location: Downham Market, UK
|
 Posted: May 6th, 2013, 9:59am Post subject: Simple Server/Client Chat Demo |
 |
|
On the Liberty BASIC Community Wiki there's a demo of using winsock to establish a client-server TCP connection. It's documented as being based on an 'Original program by Brent Thorn, Feb. 2004':
http://basic.wikispaces.com/wsock_demo
Unfortunately although the program appears to work correctly under Windows XP, it doesn't run under more recent versions of Windows, typically failing with an 'Invalid Argument' error. It turns out that there are multiple problems with the code, and it really ought never to have worked!
I have made the necessary changes and the program below seems to work on all versions of Windows including 8, at least back to Windows 2000 if not before.
| Code: | '*** Simple Server/Client Demo
'*** Richard Russell, May 2013
'*** Phil, April 2006
'*** Original program by Brent Thorn, Feb. 2004
'This is a simple "chat" type application.
'You can set up a server, then connect, and
'both sides can talk back and forth.
nomainwin
WindowWidth = 185
WindowHeight = 230
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
groupbox #main.groupbox2, "Mode", 5, 7, 165, 45
TextboxColor$ = "white"
textbox #main.textbox1, 5, 77, 155, 25
radiobutton #main.radiobutton3, "Client", [radiobutton3Set], [radiobuttonReset], 100, 22, 58, 25
radiobutton #main.radiobutton4, "Server", [radiobutton4Set], [radiobuttonReset], 15, 22, 65, 25
statictext #main.statictext5, "IP Address", 10, 57, 144, 20
button #main.button7,"Start",[button7Click], UL, 55, 167, 50, 25
statictext #main.scname1, "Display name:", 5, 107, 100, 20
textbox #main.scrname2, 5, 127, 155, 25
open "Chat" for window_nf as #main
print #main, "font ms_sans_serif 10"
print #main, "trapclose [quit.main]"
print #main.radiobutton3, "set"
wait
[radiobutton3Set]
server=0
print #main.textbox1, "!enable"
print #main.textbox1, "!show"
print #main.statictext5, "!enable"
wait
[radiobutton4Set]
server=1
print #main.textbox1, ""
print #main.textbox1, "!hide"
print #main.statictext5, "!disable"
wait
[radiobuttonReset]
wait
[quit.main]
close #main
end
[button7Click]
print #main.textbox1, "!contents? var$"
if server=0 and validip$(var$)="" then notice "Invalid IP Address":wait
print #main.scrname2, "!contents? name$"
if name$="" then notice "Please enter a display name":wait
close #main
addr$=validip$(var$)
for x=1 to 4
part$=word$(addr$,x)
part$=dechex$(val(part$))
if len(part$)=1 then part$="0"+part$
connaddr$=connaddr$+part$
next x
connaddr=hexdec(connaddr$)
global accepts
PORT = 4000
Open "wsock32" For DLL As #wsock32
Open "WMLiberty" For DLL As #wmlib
' Create a window.
WindowWidth = 400
WindowHeight = 400
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
TexteditorColor$ = "white"
texteditor #s.te, 10, 2, 370, 275
TextboxColor$ = "white"
textbox #s.t, 10, 287, 370, 25
button #s.s,"Send",[send], UL, 10, 317, 165, 25
button #s.c,"Clear",[clear], UL, 215, 317, 165, 25
open "Chat" for window_nf as #s
print #s, "font ms_sans_serif 10"
print #s.te, "!font system 10"
print #s.te, "!autoresize"
print #s.t, "!setfocus"
print #s, "trapclose [s_Close]"
' Now create a socket, bind it to a local port, set some
' network events to trap, and start listening for clients.
Call WinsockInit
Err = 1 ' Assume failure
If WSAStartup(MAKEWORD(2, 2)) = 0 Then
#s.te "> Winsock initialized."
sockaddr.sinfamily.struct = 2 'AF_INET
sockaddr.sinzero.struct = String$(8, 0)
sockaddr.sinport.struct = htons(PORT)
If sockaddr.sinport.struct <> -1 Then
if server = 1 then
sockaddr.sinaddr.struct = GetLocalIP()
else
sockaddr.sinaddr.struct = htonl(connaddr)
end if
If sockaddr.sinaddr.struct <> -1 Then
sock = socket(2, 1, 0) 'AF_INET=2:SOCK_STREAM=1
If sock <> -1 Then
#s.te "> Socket created."
Callback lpfnCB, SockProc( Long, Long, Long, Long ), Long
rc = SetWMHandler(HWnd(#s), _WM_USER, lpfnCB, 1)
'FD_READ=1:FD_WRITE=2:FD_OOB=4:FD_ACCEPT=8:FD_CONNECT=16:FD_CLOSE=32
flags=1 or 8 or 32
if server=0 then flags=flags or 16
If WSAAsyncSelect(sock, HWnd(#s), _WM_USER, flags) <> -1 Then
#s.te "> Events selected."
if server=1 then
if bind(sock) = 0 and listen(sock, 1) = 0 Then
#s.te "> Listening for incoming connections."
Err=0
end if
else
if connect(sock)=-1 and WSAGetLastError()=10035 then
#s.te "> Connect requested."
Err=0
end if
end if
End If
End If
End If
End If
End If
If Err Then
#s.te "> ERROR: "; GetWSAErrorString$(WSAGetLastError())
If sock <> -1 Then
rc = closesocket(sock)
End If
Else
if server=1 then
myip = GetLocalIP()
#s.te "> Clients connect to ["; InetNtoA$(myip); "]"
end if
End If
[s_Wait]
Scan
CallDLL #kernel32, "Sleep", _
1 As Long, _
rc As Void
GoTo [s_Wait]
[s_Close]
Call WSACleanup
Close #s
Close #wmlib
Close #wsock32
End
[send]
print #s.t, "!contents? var$"
if server=1 then
if Send(accepts,name$+"> "+var$+chr$(13),0)=-1 then #s.te "> ERROR: "; GetWSAErrorString$(WSAGetLastError())
else
if Send(sock,name$+"> "+var$+chr$(13),0)=-1 then #s.te "> ERROR: "; GetWSAErrorString$(WSAGetLastError())
end if
#s.te name$+"> "+var$
print #s.t, ""
goto [s_Wait]
[clear]
print #s.t, ""
print #s.t, "!setfocus"
goto [s_Wait]
'*** Application Procedures ***
Function SockProc( hWnd, uMsg, sock, lParam )
' Callback function to handle a Windows message
' forwarded by WMLiberty. Called when a relevant
' network event occurs.
Select Case LOWORD(lParam)
Case 1 'FD_READ
buf$ = Recv$(sock, 8192, 0)
do
i = instr(buf$, chr$(13))
if i then
#s.te woBang$(left$(buf$,i-1))
buf$ = mid$(buf$,i+1)
end if
loop until (i = 0)
#s.te woBang$(buf$);
Case 8 'FD_ACCEPT
accepts = accept(sock)
#s.te ">Socket: ";accepts
#s.te "> Accepted connection from "; _
InetNtoA$(sockaddr.sinaddr.struct); ":"; _
htons(sockaddr.sinport.struct); "."
case 16 'FD_CONNECT
if HIWORD(lParam)=0 then
#s.te "> Connect complete."
x=Send(sock,"Hi!"+chr$(13),0)
else
#s.te "> Connect failed."
end if
Case 32 'FD_CLOSE
#s.te "> Connection Closed."
End Select
SockProc=1
End Function
Sub WinsockInit
' Initializes structs used in Winsock calls.
Struct hostent, _
hname As Long, _
haliases As Long, _
haddrtype As Word, _
hlength As Word, _
haddrlist As Long
Struct sockaddr, _
sinfamily As Short, _
sinport As UShort, _
sinaddr As ULong, _
sinzero As Char[8]
Struct WSAData, _
wVersion As Word, _
wHighVersion As Word, _
szDescription As Char[257], _
szSystemStatus As Char[129], _
iMaxSockets As Word, _
iMaxUdpDg As Word, _
lpVendorInfo As Long
End Sub
Function woBang$( raw$ )
' Kludge to print a string that could start with an
' exclamation point, or bang (!). Am I missing something?
woBang$ = raw$
bangs = 0
While Mid$(raw$, bangs+1, 1) = "!"
bangs = bangs + 1
Wend
If bangs Then
bang$ = Left$(raw$, bangs)
woBang$ = Mid$(raw$, bangs+1)
#s.te "!Lines ln"
#s.te "!Line "; ln; " ln$"
#s.te "!Select "; Len(ln$)+1; " "; ln
#s.te "!Insert bang$"
#s.te "!Select 1 1"
End If
End Function
'*** General Procedures ***
Function LOWORD( dw )
LOWORD = (dw And 65535)
End Function
Function HIWORD( dw )
HIWORD = int((dw / 65536))
End Function
Function MAKEWORD( b1, b2 )
MAKEWORD = b1 Or (256 * b2)
End Function
Function String$( num, ch )
If num > 0 Then
String$ = Chr$(ch)
While Len(String$) < num
String$ = String$ + String$
Wend
String$ = Left$(String$, num)
End If
End Function
'*** Winsock Wrappers ***
Function GetHostByAddr$( addr )
Struct p, addr As ULong
p.addr.struct = addr
CallDLL #wsock32, "gethostbyaddr", _
p As Struct, _
4 As Long, _
2 As Long, _ 'AF_INET=2
phe As Long
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
GetHostByAddr$ = WinString(hostent.hname.struct)
End If
End Function
Function GetHostByName$( sName$ )
CallDLL #wsock32, "gethostbyname", _
sName$ As Ptr, _
phe As ULong
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
GetHostByName$ = WinString(hostent.hname.struct)
End If
End Function
Function GetHostName$()
buf$ = Space$(256)+Chr$(0)
CallDLL #wsock32, "gethostname", _
buf$ As Ptr, _
256 As Long, _
rc As Long
GetHostName$ = Trim$(buf$)
End Function
Function GetLocalIP()
sName$ = GetHostName$()
CallDLL #wsock32, "gethostbyname", _
sName$ As Ptr, _
phe As ULong
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
plong = hostent.haddrlist.struct
Struct p, addrlist As ULong
CallDLL #kernel32, "RtlMoveMemory", _
p As Struct, _
plong As ULong, _
4 As Long, _
rc As Void
plong = p.addrlist.struct
Struct p, addr As ULong
hlength = hostent.hlength.struct
CallDLL #kernel32, "RtlMoveMemory", _
p As Struct, _
plong As ULong, _
hlength As Long, _
rc As Void
GetLocalIP = p.addr.struct
End If
End Function
Function GetWSAErrorString$( errnum )
Select Case errnum
Case 10004: e$ = "Interrupted system call."
Case 10009: e$ = "Bad file number."
Case 10013: e$ = "Permission Denied."
Case 10014: e$ = "Bad Address."
Case 10022: e$ = "Invalid Argument."
Case 10024: e$ = "Too many open files."
Case 10035: e$ = "Operation would block."
Case 10036: e$ = "Operation now in progress."
Case 10037: e$ = "Operation already in progress."
Case 10038: e$ = "Socket operation on nonsocket."
Case 10039: e$ = "Destination address required."
Case 10040: e$ = "Message too long."
Case 10041: e$ = "Protocol wrong type for socket."
Case 10042: e$ = "Protocol not available."
Case 10043: e$ = "Protocol not supported."
Case 10044: e$ = "Socket type not supported."
Case 10045: e$ = "Operation not supported on socket."
Case 10046: e$ = "Protocol family not supported."
Case 10047: e$ = "Address family not supported by protocol family."
Case 10048: e$ = "Address already in use."
Case 10049: e$ = "Can't assign requested address."
Case 10050: e$ = "Network is down."
Case 10051: e$ = "Network is unreachable."
Case 10052: e$ = "Network dropped connection."
Case 10053: e$ = "Software caused connection abort."
Case 10054: e$ = "Connection reset by peer."
Case 10055: e$ = "No buffer space available."
Case 10056: e$ = "Socket is already connected."
Case 10057: e$ = "Socket is not connected."
Case 10058: e$ = "Can't send after socket shutdown."
Case 10059: e$ = "Too many references: can't splice."
Case 10060: e$ = "Connection timed out."
Case 10061: e$ = "Connection refused."
Case 10062: e$ = "Too many levels of symbolic links."
Case 10063: e$ = "File name too long."
Case 10064: e$ = "Host is down."
Case 10065: e$ = "No route to host."
Case 10066: e$ = "Directory not empty."
Case 10067: e$ = "Too many processes."
Case 10068: e$ = "Too many users."
Case 10069: e$ = "Disk quota exceeded."
Case 10070: e$ = "Stale NFS file handle."
Case 10071: e$ = "Too many levels of remote in path."
Case 10091: e$ = "Network subsystem is unusable."
Case 10092: e$ = "Winsock DLL cannot support this application."
Case 10093: e$ = "Winsock not initialized."
Case 10101: e$ = "Disconnect."
Case 11001: e$ = "Host not found."
Case 11002: e$ = "Nonauthoritative host not found."
Case 11003: e$ = "Nonrecoverable error."
Case 11004: e$ = "Valid name, no data record of requested type."
Case Else: e$ = "Unknown error "; errnum; "."
End Select
GetWSAErrorString$ = e$
End Function
Function InetNtoA$( inaddr )
CallDLL #wsock32, "inet_ntoa", _
inaddr As ULong, _
pstr As ULong
InetNtoA$ = WinString(pstr)
End Function
Function Recv$( s, buflen, flags )
Recv$ = Space$(buflen)+Chr$(0)
CallDLL #wsock32, "recv", _
s As Long, _
Recv$ As Ptr, _
buflen As Long, _
flags As Long, _
buflen As Long
Recv$ = Left$(Recv$, buflen)
End Function
Function Send( s, buf$, flags )
buflen=len(buf$)
CallDLL #wsock32, "send", _
s As Long, _
buf$ As Ptr, _
buflen As Long, _
flags As Long, _
Send As Long
End Function
'*** Winsock Thin Wrappers ***
Function accept( s )
Struct p, length As Long
p.length.struct = Len(sockaddr.struct)
CallDLL #wsock32, "accept", _
s As Long, _
sockaddr As Struct, _
p As Struct, _
accept As Long
End Function
Function bind( s )
namelen = Len(sockaddr.struct)
CallDLL #wsock32, "bind", _
s As Long, _
sockaddr As Struct, _
namelen As Long, _
bind As Long
End Function
Function closesocket( s )
CallDLL #wsock32, "closesocket", _
s As Long, _
closesocket As Long
End Function
Function htonl( hostlong )
CallDLL #wsock32, "htonl", _
hostlong As ULong, _
htonl As ULong
End Function
Function htons( hostshort )
CallDLL #wsock32, "htons", _
hostshort As Word, _
htons As Word
End Function
Function inetaddr( cp$ )
CallDLL #wsock32, "inet_addr", _
cp$ As Ptr, _
inetaddr As ULong
End Function
Function listen( s, backlog )
CallDLL #wsock32, "listen", _
s As Long, _
backlog As Long, _
listen As Long
End Function
Function socket( af, type, protocol )
CallDLL #wsock32, "socket", _
af As Long, _
type As Long, _
protocol As Long, _
socket As Long
End Function
Function WSAAsyncSelect( s, hWnd, wMsg, lEvent )
CallDLL #wsock32, "WSAAsyncSelect", _
s As Long, _
hWnd As ULong, _
wMsg As ULong, _
lEvent As Long, _
WSAAsyncSelect As Long
End Function
Sub WSACleanup
CallDLL #wsock32, "WSACleanup", _
r As Void
End Sub
Function WSAGetLastError()
CallDLL #wsock32, "WSAGetLastError", _
WSAGetLastError As Long
End Function
Function WSAStartup( wVersionRequested )
CallDLL #wsock32, "WSAStartup", _
wVersionRequested As Word, _
WSAData As Struct, _
WSAStartup As Long
End Function
Function connect( s )
namelen = Len(sockaddr.struct)
CallDLL #wsock32, "connect", _
s As Long, _
sockaddr As Struct, _
namelen As Long, _
connect As Long
End Function
'*** WMLiberty Thin Wrappers ***
Function SetWMHandler( hWnd, uMsg, lpfnCB, lSuccess )
CallDLL #wmlib, "SetWMHandler", _
hWnd As Long, _
uMsg As Long, _
lpfnCB As Long, _
lSuccess As Long, _
SetWMHandler As Long
End Function
function validip$(var$)
fail=0
for x=1 to len(var$)
if mid$(var$,x,1)="." then var$=left$(var$,x-1)+" "+right$(var$,len(var$)-x)
next x
if word$(var$,5)<>"" then goto [endoffuncvalidip]
if word$(var$,4)="" then goto [endoffuncvalidip]
for x=1 to 4
buf$=word$(var$,x)
buf$=trim$(buf$)
if len(buf$)>3 then fail=1
if val(buf$)=0 and buf$<>"0" then fail=1
next x
if fail=0 then validip$=var$
[endoffuncvalidip]
end function |
|
|
FAQ
Search
Usergroups
Register
Profile
Log in to check your private messages
Log in
