Text Only | Text with Attachments

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: Chris80194 on December 11, 2018, 01:25:55 am

Title: Feature request. ICMP (ping) routine.
Post by: Chris80194 on December 11, 2018, 01:25:55 am
Not sure where to put a request.
I would like to be able to ping a ip to verify status up or down.
CMD is a dirty way to do this.
Is there  way to add ICMP to QB64 the same as how TCPIP has been added?
Would be a nice feature built in.
Title: Re: Feature request. ICMP (ping) routine.
Post by: Cobalt on December 12, 2018, 11:03:50 am
when you want to 'ping' an IP do you mean like any internet site, QB64.org, Google, Yahoo. facebook, ect.. or do you mean a networked computer or user to see if they are still connected, for like a game or program? For the former I don't think I can help but for the latter this is what I usually put in my code,

 for the host side:
Code: QB64: [Select]
  1. SUB PingClients
  2.  IF NumClients > 0 THEN 'only bother if there are clients
  3.   FOR I = 1 TO NumClients ' distribute PING message to all clients
  4.    IF Users(I).Id THEN
  5.     PUT #Users(I).Id, , PING
  6.     Users(I).PingTime = UpTime&
  7.    END IF
  8.   NEXT I
  9.   LastPing = UpTime&
  12.  

and the client side:
Code: QB64: [Select]
  1. 'inside a loop-----
  2. GET #ID&, , newmessage$
  3. IF LEFT$(newmessage$, 4) = "PING" THEN SendPing ID&
  4. '---------------------
  5.  
  6. SUB SendPing (id&)
  7.  PUT #id&, , PING
  8.  Response%% = TRUE
  10.  

and once the host sends the ping the client has a certain amount of time to reply or is considered 'disconnected' or lost. and gets removed from the client array.

I think if you can use one of the QB64 commands to have a similar result with online sites, but not sure as I have never played with it. Luke used to have a bot in the IRC chat room that would pull from Wikipedia the same process could probably be used to check whether a site was up or not based on a time out. but not sure there of course.
Title: Re: Feature request. ICMP (ping) routine.
Post by: Chris80194 on December 14, 2018, 10:11:08 pm
I have a headache from a routeing issue that should have been a simple fix but has become an reengineering nightmare.

So I will try out your code snippets to see if that is what I wanted to accomplish.

Basically in my feeble mind the idea was to Ping 192.168.1.1 and get a reply back then set a flag of up or down.  I wanted to do this with out a Shell/CMD in and out of the program and creating a temp file to read, it would probably be nice to also ping yahoo.com and get a reply back too from a url instead of just an ip.

The code looks interesting and I will give that a try to see.

I was thinking of maybe setting a _ICMP command like the _CONNECT command in qb64.......

Thanks for the response, im going to now try out you code snips.
Title: Re: Feature request. ICMP (ping) routine.
Post by: Chris80194 on December 14, 2018, 10:21:55 pm
This might kinda work it needs a host and client which I was kinda banging something on my own that never worked.  As a intermediate process This might do what I want i need to run this one each system though not what I had envisioned but could work for a small network.

Like I mentioned I was thinking of a built in _ICMP command and that would work together with TCPIP transfers to verify if a ip or hostname was alive before running a _CONNECT attempt.
Ping or ICMP does not have a port number since it works on another network layer.

QB64 is c++ right?  So could I do a include of a library that is written in c++ ???
Title: Re: Feature request. ICMP (ping) routine.
Post by: Chris80194 on December 14, 2018, 10:56:34 pm
I guess I am missing something it looks like the code is not complete????
Title: Re: Feature request. ICMP (ping) routine.
Post by: Cobalt on December 16, 2018, 07:58:43 pm
Quote from: Chris80194 on December 14, 2018, 10:56:34 pm
I guess I am missing something it looks like the code is not complete????

no that is not the complete code that is just the vitals, you must define PING of course
the client has it defined as:
PING = "PONG"

and the host has it defined as
PING = "PING"

in both programs PING is DIM SHARED PING as STRING*4

