' *************************************************** ' * 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]