Nice to see a complete API network code. But I just want to add that there is no error handling in this code for sending and receiving datas. For use internet this is highly recomanded.
Example:
bytesSent = send_(clientsocket, @sendbuf, Len(sendbuf), 0
You check for BytesSent but never compare this with len(sendbuf) in your code. Why? It could be possible that you need to call send_ again and again to send your string completely. Anyway, a socket_error could be returned by send_() and you have to use lasterror() to check for it.
For sending strings I use an own code where I added a header to the datapacket with the length of the string.
Here is an example for networking ive done with PB one year ago. It should work in 3.91 too.
This is the correct way of sending and receiving datas.
Server:
Code: Select all
; Chat Server X-Ample by Mike Delling
;
; With complete documentation for correctly networking in PB. :o)
If InitNetwork()=0
MessageRequester("","Could not initialize WSA.",0)
End
EndIf
hServer=CreateNetworkServer(6000)
If hServer=0
MessageRequester("","Could not open server.",0)
EndIf
hWin=OpenWindow(0,0,0,0,0,#PB_Window_Invisible,"")
If hWin=0
MessageRequester("","Could not open window.",0)
End
EndIf
; -----------------------------------------
: Dimenstions & Structures & Constants
; -----------------------------------------
Structure slot
socket.l ; Socket Number of User
nickname.s ; Prior and Alternative Nickname of User
*receivebuffer.l ; Pointer to Receivebuffer
totalreceived.l ; Read-Buffer Position
receiveexpected.l ; Wait for this size!
EndStructure
#NetworkEvent = #WM_User +1 ; For incomeing events from server
#MaxCommands = 10
#MaxUser = 100
#BufferSize = 12000
Dim commands$(#MaxCommands)
Dim slot.slot(#MaxUser)
; -----------------------------------------
; Some Procedures
; -----------------------------------------
Procedure.w MyGetCommand(a$)
For a = 0 To #MaxCommands : commands$(a) = "" : Next
len = Len(a$) : ak = 1
;
Repeat
letter$ = Mid(a$,ak,2)
If letter$ <> "@!"
letter$ = Mid(a$,ak,1)
commands$(akcommand)+letter$ : ak + 1
EndIf
;
If letter$ = "@!"
akcommand + 1 : ak + 2
EndIf
Until ak >= len
;
ProcedureReturn akcommand
EndProcedure
;-----------------------------------
; PROC - Send Datas through network
;-----------------------------------
Procedure MySend(id,txt$)
; calculate bufferlength
length.l=Len(txt$)+1 ; String + EOL
length.l+4 ; Packet length at beginning
length.l+4 ; CRC32
*mem.l=GlobalAlloc_(#GMEM_FIXED | #GMEM_ZEROINIT, length.l)
PokeL(*mem.l,length.l) ; Store the Header (Size of Packet)
PokeS(*mem.l+4,txt$) ; Store String (Datas)
crc.l=CRC32Fingerprint(*mem.l+4,length.l-8) ; Create CRC32 Checksum
PokeL(*mem.l+length.l-4,crc.l) ; Store it at the end of the packet
Repeat ; Loop for Datasend
send=send_(id,*mem.l,length,0) ; Send our Datas
sended+send ; Count our sended Bytes
If send=#SOCKET_ERROR
wsaerror=wsagetlasterror_()
If wsaerror=#WSANOTINITIALISED:err$="Wsa not initialized":EndIf
If wsaerror=#WSAENETDOWN :err$="The Windows Sockets implementation has detected that the network subsystem has failed.":EndIf
If wsaerror=#WSAENOTCONN :err$="Socket not connected.":EndIf
If wsaerror=#WSAEINTR :err$="The (blocking) call was canceled using WSACancelBlocking":EndIf
If wsaerror=#WSAEINPROGRESS :err$="A blocking Windows Sockets operation is in progress.":EndIf
If wsaerror=#WSAENOTSOCK :err$="The descriptor is not a socket.":EndIf
If wsaerror=#WSAEOPNOTSUPP :err$="MSG_OOB was specified, but the socket is not of type SOCK_STREAM.":EndIf
If wsaerror=#WSAESHUTDOWN :err$="The socket has been shut down; it is not possible to recv on a socket after shutdown has been invoked with how set to 0 or 2.":EndIf
If wsaerror=#WSAEMSGSIZE :err$="The datagram was too large to fit into the specified buffer and was truncated.":EndIf
If wsaerror=#WSAEINVAL :err$="The socket has not been bound with bind.":EndIf
If wsaerror=#WSAECONNABORTED :err$="The virtual circuit was aborted due to timeout or other failure.":EndIf
If wsaerror=#WSAECONNRESET :err$="The virtual circuit was reset by the remote side.":EndIf
If wsaerror=#WSAEWOULDBLOCK :err$="The socket is marked as nonblocking":EndIf
If wsaerror=#WSAEWOULDBLOCK:send=0:sended=0:Delay(250):EndIf
EndIf ; Errorcheck
Until sended>=length Or send=#SOCKET_ERROR ; Loop as long as all Datas has been send
GlobalFree_(*mem) ; Free our Memory again
ProcedureReturn send
EndProcedure
If WSAAsyncSelect_(hServer,hWin,#NetworkEvent,#FD_ACCEPT|#FD_READ|#FD_CLOSE)<>0
MessageRequester("","Could not catch events!",0)
EndIf
Procedure findfreeslot()
result=-1
Repeat
If slot(ak)\socket=0 ; no Socket here, so the slot is free
result=ak
Else
ak+1
EndIf
Until ak=#MaxUser Or result>=0
ProcedureReturn result
EndProcedure
Procedure finduser(id)
result=-1
Repeat
If slot(ak)\socket=id
result=ak
Else
ak+1
EndIf
Until ak=#MaxUSer Or result=>0
ProcedureReturn result
EndProcedure
OpenConsole()
PrintN("Server running...")
Repeat
winevent=WaitWindowEvent()
If winevent=#NetworkEvent ; Incoming connection/ Datas
netevent=NetworkServerEvent() ; This command updates the NetworkClientID() Command
id=NetworkClientID()
If netevent=1
slot=findfreeslot()
slot(slot)\socket=id ; We assign the user to show that this socket is in use
slot(slot)\receivebuffer=GlobalAlloc_(#GMEM_FIXED | #GMEM_ZEROINIT, #Buffersize) ; We are in need of some memory for our user
PrintN("Incoming connection on socket "+Str(id)+" on slot "+Str(slot))
EndIf
If netevent=4 ; User disconnect, free mem and slot
slot=finduser(id)
PrintN("Slot "+Str(slot)+" free again.Socket "+Str(slot(slot)\socket)+" closed.")
slot(slot)\socket=0
globalfree_(slot(slot)\receivebuffer)
EndIf
If netevent=2 ; Datas received
; We have to find out the slot for the user who send us the datas
slot=finduser(id)
If slot(slot)\receiveexpected>0
*receivebuffer=slot(slot)\receivebuffer
received=recv_(id,*receivebuffer+slot(slot)\totalreceived,slot(slot)\receiveexpected-slot(slot)\totalreceived,0)
If received<>#SOCKET_ERROR
slot(slot)\totalreceived+received
If slot(slot)\totalreceived=slot(slot)\receiveexpected
command$=PeekS(*receivebuffer+4) ; Get our Command-String from Memorybuffer
anz=MyGetCommand(command$) ; Tokanize our Command-String
slot(slot)\totalreceived=0 ; Datapacket complete, reset value and wait for new one
slot(slot)\receiveexpected=-1 ; Wait for new packetheader but do not execute the next part!
; Commandprozessing follows here:
If commands$(0)="STRG" ; User sends a Chatstring, send it to all other clients
For ak=0 To #MaxUser
If slot(ak)\socket<>0 And slot(ak)\socket<>id
res=mysend(slot(ak)\socket,"STRG@!"+commands$(1)+"@!"+commands$(2)+"@!")
PrintN("Send message to socket:"+Str(slot(ak)\socket))
EndIf
Next ak
EndIf
If commands$(0)="ENTR"
slot=finduser(id)
slot(slot)\nickname = commands$(1)
For ak=0 To #MaxUser
If slot(ak)\socket<>0 And slot(ak)\socket<>id
res=mysend(slot(ak)\socket,"ENTR@!"+commands$(1)+"@!")
PrintN("Send ENTR message to socket:"+Str(slot(ak)\socket))
EndIf
Next ak
EndIf
; End Command STRG
EndIf
EndIf
EndIf ; End Receive Datas
If slot(slot)\totalreceived<3 And slot(slot)\receiveexpected=0 ; Unknown headersize, get header first
*receivebuffer=slot(slot)\receivebuffer
received=recv_(id,*receivebuffer+slot(slot)\totalreceived,4-slot(slot)\totalreceived,0)
If received<>#SOCKET_ERROR
If received=4:slot(slot)\receiveexpected=PeekL(*receivebuffer):EndIf ; Grad HeaderSize
slot(slot)\totalreceived+received
EndIf
EndIf
If slot(slot)\receiveexpected=-1:slot(slot)\receiveexpected=0:EndIf
EndIf ; Datas received
EndIf ; End Networkevent
Until esc=1
; ExecutableFormat=Windows
; CursorPosition=28
; FirstLine=1
; Executable=D:\server.exe
; DisableDebugger
; EOF
Client:
Code: Select all
; Chat Server X-Ample by Mike Delling
;
; With complete documentation for correctly networking in PB. :o)
If InitNetwork()=0
MessageRequester("","Could not initialize WSA.",0)
End
EndIf
hWin=OpenWindow(0,0,0,600,200,#PB_Window_ScreenCentered|#PB_Window_SystemMenu,"PB Chat Client")
If hWin=0
MessageRequester("","Could not open window.",0)
End
EndIf
If CreateGadgetList(hWin)=0
MessageRequester("","Could not Create Gadgetlist.",0)
EndIf
; -----------------------------------------
: Dimenstions & Structures & Constants
; -----------------------------------------
#NetworkEvent = #WM_User +1 ; For incomeing events from server
#MaxCommands = 10
#Maxlines = 1024
Dim commands$(#MaxCommands)
*receivebuffer=GlobalAlloc_(#GMEM_FIXED | #GMEM_ZEROINIT, 12000)
; -----------------------------------------
; Some Procedures
; -----------------------------------------
Procedure.w MyGetCommand(a$)
For a = 0 To #MaxCommands : commands$(a) = "" : Next
len = Len(a$) : ak = 1
;
Repeat
letter$ = Mid(a$,ak,2)
If letter$ <> "@!"
letter$ = Mid(a$,ak,1)
commands$(akcommand)+letter$ : ak + 1
EndIf
;
If letter$ = "@!"
akcommand + 1 : ak + 2
EndIf
Until ak >= len
;
ProcedureReturn akcommand
EndProcedure
;-----------------------------------
; PROC - Send Datas through network
;-----------------------------------
Procedure MySend(id,txt$)
; calculate bufferlength
length.l=Len(txt$)+1 ; String + EOL
length.l+4 ; Packet length at beginning
length.l+4 ; CRC32
*mem.l=GlobalAlloc_(#GMEM_FIXED | #GMEM_ZEROINIT, length.l)
PokeL(*mem.l,length.l) ; Store the Header (Size of Packet)
PokeS(*mem.l+4,txt$) ; Store String (Datas)
crc.l=CRC32Fingerprint(*mem.l+4,length.l-8) ; Create CRC32 Checksum
PokeL(*mem.l+length.l-4,crc.l) ; Store it at the end of the packet
Repeat ; Loop for Datasend
send=send_(id,*mem.l,length,0) ; Send our Datas
sended+send ; Count our sended Bytes
If send=#SOCKET_ERROR
wsaerror=wsagetlasterror_()
If wsaerror=#WSANOTINITIALISED:err$="Wsa not initialized":EndIf
If wsaerror=#WSAENETDOWN :err$="The Windows Sockets implementation has detected that the network subsystem has failed.":EndIf
If wsaerror=#WSAENOTCONN :err$="Socket not connected.":EndIf
If wsaerror=#WSAEINTR :err$="The (blocking) call was canceled using WSACancelBlocking":EndIf
If wsaerror=#WSAEINPROGRESS :err$="A blocking Windows Sockets operation is in progress.":EndIf
If wsaerror=#WSAENOTSOCK :err$="The descriptor is not a socket.":EndIf
If wsaerror=#WSAEOPNOTSUPP :err$="MSG_OOB was specified, but the socket is not of type SOCK_STREAM.":EndIf
If wsaerror=#WSAESHUTDOWN :err$="The socket has been shut down; it is not possible to recv on a socket after shutdown has been invoked with how set to 0 or 2.":EndIf
If wsaerror=#WSAEMSGSIZE :err$="The datagram was too large to fit into the specified buffer and was truncated.":EndIf
If wsaerror=#WSAEINVAL :err$="The socket has not been bound with bind.":EndIf
If wsaerror=#WSAECONNABORTED :err$="The virtual circuit was aborted due to timeout or other failure.":EndIf
If wsaerror=#WSAECONNRESET :err$="The virtual circuit was reset by the remote side.":EndIf
If wsaerror=#WSAEWOULDBLOCK :err$="The socket is marked as nonblocking":EndIf
If wsaerror=#WSAEWOULDBLOCK:send=0:sended=0:Delay(250):EndIf
EndIf ; Errorcheck
Until sended>=length Or send=#SOCKET_ERROR ; Loop as long as all Datas has been send
GlobalFree_(*mem) ; Free our Memory again
ProcedureReturn send
EndProcedure
#HostIPText = 1
#HostString = 2
#NickText = 3
#NickString = 4
#Connect = 5
#ChatWindow = 6
#ChatText = 7
#Send = 8
#ReturnKey = 1
TextGadget (#HostIPText,10,13,50,20,"Host/IP:")
StringGadget (#HostString,70,10,150,20,"127.0.0.1")
TextGadget (#NickText,230,13,50,20,"Nickname:")
StringGadget (#NickString,290,10,150,20,"Eliot")
ButtonGadget (#Connect,450,10,100,20,"Connect")
ListIconGadget(#ChatWindow,10,40,580,120,"",500)
StringGadget (#ChatText,10,170,500,20,"")
ButtonGadget (#Send,520,170,70,20,"Send"):AddKeyboardShortcut(0,#PB_Shortcut_Return,#ReturnKey)
Procedure showmsg(msg$)
Shared lines,maxlines
AddGadgetItem(#ChatWindow,lines,msg$)
SendMessage_(GadgetID(#ChatWindow),#LVM_ENSUREVISIBLE,lines,1)
lines+1
EndProcedure
Procedure window(WindowID, Message, wParam, lParam)
Shared hSocket,*receivebuffer.l,totalreceived.l,receiveexpected.l,received
Result = #PB_ProcessPureBasicEvents
; Handle Networkevents here
If Message=#NetworkEvent
serverevent=NetworkClientEvent(hSocket) ; What happens?
If serverevent=2 ; Rawdata received (2 is described by the PB Manual)
If receiveexpected>0
received=recv_(hSocket,*receivebuffer.l+totalreceived.l,receiveexpected-totalreceived,0)
If received<>#SOCKET_ERROR
If received>0:totalreceived+received:EndIf
If totalreceived=PeekL(*receivebuffer.l) ; Is our packet complete?
command$=PeekS(*receivebuffer+4) ; Get our Command-String from Memorybuffer
anz=MyGetCommand(command$) ; Tokanize our Command-String
totalreceived=0 ; Datapacket complete, reset value and wait for new one
receiveexpected=-1 ; Wait for new packetheader but do not execute the next part!
; Message Processing here
If commands$(0)="STRG"
;AddGadgetItem(#ChatWindow,-1,commands$(1)+" > "+commands$(2))
showmsg(commands$(1)+" > "+commands$(2))
EndIf
If commands$(0)="ENTR"
;AddGadgetItem(#ChatWindow,-1,commands$(1)+" entered the chat.")
showmsg(commands$(1)+" entered the chat.")
EndIf
EndIf
EndIf
EndIf
If totalreceived<3 And receiveexpected=0 ; Receive our Packetheader till it is complete
received=recv_(hSocket,*receivebuffer+totalreceived,4-totalreceived,0) ; Receive TCP/IP Buffer (max. 4 Bytes)
If received<>#SOCKET_ERROR
If received=4
receiveexpected=PeekL(*receivebuffer)
EndIf ; Completed yet?
If received>0:totalreceived+received:EndIf ; Count our Received bytes (we need 4!)
commands$(0)="" ; Erase our String to avoid multihandling
EndIf
EndIf
If receiveexpected=-1:receiveexpected=0:EndIf ; Ready to receive next dataheader again!!
EndIf ; End RAW Data receive
EndIf
ProcedureReturn Result
EndProcedure
SetWindowCallback(@window())
Repeat
winevent.l=WaitWindowEvent() ; Get Window-Event ID
wineventgadget.l=EventGadgetID() ; Get Gadget-Event ID
wineventtype=EventType() ; Get Windows Event Type
winid=EventWindowID() ; Get window where the event occurs
winmenu=EventMenuID() ; Get MenuID
lastgadget.l=wineventgadget.l
; Handle Windowevents here
If winevent.l=#PB_Event_Menu ; Menuchecking for keyboard shortcuts
If winmenu=#Returnkey
If LCase(GetGadgetText(#Chattext))="send"
nick$=InputRequester("Send File to user...","Please type in the nickname of user:","")
file$=OpenFileRequester("Select file to send to "+nick$,"","*.*","")
mysend(hSocket,"FILE@!"+nick$+"@!"+file$+"@!"+StrU(FileSize(file$),#Long)+"@!")
EndIf
If mysend(hSocket,"STRG@!"+GetGadgetText(#NickString)+"@!"+GetGadgetText(#Chattext)+"@!")=#SOCKET_ERROR
showmsg("Could not send String.")
; AddGadgetItem(#ChatWindow,-1,"Could not send String.")
Else
;AddGadgetItem(#ChatWindow,-1,GetGadgetText(#NickString)+" > "+GetGadgetText(#Chattext))
showmsg(GetGadgetText(#NickString)+" > "+GetGadgetText(#Chattext))
SetGadgetText(#ChatText,"")
EndIf
EndIf
EndIf
If winevent.l=#PB_Event_Gadget ; Any Gadgetevent here?
If wineventgadget=#Connect ; User try to connect
hSocket=OpenNetworkConnection(GetGadgetText(#HostString),6000)
If hSocket=0
MessageRequester("","Could not connect to server.",0)
Else
; Connection successfull, add a Usermessage to the Window
WSAAsyncSelect_(hSocket,hWin,#NetworkEvent,#FD_READ | #FD_Write |#FD_OOB)
mysend(hSocket,"ENTR@!"+GetGadgetText(#NickString)+"@!")
;AddGadgetItem(#ChatWindow,-1,"Connected to server.")
showmsg("Connected to server.")
; We are now successfully connected
EndIf
EndIf ; End Connect
If wineventgadget=#Send
If mysend(hSocket,"STRG@!"+GetGadgetText(#NickString)+"@!"+GetGadgetText(#Chattext)+"@!")=#SOCKET_ERROR
AddGadgetItem(#ChatWindow,-1,"Could not send String.")
Else
;AddGadgetItem(#ChatWindow,-1,GetGadgetText(#NickString)+" > "+GetGadgetText(#Chattext))
showmsg(GetGadgetText(#NickString)+" > "+GetGadgetText(#Chattext))
SetGadgetText(#ChatText,"")
EndIf
EndIf
EndIf ; End gadgetevents condition
Until winevent=#PB_Event_CloseWindow
End
Sorry for huge sources.
)
Mike