there is a good bit involved in running the host and client, I was just showing the parts the were responsible for checking if a client was still connected.
here is the code so far, still haven't added all the functions I wanted but it connected and did basic operating.
HOST:
Code: QB64: [Select]
  1. TYPE clients
  2.  PingTime AS LONG
  3.  Id AS LONG
  5. DIM SHARED HostID&, UpTime&, NumClients AS INTEGER, PING AS STRING * 4
  6. DIM SHARED LastPing AS LONG, LastJoin AS LONG, NICK(1 TO 1000) AS STRING
  7. DIM SHARED Users(1 TO 1000) AS clients ' array to hold other client info
  8. CONST TRUE = -1, FALSE = NOT TRUE
  9. PING = "PING"
  10.  
  11. Update& = _FREETIMER
  12. ON TIMER(Update&, .5) DisplayStats 'timer for Host status.
  13. Pong& = _FREETIMER
  14. ON TIMER(Pong&, 60) PingClients
  15.  
  16. 'OPEN "HostDebug.txt" FOR OUTPUT AS #3
  17.  
  18. SCREEN _NEWIMAGE(80, 10, 0) 'Reduced screen Size for Host info.
  20. _TITLE "Host: Setting up...."
  21. IF StartHost(0) THEN
  22.  TIMER(Update&) ON
  23.  TIMER(Pong&) ON
  24.  HostMain HostID&
  25.  TIMER(Update&) OFF
  26.  TIMER(Pong&) OFF
  28.  PRINT "Error starting up host"
  30.  
  32.  
  33.  
  34.  
  35.  
  36.  
  37.  
  38. SUB HostMain (ID&)
  39.  _TITLE "Host - Connection:" + _CONNECTIONADDRESS(HostID&)
  40.  NumClients = 0
  41.  DO ' host main loop
  42.   newclient = _OPENCONNECTION(ID&) ' receive any new connection
  43.   IF newclient THEN
  44.    NumClients = NumClients + 1
  45.    Users(NumClients).Id = newclient
  46.    LastJoin = UpTime&
  47.   END IF
  48.   FOR I = 1 TO NumClients ' distribute incoming messages to all clients
  49.    IF Users(I).Id THEN
  50.     GET #Users(I).Id, , message$
  51.     IF message$ = "PONG" THEN Users(I).PingTime = -1 'User Replied to PING
  52.     IF message$ = "LEAVING" THEN DropUser I 'user quits
  53.     IF LEFT$(message$, 5) = "HELLO" THEN AddNick message$, I 'get new user nickname
  54.     IF Users(I).PingTime > 0 AND Users(I).PingTime + 45 = UpTime& THEN DropUser I 'Client Failed to pong
  55.     IF LEFT$(message$, 4) = "TALK" THEN PRINT "Message recieved": MessageParse I, message$
  56.    END IF
  57.   NEXT I
  58.   _DELAY 0.04 ' reduce CPU usage
  59.   IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
  60.  LOOP UNTIL ExitFlag%%
  61.  PRINT "Shutting down Host"
  63.  
  64. 'open host for file transfer
  65. FUNCTION StartHost (port%)
  66.  IF port% = 0 THEN default% = 1979 ELSE default% = port%
  67.  ID$ = "TCP/IP:" + LTRIM$(STR$(default%))
  68.  HostID& = _OPENHOST(ID$) 'begin new host
  69.  Result = HostID&
  70.  StartHost = Result
  72.  
  73. 'Current Status
  74. SUB DisplayStats
  75.  STATIC click%%
  76.  LOCATE 1, 1: PRINT "Host Up Time-"; Clock$(UpTime&); "("; UpTime&; ")"
  77.  LOCATE 2, 1: PRINT "Client Count-"; NumClients
  78.  LOCATE 3, 1: PRINT "Last Ping At-"; Clock$(LastPing)
  79.  LOCATE 4, 1: PRINT "Last Join At-"; Clock$(LastJoin)
  80.  IF NumClients > 0 THEN LOCATE 5, 1: PRINT "Who Joined  -"; NICK(NumClients) ELSE LOCATE 5, 1: PRINT SPACE$(79)
  81.  click%% = click%% + 1
  82.  IF click%% = 2 THEN UpTime& = UpTime& + 1: click%% = 0
  84.  
  85. FUNCTION Clock$ (tim&)
  86.  Secs%% = tim& MOD 60
  87.  Mins%% = (tim& - Secs%%) / 60
  88.  Hrs%% = INT(Mins%% / 60) - .49
  89.  Mins%% = Mins%% MOD 60
  90.  IF Hrs%% < 10 THEN H$ = "0" + LTRIM$(STR$(Hrs%%)) ELSE H$ = LTRIM$(STR$(Hrs%%))
  91.  IF Mins%% < 10 THEN M$ = "0" + LTRIM$(STR$(Mins%%)) ELSE M$ = LTRIM$(STR$(Mins%%))
  92.  IF Secs%% < 10 THEN S$ = "0" + LTRIM$(STR$(Secs%%)) ELSE S$ = LTRIM$(STR$(Secs%%))
  93.  Clock$ = H$ + ":" + M$ + ":" + S$
  95.  
  96. SUB PingClients
  97.  IF NumClients > 0 THEN 'only bother if there are clients
  98.   FOR I = 1 TO NumClients ' distribute PING message to all clients
  99.    IF Users(I).Id THEN
  100.     PUT #Users(I).Id, , PING
  101.     Users(I).PingTime = UpTime&
  102.    END IF
  103.   NEXT I
  104.   LastPing = UpTime&
  105.   SendUpTime UpTime&
  108.  
  109. SUB DropUser (id%)
  110.  'if user sends "LEAVING" message or fails to respond to a PING
  111.  'then drop the user
  112.  FOR J% = id% TO NumClients
  113.   SWAP Users(J%), Users(J% + 1)
  114.   SWAP NICK(J%), NICK(J% + 1)
  115.  NEXT J%
  116.  Users(J%).Id = 0
  117.  Users(J%).PingTime = 0
  118.  NICK(J%) = ""
  119.  NumClients = NumClients - 1
  121.  
  122. SUB MessageParse (WhoFrom&, Txt$)
  123.  'find who the message is for
  124.  Txt$ = MID$(Txt$, 5)
  125.  match% = FALSE
  126.  FOR i% = 1 TO NumClients
  127.   IF LCASE$(MID$(Txt$, 1, INSTR(Txt$, ":") - 1)) = LCASE$(NICK(i%)) THEN match% = i%: i% = NumClients + 1
  128.  NEXT i%
  129.  '---------------------------
  130.  'pull message body
  131.  MSG$ = MID$(Txt$, INSTR(Txt$, ":") + 1)
  132.  '---------------------------
  133.  MSG$ = NICK(WhoFrom&) + " SAYS: " + CHR$(34) + MSG$ + CHR$(34)
  134.  'send message to right client(hopefully)
  135.  IF match% THEN
  136.   PUT #Users(match%).Id, , MSG$
  137.  ELSE 'no name given send to all clients
  138.   FOR i% = 1 TO NumClients
  139.    PUT #Users(i%).Id, , MSG$
  140.   NEXT i%
  142.  '---------------------------
  143.  
  145.  
  146. SUB DataParse (WhoFrom&, Dat$)
  147.  
  149.  
  150. SUB AddNick (TXT$, WHO&)
  151.  InUse%% = FALSE
  152.  temp$ = MID$(TXT$, 7) 'get new user Nickname
  153.  'make sure name is not already in use
  154.  FOR i% = 1 TO NumClients
  155.   IF LCASE$(RTRIM$(temp$)) = LCASE$(NICK(i%)) THEN InUse%% = TRUE: i% = NumClients + 1
  156.  NEXT i%
  157.  IF InUse%% THEN
  158.   MSG$ = "BADNICK"
  159.   PUT #Users(WHO&).Id, , MSG$
  161.   NICK(WHO&) = RTRIM$(temp$)
  163.  
  165.  
  166. SUB SendUpTime (t&)
  167.  FOR i% = 1 TO NumClients
  168.   TXT$ = "DATASTRGTIME" + Clock$(UpTime&)
  169.   PUT #Users(i%).Id, , TXT$
  170.  NEXT i%
  172.  

