Page 1 of 1

PB.Ex ICMP (Windows)

Posted: Sat May 11, 2019 11:23 am
by RSBasic
Hello

With this library it is possible to ping any website or server to determine if the website is accessible.

Functions:
  • SendICMPPing()
    • Syntax:

      Code: Select all

      Result = SendICMPPing(Address$, Timeout, TTL, DontFragment, @ErrorOutput$)
    • Description: Sends a ping packet (ICMP echo message) to a server.
    • Parameter:
      1. Address$: The domain or IP address of the server.
      2. Timeout: Defines the maximum time in milliseconds for waiting for the response of the target server.
      3. TTL: Specifies the number of times the packet may be forwarded to routers and gateways until the packet is discarded.
      4. DontFragment: Determines whether the sent packet can be fragmented.
      5. @ErrorOutput$: If an error occurred, the error message is stored in the variable. This variable must be reserved with 128 characters before passing. Max the length of the return is 128 characters including the NULL character. If no error description is to be returned for an error, 0 can be passed instead.
    • Return value:
      • 1: The process was successful.
    • Example:

      Code: Select all

      EnableExplicit
      
      Global PBEx_ICMP
      
      #PBEx_ICMP_Status_BadDestination = 11018
      #PBEx_ICMP_Status_BadHeader = 11042
      #PBEx_ICMP_Status_BadOption = 11007
      #PBEx_ICMP_Status_BadRoute = 11012
      #PBEx_ICMP_Status_DestinationHostUnreachable = 11003
      #PBEx_ICMP_Status_DestinationNetworkUnreachable = 11002
      #PBEx_ICMP_Status_DestinationPortUnreachable = 11005
      #PBEx_ICMP_Status_DestinationProhibited = 11004
      #PBEx_ICMP_Status_DestinationProtocolUnreachable = 11004
      #PBEx_ICMP_Status_DestinationScopeMismatch = 11045
      #PBEx_ICMP_Status_DestinationUnreachable = 11040
      #PBEx_ICMP_Status_HardwareError = 11008
      #PBEx_ICMP_Status_IcmpError = 11044
      #PBEx_ICMP_Status_NoResources = 11006
      #PBEx_ICMP_Status_PacketTooBig = 11009
      #PBEx_ICMP_Status_ParameterProblem = 11015
      #PBEx_ICMP_Status_SourceQuench = 11016
      #PBEx_ICMP_Status_Success = 0
      #PBEx_ICMP_Status_TimedOut = 11010
      #PBEx_ICMP_Status_TimeExceeded = 11041
      #PBEx_ICMP_Status_TtlExpired = 11013
      #PBEx_ICMP_Status_TtlReassemblyTimeExceeded = 11014
      #PBEx_ICMP_Status_Unknown = -1
      #PBEx_ICMP_Status_UnrecognizedNextHeader = 11043
      
      CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
        PBEx_ICMP = OpenLibrary(#PB_Any, "PB.Ex_ICMP_x86.dll")
      CompilerElseIf #PB_Compiler_Processor = #PB_Processor_x64
        PBEx_ICMP = OpenLibrary(#PB_Any, "PB.Ex_ICMP_x64.dll")
      CompilerEndIf
      
      If PBEx_ICMP
        Prototype SendICMPPing(Address.p-Unicode, Timeout, TTL, DontFragment, ErrorOutput)
        Global SendICMPPing.SendICMPPing = GetFunction(PBEx_ICMP, "SendICMPPing")
        Prototype GetICMPStatus(ErrorOutput)
        Global GetICMPStatus.GetICMPStatus = GetFunction(PBEx_ICMP, "GetICMPStatus")
        Prototype GetICMPIPAddress(Output, ErrorOutput)
        Global GetICMPIPAddress.GetICMPIPAddress = GetFunction(PBEx_ICMP, "GetICMPIPAddress")
        Prototype GetICMPRoundTripTime(ErrorOutput)
        Global GetICMPRoundTripTime.GetICMPRoundTripTime = GetFunction(PBEx_ICMP, "GetICMPRoundTripTime")
        Prototype GetICMPTTL(ErrorOutput)
        Global GetICMPTTL.GetICMPTTL = GetFunction(PBEx_ICMP, "GetICMPTTL")
        
      EndIf
      
      Global Output$ = Space(1024)
      Global ErrorOutput$ = Space(128)
      
      Define ICMPStatus
      
      SendICMPPing("www.google.de", 1000, 128, 1, @ErrorOutput$)
      ICMPStatus = GetICMPStatus(@ErrorOutput$)
      If ICMPStatus = #PBEx_ICMP_Status_Success
        GetICMPIPAddress(@Output$, @ErrorOutput$)
        Debug "IP address: " + Output$
        Debug "Time needed: " + GetICMPRoundTripTime(@ErrorOutput$)
        Debug "TTL: " + GetICMPTTL(@ErrorOutput$)
      Else
        Debug "ICMP-Error: " + ICMPStatus
      EndIf
      
      CloseLibrary(PBEx_ICMP)
      
    GetICMPStatus()
    • Syntax:

      Code: Select all

      Result = GetICMPStatus(@ErrorOutput$)
    • Description: Determines the status. This function is only valid after calling the SendICMPPing() function.
    • Parameter:
      1. @ErrorOutput$: If an error occurred, the error message is stored in the variable. This variable must be reserved with 128 characters before passing. Max the length of the return is 128 characters including the NULL character. If no error description is to be returned for an error, 0 can be passed instead.
    • Return value: The status value can be used, for example, to determine whether the server was reachable or whether a timeout occurred. The following constants can be queried:
      • #PBEx_ICMP_Status_BadDestination
      • #PBEx_ICMP_Status_BadHeader
      • #PBEx_ICMP_Status_BadOption
      • #PBEx_ICMP_Status_BadRoute
      • #PBEx_ICMP_Status_DestinationHostUnreachable
      • #PBEx_ICMP_Status_DestinationNetworkUnreachable
      • #PBEx_ICMP_Status_DestinationPortUnreachable
      • #PBEx_ICMP_Status_DestinationProhibited
      • #PBEx_ICMP_Status_DestinationProtocolUnreachable
      • #PBEx_ICMP_Status_DestinationScopeMismatch
      • #PBEx_ICMP_Status_DestinationUnreachable
      • #PBEx_ICMP_Status_HardwareError
      • #PBEx_ICMP_Status_IcmpError
      • #PBEx_ICMP_Status_NoResources
      • #PBEx_ICMP_Status_PacketTooBig
      • #PBEx_ICMP_Status_ParameterProblem
      • #PBEx_ICMP_Status_SourceQuench
      • #PBEx_ICMP_Status_Success
      • #PBEx_ICMP_Status_TimedOut
      • #PBEx_ICMP_Status_TimeExceeded
      • #PBEx_ICMP_Status_TtlExpired
      • #PBEx_ICMP_Status_TtlReassemblyTimeExceeded
      • #PBEx_ICMP_Status_Unknown
      • #PBEx_ICMP_Status_UnrecognizedNextHeader
      Further information on the individual status values can be found here: https://docs.microsoft.com/en-us/dotnet ... n.ipstatus
    GetICMPIPAddress()
    • Syntax:

      Code: Select all

      Result = GetICMPIPAddress(@Output$, @ErrorOutput$)
    • Description: Determines the resolved IP address of the ping server. This function is only valid after calling the SendICMPPing() function.
    • Parameter:
      1. @Output$: The resolved IP address is stored in this variable.
      2. @ErrorOutput$: If an error occurred, the error message is stored in the variable. This variable must be reserved with 128 characters before passing. Max the length of the return is 128 characters including the NULL character. If no error description is to be returned for an error, 0 can be passed instead.
    • Return value:
      • 1: The process was successful.
    GetICMPRoundTripTime()
    • Syntax:

      Code: Select all

      Result = GetICMPRoundTripTime(@ErrorOutput$)
    • Description: Determines the required time in milliseconds, how long it took to send the ping packet to the server and return it. This function is only valid after calling the SendICMPPing() function.
    • Parameter:
      1. @ErrorOutput$: If an error occurred, the error message is stored in the variable. This variable must be reserved with 128 characters before passing. Max the length of the return is 128 characters including the NULL character. If no error description is to be returned for an error, 0 can be passed instead.
    • Return value: Time in milliseconds
    GetICMPTTL()
    • Syntax:

      Code: Select all

      Result = GetICMPTTL(@ErrorOutput$)
    • Description: Determines the TTL (Time to Live) value of how often the ping packet was forwarded to routers and gateways until the packet arrived. This function is only valid after calling the SendICMPPing() function.
    • Parameter:
      1. @ErrorOutput$: If an error occurred, the error message is stored in the variable. This variable must be reserved with 128 characters before passing. Max the length of the return is 128 characters including the NULL character. If no error description is to be returned for an error, 0 can be passed instead.
    • Return value: Number of redirects.
System requirements:
  • Windows Vista or higher
  • .NET Framework 4.5 or higher
  • Unicode activation (default from PB 5.50)
Licence: This DLL file is free of charge and may be used both privately and commercially.
The following copyright texts must be provided:
Copyright © 2019 RSBasic.de
Download: https://www.rsbasic.de/downloads/downlo ... x_ICMP.zip
Image

I would be very pleased about feedbacks, improvement suggestions, error messages or wishes. If you want to support me, you can also donate something. Thanks :)

Re: PB.Ex ICMP (Windows)

Posted: Sat May 11, 2019 12:19 pm
by BarryG
Hi RSBasic, how does this differ to just ding a DOS "ping" command to the website? I assume it does something better because you put a lot of work into it.

Re: PB.Ex ICMP (Windows)

Posted: Sat May 11, 2019 12:37 pm
by RSBasic
Advantages:
You don't have to parse the return string of ReadProgramString() yourself.
You don't have to run an external EXE program with RunProgram().
You can get the status with the DLL. E.g.:
-#PBEx_ICMP_Status_Success
-#PBEx_ICMP_Status_TimedOut
-#PBEx_ICMP_Status_TtlExpired
[...]

Re: PB.Ex ICMP (Windows)

Posted: Sat May 11, 2019 9:11 pm
by infratec
Why an extra dll :?:
Why dependency on .net :?:

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
CompilerEndIf



Procedure.s PingStatus(Status.i)
  
  Protected Result$
  
  
  Select Status
    Case 0 : Result$ = "Ok"
    Case 11001 : Result$ = "The reply buffer was too small."
    Case 11002 : Result$ = "The destination network was unreachable. "
    Case 11003 : Result$ = "The destination host was unreachable."
    Case 11004 : Result$ = "The destination protocol was unreachable."
    Case 11005 : Result$ = "The destination port was unreachable."
    Case 11006 : Result$ = "Insufficient IP resources were available."
    Case 11007 : Result$ = "A bad IP option was specified."
    Case 11008 : Result$ = "A hardware error occurred."
    Case 11009 : Result$ = "The packet was too big."
    Case 11010 : Result$ = "The request timed out."
    Case 11011 : Result$ = "A bad request."
    Case 11012 : Result$ = "A bad route."
    Case 11013 : Result$ = "The time to live (TTL) expired in transit."
    Case 11014 : Result$ = "The time to live expired during fragment reassembly."
    Case 11015 : Result$ = "A parameter problem."
    Case 11016 : Result$ = "Datagrams are arriving too fast to be processed and datagrams may have been discarded."
    Case 11017 : Result$ = "An IP option was too big."
    Case 11018 : Result$ = "A bad destination."
    Case 11050 : Result$ = "A general failure. This error can be returned for some malformed ICMP packets."
    Default : Result$ = "unknown"
  EndSelect
  
  ProcedureReturn Result$
  
EndProcedure


Procedure.i Ping(IP$, *Reply.ICMP_ECHO_REPLY=#Null, *Buffer=#Null, TimeoutMs.i=1000)
  
  Protected Result.i, ip.l, hIcmp.i, *SendData, *ReplyBuffer.ICMP_ECHO_REPLY, dwRetVal.l
  
  
  ip = MakeIPAddress(Val(StringField(IP$, 1, ".")), Val(StringField(IP$, 2, ".")), Val(StringField(IP$, 3, ".")), Val(StringField(IP$, 4, ".")))
  
  hIcmp = IcmpCreateFile_()
  If hIcmp
    If *Buffer
      *SendData = *Buffer
    Else
      *SendData = UTF8("Ping")
    EndIf
    If *SendData
      *ReplyBuffer = AllocateMemory(SizeOf(ICMP_ECHO_REPLY) + MemorySize(*SendData) + 8)
      If *ReplyBuffer
        
        dwRetVal = IcmpSendEcho_(hIcmp, ip, *SendData, MemorySize(*SendData), #Null, *ReplyBuffer, MemorySize(*ReplyBuffer), TimeoutMs)
        If dwRetVal
          If *Reply
            CopyMemory(*ReplyBuffer, *Reply, SizeOf(ICMP_ECHO_REPLY))
          EndIf
          If *ReplyBuffer\Status = 0
              ;Debug PeekS(*ReplyBuffer\Data, *ReplyBuffer\DataSize, #PB_UTF8)
              If CompareMemory(*SendData, *ReplyBuffer\Data, MemorySize(*SendData))
                Result = #True
              EndIf
          EndIf
        Else
          If *Reply
            *Reply\Status = GetLastError_()
          EndIf
        EndIf
        
        FreeMemory(*ReplyBuffer)
      EndIf
      If *Buffer = #Null
        FreeMemory(*SendData)
      EndIf
    EndIf
    
    IcmpCloseHandle_(hIcmp)
  EndIf
  
  ProcedureReturn Result
  
EndProcedure



CompilerIf #PB_Compiler_IsMainFile
  If Ping("127.0.0.1")
    Debug "Ping Ok"
  Else
    Debug "Ping failed"
  EndIf
  
  Define *Buffer
  *Buffer = UTF8("Test")
  If *Buffer
    If Ping("127.0.0.1", #Null, *Buffer)
      Debug "Ping Ok"
    Else
      Debug "Ping failed"
    EndIf
    FreeMemory(*Buffer)
  EndIf
  
  Define Reply.ICMP_ECHO_REPLY
  If Ping("127.0.0.1", @Reply)
    Debug "Ping Ok"
    Debug "RoundTripTime: " + Str(Reply\RoundTripTime) + "ms"
    Debug "DataSize: " + Str(Reply\DataSize)
    Debug "Status: " + PingStatus(Reply\Status)
  Else
    Debug "Ping failed"
    Debug "Status: " + PingStatus(Reply\Status)
  EndIf
CompilerEndIf

Re: PB.Ex ICMP (Windows)

Posted: Sat May 11, 2019 9:17 pm
by RSBasic
You're right. I didn't see that. I implemented it for a user because he needs it and he suggested it for PB.Ex, but I didn't manually check if there was a WinAPI function. Now it's too late. :D

Re: PB.Ex ICMP (Windows)

Posted: Wed Aug 14, 2019 7:06 pm
by Little John
Hello infratec,
thanks for your code!

The following snippet

Code: Select all

   Define Reply.ICMP_ECHO_REPLY
   
   If Ping("www.google.de", @Reply)
      Debug "Ping Ok"
      Debug "RoundTripTime: " + Str(Reply\RoundTripTime) + "ms"
      Debug "DataSize: " + Str(Reply\DataSize)
      Debug "Status: " + PingStatus(Reply\Status)
   Else
      Debug "Ping failed"
      Debug "Status: " + PingStatus(Reply\Status)
   EndIf
yields
Ping failed
Status: unknown
(PB 5.71 beta 3 (x64) on Windows 10)

Does it not work with domain names, but only with IP addresses?

Re: PB.Ex ICMP (Windows)

Posted: Wed Aug 14, 2019 7:50 pm
by Bisonte
Little John wrote:Does it not work with domain names, but only with IP addresses?
I remember this code... It's only worked with ip addresses. But there was also a proc, that convert the domain to an ip.

Code: Select all

Procedure.s GetIPAdress(HostName.s = "")

  Protected TheIPAddress.s, pHostinfo, AdressNumber, ipAddress, Url.s
  Protected hostinfo.HOSTENT, *Url
  
  If InitNetwork() = #False : ProcedureReturn "Unable to resolve domain name" : EndIf
    
  URL = GetURLPart(HostName, #PB_URL_Site)
  If Url = ""
    Url = HostName
  EndIf
  
  *Url = Ascii(Url)
  
  If *Url
    pHostinfo = gethostbyname_(*Url) 
    If pHostinfo = 0 
      TheIPAddress = "Unable to resolve domain name" 
    Else 
      CopyMemory (pHostinfo, hostinfo.HOSTENT, SizeOf(HOSTENT)) 
      If hostinfo\h_addrtype <> #AF_INET   
        TheIPAddress = "A non-IP address was returned."   
      Else 
        While PeekL(hostinfo\h_addr_list+AdressNumber*4) 
          ipAddress = PeekL(hostinfo\h_addr_list+AdressNumber*4)  
          TheIPAddress = StrU(PeekB(ipAddress),#PB_Byte)+"."+StrU(PeekB(ipAddress+1),#PB_Byte)+"."+StrU(PeekB(ipAddress+2),#PB_Byte)+"."+StrU(PeekB(ipAddress+3),#PB_Byte)
          AdressNumber+1 
        Wend 
      EndIf 
    EndIf 
    FreeMemory(*Url)
  EndIf

  ProcedureReturn TheIPAddress
  
EndProcedure

Debug GetIPAdress("google.de")
Sorry, I don't know who the author is... I only make it work with unicode compiling.

Re: PB.Ex ICMP (Windows)

Posted: Wed Aug 14, 2019 8:26 pm
by Shardik
Bisonte wrote:Sorry, I don't know who the author is... I only make it work with unicode compiling.
The oldest posting of your code seems to be from Fred about 17 years ago. Several authors have used this code afterwards in slightly modified form in similar examples.

Re: PB.Ex ICMP (Windows)

Posted: Wed Aug 14, 2019 9:05 pm
by Bisonte
So the credits goes to Fred ;)

And I also was just one of those guys who tampered with it. In old tradition ;)

Re: PB.Ex ICMP (Windows)

Posted: Thu Aug 15, 2019 7:09 am
by Little John
Many thanks, Bisonte!
(There is a small glitch that prevents your code from running: "url.s" is defined twice.)

Re: PB.Ex ICMP (Windows)

Posted: Thu Aug 15, 2019 7:44 pm
by Bisonte
It runs without any stops....

Define a variable with datatype and later call the var complete with datatype is not an error...

Code: Select all

Define String.s
String.s = "H"
String.s + "i"
Debug String.s
But I change the code ;)

Re: PB.Ex ICMP (Windows)

Posted: Thu Aug 15, 2019 7:57 pm
by Little John
Bisonte wrote:Define a variable with datatype and later call the var complete with datatype is not an error...
That's not what I mean. The problem is this:
Protected TheIPAddress.s, pHostinfo, AdressNumber, ipAddress, Url.s
Protected hostinfo.HOSTENT, Url.s, *Url
Bisonte wrote:It runs without any stops....
Huh? Not here ...
Here with PB 5.71 beta 3 on Window, execution stops and I still get the error message:
Zeile 4: Lokale Variable bereits deklariert: Url.
Maybe the behaviour depends on a compiler option?

Re: PB.Ex ICMP (Windows)

Posted: Thu Aug 15, 2019 8:12 pm
by Bisonte
Ok thats weird... I see my mistake now... But I hit F5 and it run without errors...

Edit : Ok now I found it :
I add the Url.s in the "protected" line here at the forum... not in my code :oops:

Re: PB.Ex ICMP (Windows)

Posted: Thu Aug 15, 2019 8:40 pm
by Little John
That'ts really weird: Why did I get that error message, and you didn't?
Well, thanks again anyway. :-)