Result = SendICMPPing(Address$, Timeout, TTL, DontFragment, @ErrorOutput$)
Description: Sends a ping packet (ICMP echo message) to a server.
Parameter:
Address$: The domain or IP address of the server.
Timeout: Defines the maximum time in milliseconds for waiting for the response of the target server.
TTL: Specifies the number of times the packet may be forwarded to routers and gateways until the packet is discarded.
DontFragment: Determines whether the sent packet can be fragmented.
@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.
Description: Determines the status. This function is only valid after calling the SendICMPPing() function.
Parameter:
@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:
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:
@Output$: The resolved IP address is stored in this variable.
@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.
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:
@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.
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:
@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:
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
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.
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
[...]
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
Last edited by infratec on Sat May 11, 2019 9:23 pm, edited 2 times in total.
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.
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.
Last edited by Bisonte on Thu Aug 15, 2019 8:11 pm, edited 2 times in total.
PureBasic 6.10 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom
English is not my native language... (I often use DeepL to translate my texts.)
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.
And I also was just one of those guys who tampered with it. In old tradition
PureBasic 6.10 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom
English is not my native language... (I often use DeepL to translate my texts.)
PureBasic 6.10 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom
English is not my native language... (I often use DeepL to translate my texts.)
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
Last edited by Bisonte on Fri Aug 16, 2019 6:57 am, edited 1 time in total.
PureBasic 6.10 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom
English is not my native language... (I often use DeepL to translate my texts.)