CLIENT:
Code: QB64: [Select]
  1. DIM SHARED Message AS STRING, MyName$, UpTime&, Response%%
  2. DIM SHARED ClientID&, PING AS STRING * 4, QUIT AS STRING * 7
  3. DIM SHARED HostTime$
  4. CONST TRUE = -1, FALSE = NOT TRUE
  5. QUIT = "LEAVING": PING = "PONG"
  6.  
  7. Update& = _FREETIMER
  8. ON TIMER(Update&, .5) StatusUpdate 'timer for Host status.
  9.  
  10. LOCATE , , 1 ' display the print cursor for INKEY$
  11. _TITLE "Client - Connecting..."
  12. INPUT "Enter your name: ", MyName$
  13. INPUT "Enter Host IP address(0-Local)"; IPA$
  14. INPUT "Enter Hosts Port(0-default)"; port%
  15.  
  16. IF ConnectClient(port%, IPA$) THEN
  17.  CLS: TIMER(Update&) ON
  18.  SendNick MyName$, ClientID&
  19.  ClientMain ClientID&
  21.  PRINT "Error Connecting to Host"
  23.  
  25.  
  26.  
  27. FUNCTION ConnectClient (port%, IPA$)
  28.  IF port% = 0 THEN default% = 1979 ELSE default% = port%
  29.  IF IPA$ = "0" THEN IP$ = ":localhost" ELSE IP$ = ":" + IPA$
  30.  ID$ = "TCP/IP:" + LTRIM$(STR$(default%)) + IP$
  31.  ClientID& = _OPENCLIENT(ID$) ' Attempt to connect to local host as a client
  32.  Result = ClientID&
  33.  ConnectClient = Result
  35.  
  36. SUB ClientMain (ID&)
  37.  _TITLE "Client - Connected - " + MyName$
  38.  DO
  39.   GetMessage ID&
  40.   '  SendMessage MyName$, MyMessage$, ID& ' display current input on screen
  41.   _DELAY 0.0416 ' reduce CPU usage
  42.  
  43.   KBD$ = INKEY$
  44.   SELECT CASE KBD$
  45.    CASE CHR$(27)
  46.     ExitFlag%% = TRUE
  47.    CASE CHR$(13)
  48.     SendMessage
  49.    CASE ELSE
  50.     TypeMessage KBD$
  52.  
  53.  LOOP UNTIL ExitFlag%%
  54.  PUT #ClientID&, , QUIT
  55.  PRINT "Disconnected from host"
  57.  
  58. SUB SendPing (id&)
  59.  PUT #id&, , PING
  60.  Response%% = TRUE
  62.  
  63. SUB GetMessage (ID&) ' get & display any new message
  64.  STATIC pingcount~%
  65.  GET #ID&, , newmessage$
  66.  IF LEFT$(newmessage$, 4) = "PING" THEN SendPing ID&: Response%% = FALSE: LOCATE 5, 1: PRINT "You Got Pinged! Time Was:"; TIME$: pingcount~% = pingcount~% + 1: PRINT pingcount~%: newmessage$ = MID$(newmessage$, 5)
  67.  'if the nick is in use ask user for new, if it takes too long to reply
  68.  'the host will kick client.
  69.  IF newmessage$ = "BADNICK" THEN LOCATE 1, 1: INPUT "Name Already In Use, Pick New Name"; MyName$: SendNick MyName$, ID&
  70.  IF LEFT$(newmessage$, 4) = "DATA" THEN ProcessPacket newmessage$
  71.  IF INSTR(newmessage$, "SAYS:") THEN ShowMessages MID$(newmessage$, INSTR(newmessage$, ":") + 1)
  73.  
  74. SUB SendNick (tag$, id&)
  75.  MSG$ = "HELLO:" + tag$
  76.  PUT #id&, , MSG$
  78.  
  79. SUB TypeMessage (txt$)
  80.  SELECT CASE txt$
  81.   CASE CHR$(8) 'back space
  82.    Message = LEFT$(Message, LEN(Message) - 1)
  83.   CASE CHR$(32) TO CHR$(126)
  84.    Message = Message + txt$
  86.  DisplayMessage
  88.  
  89. SUB DisplayMessage
  90.  LOCATE 23, 1
  91.  IF LEN(Message) < 70 THEN
  92.   PRINT Message; SPACE$(70 - LEN(Message))
  93.  ELSE 'message longer than line
  94.   PRINT MID$(Message, LEN(Message) - 70)
  97.  
  98. SUB SendMessage () ' (ToWho$)
  99.  IF INSTR(Message, ":") THEN 'if message is to certain client
  100.   MSG$ = "TALK" + Message
  101.  ELSE 'other wise send to all
  102.   MSG$ = "TALK  :" + Message
  104.  PUT #ClientID&, , MSG$
  105.  Message = ""
  107.  
  108. SUB ShowMessages (txt$)
  109.  'define message area
  110.  VIEW PRINT 3 TO 21
  111.  'display message
  112.  LOCATE 21, 1: PRINT txt$
  113.  'restore screen area
  114.  VIEW PRINT 1 TO 24
  116.  
  117. SUB ProcessPacket (txt$)
  118.  txt$ = MID$(txt$, 5) 'remove DATA from string
  119.  'what type of value
  120.  SELECT CASE LEFT$(txt$, 4)
  121.   CASE "BYTE"
  122.    d%% = VAL(MID$(txt$, 5))
  123.   CASE "INTR"
  124.    d% = VAL(MID$(txt$, 5))
  125.   CASE "LONG"
  126.    d& = VAL(MID$(txt$, 5))
  127.   CASE "SNGL"
  128.    d! = VAL(MID$(txt$, 5))
  129.   CASE "DUBL"
  130.    d& = VAL(MID$(txt$, 5))
  131.   CASE "STRG"
  132.    IF MID$(txt$, 5, 4) = "TIME" THEN
  133.     HostTime$ = MID$(txt$, 9)
  134.    ELSE
  135.     d$ = MID$(txt$, 5)
  136.    END IF
  139.  
  140. SUB StatusUpdate
  141.  LOCATE 1, 1: PRINT "Host Up Time:"; HostTime$
  142.  LOCATE 1, 25: PRINT "PING Response Yet?";
  143.  IF Response%% THEN PRINT "Yes" ELSE PRINT "No "
  145.  

They are dirty and messy and not complete, just doing some basic R&D for my Battleship game.
You can use a DLL, if you know what you need but that is beyond my experience I fear.
Title: Re: Feature request. ICMP (ping) routine.
Post by: Chris80194 on December 19, 2018, 05:32:00 am
I will give that a go then.
Thanks,

PS.
The ICMP idea was a out of the box thinking idea to augment the other built-in tcpip commands.
Text Only | Text with Attachments