' ***************************************************
' * g_net.bas *
' * UDP/IP support for GMT *
' * compiles to g_net.dll *
' * This module requires WinSock2/ ws2_32.dll *
' * Version 10.09 *
' ***************************************************
' 20.11.2002: start of research into network support for GMT
' should become a specific dll for network support
' 22.11.2002: UDP/IP broadcast system up and working.
' 23.11.2002: Receive system working.
' 24.11.2002: classic problems with thread functions undermining GMT speed...
' 04.12.2002: IP lookup improved.
' 06.12.2002: runs very well on Win2000 and XP systems.
' UDP send under Win98 and Millennium is problematic...
' maybe we cannot use UDP/IP bidirectionally under these OS's...
' 12.12.2002: Flaw discovered in Windows: we cannot call any timerfunction with a
' callback of its own from within the UDP callback used here.
' Hence relay to midi-out does work, but robot controll does not!
'03.01.2003: kl: now you can put a server port and ports for output to other apps on the same computer
' I/O should allways work if different ports are used ..? (to be tested..)
'30.01.2003: solved some small bugs. bidirectional UDP should work now (tested between tox <> pak, gmt <> pd)
' function g_net_setServercptr added to allow custom callback
'15.12.2004: may cause problems on large and server-controlled networks (Hogent...)
'05.03.2005: adapted to PBWIN 8.00
'20.12.2006: Start reconsideration, for we want to equip our robots with network ports...
'31.08.2008: adapted to compiler PB9.0
'02.06.2009: refs to non required libs removed.
'09.04.2012: recompiled PB10.03
#COMPILE DLL "g_net.dll"
#OPTION VERSION5
'#REGISTER ALL
#DIM ALL
#INCLUDE ONCE "..\winapi\g_win.inc"
#INCLUDE ONCE "g_kons.bi" ' integer and string constants
#INCLUDE ONCE "g_type.bi" ' structures, user defined types
#INCLUDE ONCE "g_indep.bi" ' required
#INCLUDE ONCE "g_file.bi" ' required
#INCLUDE ONCE "g_lib.bi" ' required
'%gnet_dbg = 1
#IF %DEF(%gnet_dbg)
#IF NOT %DEF(%kl_dbg_included)
#INCLUDE ONCE "C:\b\pb\gmt\kristof\kl_debug.inc"
GLOBAL insdbg AS LONG
#ENDIF
#ENDIF
' added to g_win.inc:
' WinSock 2 extension -- bit values and indices for FD_XXX network events
' moved to g_win.inc 15.12.2005 gwr.
' why not wsock32.dll ??
DECLARE FUNCTION gethostbyname LIB "ws2_32.dll" ALIAS "gethostbyname" (hname AS ASCIIZ) AS DWORD
DECLARE FUNCTION WSAStartup LIB "ws2_32.dll" ALIAS "WSAStartup" (BYVAL wVR AS WORD, lpWSAD AS WSADATA) AS LONG
DECLARE FUNCTION WSACleanup LIB "ws2_32.dll" ALIAS "WSACleanup" () AS LONG
DECLARE SUB WSASetLastError LIB "ws2_32.dll" ALIAS "WSASetLastError" (BYVAL iError AS LONG)
DECLARE FUNCTION WSAGetLastError LIB "ws2_32.dll" ALIAS "WSAGetLastError" () AS LONG
' compiles o.k. but to no advantage, problems on Millennium and win98 remain.
'DECLARE FUNCTION gethostbyname LIB "wsock32.dll" ALIAS "gethostbyname" (hname AS ASCIIZ) AS DWORD
'DECLARE FUNCTION WSAStartup LIB "wsock32.dll" ALIAS "WSAStartup" (BYVAL wVR AS WORD, lpWSAD AS WSADATA) AS LONG
'DECLARE FUNCTION WSACleanup LIB "wsock32.dll" ALIAS "WSACleanup" () AS LONG
'DECLARE SUB WSASetLastError LIB "wsock32.dll" ALIAS "WSASetLastError" (BYVAL iError AS LONG)
'DECLARE FUNCTION WSAGetLastError LIB "wsock32.dll" ALIAS "WSAGetLastError" () AS LONG
'----------------------------------------------------------
%Uport = 16001 '123 ' 7 '16001 ' &H3E81 port used for broadcast and listening 062.129
%UportOut = 16002 ' for testing only
%UportIn = 16003
%Timeout = 10 ' set to 10 ms timeout... 1000 ' set to 1 second timeout
'%g_net_debug = 1 ' for code development only
%G_NET_UDP_NOTIFY = %WM_USER + 1000
%ID_NetIO = 101 ' for listbox dialog in menu only
GLOBAL hUdp AS LONG ' hold the filehandle for the opened UDP channel
GLOBAL hUdpOut AS LONG ' for systems that are not bidirectional. If %False, we do not crash...
GLOBAL g_net AS g_net_type
GLOBAL pApp AS Applicationtype PTR
GLOBAL pgh AS GMT_HANDLES PTR ' handles to gmt windows created in GMT
GLOBAL hCB AS DWORD ' handle to the callbackwindow for UDP-reception
%g_net_inc = %True
#INCLUDE "g_net.bi"
' declares for local procs. and functions:
DECLARE FUNCTION g_net_quit () AS LONG ' internal cleanup
DECLARE FUNCTION g_net_ServerThread(BYVAL hWnd AS LONG) AS LONG ' not exported
'declare function g_net_callback (BYVAL h AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
DECLARE CALLBACK FUNCTION g_net_callback ()
DECLARE CALLBACK FUNCTION g_NetIoDlgCallback () AS LONG
DECLARE FUNCTION g_net_setServercptr(cptr AS DWORD) AS LONG
FUNCTION LIBMAIN(BYVAL h AS LONG, BYVAL fwdReason AS LONG, BYVAL lpvReserved AS LONG) AS LONG
LOCAL Count&
FUNCTION = 1
SELECT CASE fwdReason
CASE %DLL_PROCESS_ATTACH
' make a callback dialog, hidden!
' DIALOG NEW 0, "hidden UDP window", 1, 1, 100, 100, , %WS_EX_TOOLWINDOW OR %WS_EX_NOPARENTNOTIFY TO hCB 'with this style we can completely hide it..
' DIALOG SHOW MODELESS hCB CALL g_net_callback
' DIALOG SHOW STATE hCB, %SW_HIDE
CASE %DLL_PROCESS_DETACH
g_net_quit
CASE ELSE
FUNCTION = %False
END SELECT
END FUNCTION
FUNCTION g_net_init (BYREF A AS ApplicationType) EXPORT AS LONG
' here we must initialize and configure the networked operation of this PC
LOCAL f AS STRING
LOCAL mpName AS ASCIIZ * %MAX_COMPUTERNAME_LENGTH + 1
LOCAL ht AS HostentStru PTR ' w32_2.inc
LOCAL retval AS DWORD
' LOCAL ipw AS LONG
LOCAL alen AS INTEGER
LOCAL i AS DWORD
LOCAL j AS DWORD
' LOCAL htyp AS INTEGER
LOCAL aantal_pcs AS DWORD
' STATIC ip_in_file AS LONG
' GLOBAL idthread AS LONG
' STATIC count AS LONG
'static h as dword ' window handle for the callback function
STATIC hNetIOdlg AS DWORD
STATIC cnt AS LONG
LOCAL zandloper AS ASCIIZ PTR ' (caused by declaration of WinApi)
LOCAL hCursor AS DWORD
STATIC wVersionRequested AS WORD
STATIC WSADta AS WSAData
#IF %DEF(%gnet_dbg)
insdbg = kl_debug(0, "UDP test window")
kl_debug %kl_dbg_size, STR$(insdbg)+", 20, 20, 250, 300"
kl_debug %kl_dbg_logfile, STR$(insdbg) + ", c:\b\pb\gmt\kristof\UDPDEBUG.log"
#ENDIF
FUNCTION = %False
pApp = VARPTR(A)
' if not already done on preparation of the menu:
IF ISFALSE g_net.ip(0) THEN
'this will be the case if we call the function out of GMT context.
HOST ADDR TO g_net.ip(0)
HOST NAME g_net.ip(0) TO g_net.names(0) ' returns "miel" , or "yes" ...
' our robots may not return a name, but since they should have fixed and unique
' IP numbers, we can use a lookup to resolve to their names.
END IF
g_net.names(0) = MCASE$(g_net.names(0))
g_net.dotip(0) = DottedIP$(g_net.ip(0))
' check:
' GetComputerName mpName,SIZEOF(mpName) ' WinApi function
' IF g_net.names(0) <> TRIM$(MCASE$(mpname)) THEN
' MSGBOX g_net.dotip(0) & " " & g_net.names(0) & " " & mpname
' ' if we get this message box, our computer suffers from split personality syndrome...
' END IF
' read network configuration from ini-file and try to connect to the
' connected PC's
DIM netcfg(0) AS STATIC STRING
netcfg(0) = "0- [None]"
retval = ReadNetworkConfigsFromFile (IniFileName, netcfg()) ' in g_file.dll
IF ISFALSE retval THEN
MSGBOX "Error after reading network config.",,FUNCNAME$
EXIT FUNCTION
END IF
DIALOG NEW @pgh.setup, "Network configurations ",,,120,150,,TO hNetIOdlg
CONTROL ADD LISTBOX, hNetIODlg, %id_NetIO,netcfg(), 0, 0, 110, 120,,, CALL g_NetIODlgCallback
' modal:
cnt = %False
DIALOG SHOW MODAL hNetIOdlg TO cnt ' note cnt cannot be a register variable
DIALOG END hNetIodlg
'g_net.cfg ' holds the return value from the listbox
' if isfalse g_net.cfg then exit function
f = netcfg(g_net.cfg) '$G_DEV ' passing string constants under Win2000 leads to problems!
f = MID$(f,4, LEN(f)-3)
retval = ReadNetworkDataFromFile (InifileName, g_net, f) ' in g_file.dll 23.11.2002
' 14.12.2002: now we also read port-numbers.
IF ISFALSE retval THEN
MSGBOX "Error after reading network data.",,FUNCNAME$
EXIT FUNCTION
ELSE
aantal_pcs = retval ' must be at least 1 now.
END IF
' searching the network may take a while, so present the user with a wait-cursor...
hCursor = GetCursor ()
zandloper = %IDC_WAIT
SetCursor LoadCursor (%Null, BYVAL(zandloper)) ' cfr. declaration PB WinApi
' Now we need a procedure to return the IP number for the name of the computer.
' We will configure all PC's for peer-to-peer communication.
' if we have an IP number in the cfg file, we will always first try to connect and find it...
' The g_net.ip() field is calculated in g_file.dll if there is a valid dotIP in the file.
wVersionRequested = &H20 ' request version 2.0 ' 1.0
WSAStartup wVersionRequested, WSADta ' required for Win2000 and XP
' here we may analyse the data returned to find out the capabilities...
i = 1
DO
mpName = TRIM$(g_net.names(i)) ' names as read from the ini-file
' msgbox mpname + " - " + g_net.names(0)
IF g_net.ip(i) THEN
HOST NAME g_net.ip(i) TO g_net.names(i) ' returns the name of the PC with that IP as known in the net
#IF %DEF(%gnet_dbg)
kl_debug insdbg, "Find: " + STR$(i) + " " + g_net.dotip(i) + " " + g_net.names(i) + STR$(g_net.ports(i))
#ENDIF
IF LCASE$(mpName) <> LCASE$(TRIM$(g_net.names(i))) THEN
SELECT CASE mpName
CASE "site","siteplayer","-",""
' in this case we are connected to a non-pc dedicated webserver board...
g_net.names(i) = "Siteplayer"
CASE ELSE
IF TRIM$(g_net.names(i)) <> "" THEN
MSGBOX "PC name and IP number do not match in inifile!" & $CR & g_net.dotip(i) & " = " & g_net.names(i),,FUNCNAME$
ELSE
' pc is not on the network!
MSGBOX mpname & " is not on the network!",, FUNCNAME$
#IF %DEF(%gnet_dbg)
kl_debug insdbg, g_net.names(i) + " not found"
#ENDIF
g_net.ip(i) = %False
g_net.dotip(i) = ""
END IF
END SELECT
END IF
ELSE
' if no IP is given in the ini file, we will try to find a valid IP number...
IF g_net.names(i) = "" THEN EXIT LOOP ' we must have a name for the pc to connect to...
'
'for sending messages to port on same pc..
IF g_net.names(i) = g_net.names(0) THEN
' MSGBOX "extra output port on " + g_net.names(0) + ": " + STR$(g_net.ports(i))
#IF %DEF(%gnet_dbg)
kl_debug insdbg, "extra output port on " + g_net.names(0) + ": " + STR$(g_net.ports(i))
#ENDIF
g_net.ip(i) = g_net.ip(0)
g_net.dotip(i) = g_net.dotip(0)
ITERATE LOOP
END IF
'
' following call depends on the OS used. It works fine in Millenium, but may return error
' on Win2000 and XP systems.
retval = getHostByName (mpName) ' requires WSA preparation on XP and Win2000...
IF retval THEN
ht = retval
alen = @ht.h_length
' g_net.ip(i) = @ht.@h_addr_list[alen-1] ' last one..., but is this always the case??? NO!
'check which of the returned ip's is on our local network..
#IF %DEF(%gnet_dbg)
kl_debug insdbg, "IP nrs found for " + mpname + " -----------------------------"
kl_debug insdbg, "We choose the one on our local network!!!"
#ENDIF
FOR j = 0 TO alen-1
IF LEFT$(dottedip$(@ht.@h_addr_list[j]), 3) = "192" THEN g_net.ip(i) = @ht.@h_addr_list[j]
#IF %DEF(%gnet_dbg)
kl_debug insdbg, dottedip$(@ht.@h_addr_list[j])
#ENDIF
NEXT
g_net.dotip(i)= DottedIP$(g_net.ip(i))
' MSGBOX mpname & " found at " & g_net.dotip(i),, FUNCNAME$
#IF %DEF(%gnet_dbg)
kl_debug insdbg, mpname & " found at " & g_net.dotip(i)
#ENDIF
ELSE
' failure in calling the function
retval = WSAGetLastError
SELECT CASE retval
CASE %WSANOTINITIALISED
MSGBOX mpname & " A successful WSAStartup must occur before using this function.",, FUNCNAME$
CASE %WSAENETDOWN
MSGBOX mpname & " The network subsystem has failed.",, FUNCNAME$
CASE %WSAHOST_NOT_FOUND
MSGBOX mpname & " Authoritative Answer Host not found.",,FUNCNAME$
CASE %WSATRY_AGAIN
' this what we get most on our peer to peer network without real server...
MSGBOX mpname & " Non-Authoritative Host not found, or server failure.",, FUNCNAME$
CASE %WSANO_RECOVERY
MSGBOX mpname & " Nonrecoverable error occurred.",, FUNCNAME$
CASE %WSANO_DATA
MSGBOX mpname & " Valid name, no data record of requested type.",, FUNCNAME$
CASE %WSAEINPROGRESS
MSGBOX mpname & " A blocking Windows Sockets 1.1 call is in progress, or the service provider is still processing a callback function.",, FUNCNAME$
CASE %WSAEFAULT
MSGBOX mpname & " The name parameter is not a valid part of the user address space.",, FUNCNAME$
CASE %WSAEINTR
MSGBOX mpname & " A blocking Windows Socket 1.1 call was canceled through WSACancelBlockingCall",, FUNCNAME$
END SELECT
WSASetLastError %False
'MSGBOX "Could not find " & mpName,,FUNCNAME$
END IF
END IF
INCR i
LOOP UNTIL i > aantal_pcs
WSACleanUp ' we do not use any more wsa functions.
' sofar this all seems to be working...
SetCursor hCursor
' now we could eliminate not responding PC's en resort the type.
i = 1
'KL: we leave this here for compatibility
'since we can put a port for in ini file now we don't really need it any more..
IF ISFALSE g_net.ports(0) THEN
' here we set the UDP port number to the first portnumber found valid in the INI file.
' Note that this is the port that this PC will use to send UDP messages.
DO
g_net.ports(0) = g_net.ports(i)
INCR i
IF i > 15 THEN EXIT LOOP
LOOP UNTIL g_net.ports(0)
END IF
IF ISFALSE g_net.ports(0) THEN g_net.ports(0)= %Uport
'
'IF IsNT THEN
' ' open bidirectional UDP/IP channel:
' hUdp = FREEFILE
' UDP OPEN PORT g_net.ports(0) AS #hUdp TIMEOUT %Timeout ' open as server to receive data.
' IF ERR THEN
' MSGBOX "Cannot open UDP/IP port " & ERROR$(ERR),, FUNCNAME$
' ERRCLEAR
' EXIT FUNCTION ' function will return false on errors
' END IF
' ' make a callback dialog, hidden!
' DIALOG NEW @pgh.Cockpit, "hidden UDP window", 1, 1, 100, 100, , %WS_EX_TOOLWINDOW OR %WS_EX_NOPARENTNOTIFY TO hCB 'with this style we can completely hide it..
' DIALOG SHOW MODELESS hCB CALL g_net_callback
' DIALOG SHOW STATE hCB, %SW_HIDE
' UDP NOTIFY #hUdp, RECV TO hCB AS %G_NET_UDP_NOTIFY ' interupt coding
' hUDPout = hUDP
' ' alternative: use a thread:
' ' now we can start the listening function in a separate thread:
'' THREAD CREATE g_net_ServerThread(@pgh.cockpit) TO idThread ' gh.Setup ?
'' THREAD CLOSE idThread TO idThread ' thread continues running!, only handle is freed.
'ELSE
'
' here we can only open UDP for Input or Output, but not bidirectional
hUdp = FREEFILE
IF ISFALSE hUdp THEN
MSGBOX "No more I/O handles...",, FUNCNAME$
EXIT FUNCTION
END IF
'
' g_net.portin = 3101 'input port of this machine
IF g_net.portin THEN
#IF %DEF(%gnet_dbg)
kl_debug insdbg, "open UDP bidirectional. server listens to" + STR$(g_net.portin)
#ENDIF
' MSGBOX "open UDP bidirectional. server listens to" + STR$(g_net.portin)
UDP OPEN PORT g_net.portin AS #hUdp 'TIMEOUT %Timeout
ELSE
' MSGBOX "open UDP for output only"
#IF %DEF(%gnet_dbg)
kl_debug insdbg, "open UDP for output only"
#ENDIF
UDP OPEN AS #hUdp
END IF
'
' UDP OPEN PORT g_net.ports(0) AS #hUdp TIMEOUT %Timeout
'
IF ERR THEN
MSGBOX "Error opening UDP/IP port" & ERROR$(ERR),, FUNCNAME$
ERRCLEAR
EXIT FUNCTION
END IF
'
' SELECT CASE TRIM$(MCASE$(g_net.names(0)))
' CASE "Yes", "Putty" , "Noh", "Lily" , "Pak" ,"Isis","Shop"
'>
' try input only... , so these PC's will only have a listen function
' make a callback dialog, hidden!
DIALOG NEW @pgh.Cockpit, "hidden UDP window", 1, 1, 100, 100, , %WS_EX_TOOLWINDOW OR %WS_EX_NOPARENTNOTIFY TO hCB 'with this style we can completely hide it..
DIALOG SHOW MODELESS hCB CALL g_net_callback
DIALOG SHOW STATE hCB, %SW_HIDE
UDP NOTIFY #hUdp, RECV TO hCB AS %G_NET_UDP_NOTIFY ' interupt coding
'
' hUDPout = %False ' this blocks the UDP_send function.
' CASE ELSE
'>
' ' experiment: output only... , so these PC's will be broadcasters only
'UDP OPEN AS #hUdp TIMEOUT %Timeout ' output only
hUDPout = hUdp
'
' END SELECT
'END IF
'
FUNCTION = %True
END FUNCTION
FUNCTION g_net_send (BYVAL msg AS STRING, BYVAL pc AS DWORD) EXPORT AS LONG
' STATIC bIp AS LONG ' broadcast IP adress for this segment, class D - destination
STATIC flag AS DWORD
' the idea is to use decoding of the status word, to find the PC we send the message to
' Thus this function would work like MidiOutMessage
' in our midi implementation we implemented multiport use by setting the midichannel in the
' lobyte of the channel-word and the port in the low nibble of hi-byte
' bip = (g_net.ip(0) OR &HFF000000) ' mask last section with 255 , so now we get 255.xxx.xxx.xxx
' broadcast to sender segment:
'UDP SEND hUDP, AT bIp, %Uport, msg ' send to network segment
'UDP SEND hUDP, AT IpString2Nr("192.168.0.3"), %Uport, msg ' send directly to Miel
STATIC retval AS DWORD
STATIC ONCE AS DWORD
FUNCTION = %False
IF pc > 15 THEN
EXIT FUNCTION
END IF
IF ISFALSE hUDPout THEN
FUNCTION = %False
EXIT FUNCTION
' hUDPout = FREEFILE
' UDP OPEN PORT g_net.ports(pc) AS #hUDPout TIMEOUT %Timeout
' IF ERRCLEAR THEN
' CLOSE #hUDPout
' hUDPout = %FALSE
' IF ISFALSE once THEN
' MSGBOX "Error hUDPout",,FUNCNAME$
' END IF
' EXIT FUNCTION
' END IF
' flag = %True
'ELSE
' flag = %False
END IF
IF g_net.ip(pc) THEN
' msgbox "UDP send" + str$(hUdpOut) + str$(g_net.ip(pc)) + str$(g_net.ports(pc)) + " : " + msg
#IF %DEF(%gnet_dbg)
kl_debug insdbg, STR$(timegettime) + " SEND " + g_net.names(pc) +":" + TRIM$(STR$(g_net.ports(pc))) + " > " + msg
#ENDIF
UDP SEND #hUDPout, AT g_net.ip(pc), g_net.ports(pc), msg
' retval = ERR
' sleep 0
' if retval then
' msgbox error$(retval),, funcname$
' ERRCLEAR
' retval = %False
' end if
FUNCTION = %True
ELSE
#IF %DEF(%gnet_dbg)
kl_debug insdbg, STR$(timegettime) + " no IP nr for " + g_net.names(pc)
#ENDIF
FUNCTION = %False
END IF
' IF flag THEN
' CLOSE #hUDPout
' ERRCLEAR
' hUDPout = %False
' flag = %False
' END IF
' receiving: - if we send to network segment, we receive also what we just have sent.
' if we broadcast to a specific IP adres, we do not get anything back here:
END FUNCTION
FUNCTION g_net_quit () AS LONG
IF hUdp THEN UDP CLOSE #hUdp
IF hUdpOut THEN
IF hUdpOut <> hUdp THEN
UDP CLOSE #hUdpOut
END IF
END IF
#IF %DEF(%gnet_dbg)
kl_debug insdbg, STR$(timegettime) + " QUIT!"
#ENDIF
' IF hCB THEN DIALOG END hCB ' should'nt this be destroywindow ?
hUdp = %False
hUdpOut = %False
IF hCB THEN DestroyWindow hCB ', 0 ' check this...
FUNCTION = %True
END FUNCTION
FUNCTION PrepareNetMenu (gh AS gmt_handles) EXPORT AS LONG
' used for preparing the network-menu in GMT
' if no network section is found in the ini file, this will be the
' only function called in this dll.
LOCAL hMenu AS LONG
LOCAL retval AS DWORD
pgh = VARPTR(gh)
hMenu = GetMenu(@pgh.setup)
' first we check whether we are connected to a network:
HOST ADDR TO g_net.ip(0)
HOST NAME g_net.ip(0) TO g_net.names(0) ' returns "miel" , or "yes" ...
' if no name is returned, we are not connected to a network!
' the IP is then 127.0.0.1
IF hMenu THEN
IF TRIM$(g_net.names(0)) = "" THEN
'MSGBOX "Not connected to network!",,FUNCNAME$
MENU DELETE hMenu, BYCMD %IDM_NETWORK
EXIT FUNCTION
ELSE
retval = CheckForNetworkSupport (IniFileName)
IF retval THEN
EnableMenuItem hMenu, %IDM_NETWORK, %MF_ENABLED
ELSE
MENU DELETE hMenu, BYCMD %IDM_NETWORK
END IF
END IF
MENU DRAW BAR @pgh.setup
ELSE
' we are calling the menu out of the GMT context.
IF TRIM$(g_net.names(0)) = "" THEN
MSGBOX "Not connected to network!",,FUNCNAME$
EXIT FUNCTION
END IF
END IF
FUNCTION = %True
END FUNCTION
FUNCTION g_net_setServercptr(cptr AS DWORD) EXPORT AS LONG
'pass a codepointer to a sub that will deal with udp input
'the sub should have exactly one STRING BYVAL as parameter
'this string will contain incoming udp data
'note that for certain values of gh.app UDP input is directed to other function such as Harma_UDP_Listen..
#IF %DEF(%gnet_dbg)
kl_debug insdbg, STR$(timegettime) + " External serverproc set to " + STR$(cptr)
#ENDIF
g_net.servercptr = cptr
END FUNCTION
FUNCTION g_net_ServerThread(BYVAL hWnd AS LONG) AS LONG
' thread function for receiving UDP/IP data
STATIC InBuffer AS STRING ' UDP data received
LOCAL ipAddr AS LONG ' IP address of sending machine
LOCAL ipPort AS LONG ' UDP Port of sending machine to reply to
LOCAL x AS LONG ' Hold the size of the Dialog to test for closure
LOCAL Op AS STRING ' Status text
LOCAL sendername AS STRING ' name of the PC sending to us
DO
' Start listening to the UDP/IP port
IF ISFALSE hUdp THEN EXIT FUNCTION ' this kills the thread automatically
ERRCLEAR
UDP RECV #hUdp, FROM ipAddr, ipPort, InBuffer
' Ignore any timout or other errors
IF ERR THEN ITERATE
' IF %g_net_debug = 1 THEN
' HOST NAME ipAddr TO sendername
' ' We got one, so update the status screen
' Op = "Received from " & MCASE$(sendername) & DottedIP$(ipAddr) & ":" & _
' FORMAT$(ipPort) & $DQ & Buffer & $DQ
' CONTROL SET TEXT hWnd, %Feedback, Op
' ELSE
' possible strategies:
' 1.- direct action: requires machine specific code in this thread function
' 2.- direct relay: relay buffer directly to running application
' 3.- use double buffering and send this buffer to a global buffer-array that can be parsed by a listen task.
' 4.- we can also add the received data to an existing midiinput-buffer. This would have the
' advantage that the existing listening tasks do not need any changes.
' Here, we call the harma action procedure immediately
' consequently, we have to include g_n*h.dll
' MSGBOX InBuffer
IF InBuffer <> "" THEN
#IF %DEF(%gnet_dbg)
kl_debug insdbg, STR$(timegettime) + " (Thread) RECV From: " + DottedIP$(ipPort) + ": " + InBuffer
#ENDIF
SELECT CASE @pApp.id
' CASE %IDM_HARMA
' Harma_Listen_UDP InBuffer ' buffer is passed byval ! - proc. in g_n*h.dll
' CASE %IDM_DRIPPER
' Dripper_Listen_UDP InBuffer
CASE %IDM_BELLY
' note that we respond to messages from any PC on the net!
' parsing is done in the following procedure.
' Belly_Listen_UDP InBuffer
CASE %ID_DEMO, %ID_DEFAULT , %ID_SREICH
' makes a relay to the midiO() port
Midi_Listen_UDP InBuffer ' in g_lib.dll
CASE ELSE
IF g_net.servercptr THEN
CALL DWORD g_net.servercptr USING Midi_listen_UDP(Inbuffer)
END IF
END SELECT
END IF
' END IF
LOOP WHILE hWnd ' hWnd = @pgh.cockpit, so as soon as cockpit closes, this thread exits.
END FUNCTION
CALLBACK FUNCTION g_net_callback ()
' the winapi declaration would be:
' FUNCTION g_net_callback (BYVAL h AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
' callback function for UDP receive notifications
' this works very fast when sending from Miel to Yes.
' On Win98 and Millennium machines however, reception slows down and blocks if we also start
' using UPD as output.
STATIC InBuffer AS STRING
LOCAL ipAddr AS LONG ' IP address of sending machine
LOCAL ipPort AS LONG ' UDP Port of sending machine to reply to
STATIC ONCE AS DWORD
' window handle = CBHNDL
FUNCTION = %False ' %True to block any further processing by windows. Normally the default should be %False
SELECT CASE CBMSG 'wMsg
CASE %G_NET_UDP_NOTIFY
'wparam =systemhandle for the windows socket lowrd(wparam) =CBCTL hiwrd(wparam)= CBCTLMSG
'lowrd(lparam) = code of the event
'hiwrd(lparam) = error if an error occured.
IF HIWRD(CBLPARAM) THEN
MSGBOX "Error",, FUNCNAME$
END IF
SELECT CASE LOWRD(CBLPARAM) 'lowrd(lparam)
CASE %FD_READ
' data available to be read from the socket
'Inbuffer = ""
UDP RECV #hUdp, FROM ipAddr, ipPort, InBuffer
' msgbox InBuffer + " " + str$(ipport) + " = " + str$(g_net.portin)
' IF ipPort = g_net.portin then 'ports(0) THEN '%Uport THEN
' note: ipPort = port to answer to (??), not port on wich data is received
' if we opened UDP with serverport, that will be the only port on wich we receive anything
' we listen only this this single port.
IF InBuffer <> "" THEN
#IF %DEF(%gnet_dbg)
kl_debug insdbg, STR$(timegettime) + " (Callback) RECV From: " + DottedIP$(ipPort) + ": " + InBuffer
#ENDIF
SELECT CASE @pApp.id
'CASE %IDM_HARMA
' Harma_Listen_UDP InBuffer ' buffer is passed byval ! - proc. in g_n*h.dll
' IF ISFALSE once THEN
' once = %True
' MSGBOX "UDP-Midi received and X-ferred to Harma"
' END IF
' CASE %IDM_DRIPPER
' Dripper_Listen_UDP InBuffer
CASE %IDM_BELLY
' Belly_Listen_UDP Inbuffer
CASE %ID_DEMO, %ID_DEFAULT , %ID_SREICH
Midi_Listen_UDP InBuffer ' in g_lib.dll
CASE ELSE
IF g_net.servercptr THEN
CALL DWORD g_net.servercptr USING Midi_listen_UDP(Inbuffer)
END IF
END SELECT
END IF
' END IF
FUNCTION = %True
CASE %FD_WRITE
' socket ready for writing data
FUNCTION = %True
MSGBOX "FD_WRITE received",, FUNCNAME$
CASE %FD_ACCEPT
' socket ready for a new connection
FUNCTION = %True
MSGBOX "FD_ACCEPT received" ,, FUNCNAME$
CASE %FD_CONNECT
' socket connection established
FUNCTION = %True
MSGBOX "UDP socket established",, FUNCNAME$
CASE %FD_CLOSE
FUNCTION = %True
' socked has been closed
MSGBOX "UDP socket closed",,FUNCNAME$
END SELECT
' case else
' function = %False
' msgbox "Other msg received in callback",, funcname$ ' we do get these!
END SELECT
END FUNCTION
CALLBACK FUNCTION g_NetIoDlgCallback () AS LONG
' LOCAL lParam AS LONG
' LOCAL wParam AS LONG
LOCAL TXT$
' lParam = CBLPARAM
' wParam = CBWPARAM
IF CBCTLMSG = %LBN_SELCHANGE THEN
LISTBOX GET TEXT CBHNDL, %id_NetIO TO TXT$
DIALOG END CBHNDL
g_net.cfg = VAL(TXT$)
FUNCTION = %True
END IF
END FUNCTION
FUNCTION g_net_ptr () EXPORT AS DWORD ' returns a pointer to g_net
FUNCTION = VARPTR(g_net)
END FUNCTION
'[EOF]