I Have a vb6 code which is used to test whether internet connection is there or not for a PC.I make use of checking google DNS for it.It works fine in Windows XP.But in Windows 8 if internet is connected or not it always returns success(Internet is connected). I am making use of Below is part of coding
And below is ping procedureCode:Private Function CheckForInternet(ByVal ServerIP As String, ByRef IsTimedOut As Boolean) A s Boolean On Error GoTo CheckForInternet_EH Dim Reply As ICMP_ECHO_REPLY Dim lngSuccess As Long Dim strIPAddress As String Dim a As String Dim startTimer As Single Dim EndTimer As Single Const Time_out_in_ms As Integer = 1000 'Get the sockets ready. If SocketsInitialize() Then 'Address to ping strIPAddress = ServerIP 'Ping the IP that is passing the address and get a reply. lngSuccess = ping(strIPAddress, Time_out_in_ms, Reply) 'Clean up the sockets. SocketsCleanup ''Return Value If lngSuccess = ICMP_SUCCESS Then CheckForInternet = True ElseIf lngSuccess = ICMP_STATUS_REQUEST_TIMED_OUT Then IsTimedOut = True End If 'Else ' 'Winsock error failure, initializing the sockets. ' Debug.Print WINSOCK_ERROR End If Exit Function CheckForInternet_EH: Call msglog(Err.Description & Space(10) & "CheckForInternet", False) End Function
It is only a part of coding(I do pass parameters properly such as sAddress with DNS of google etc).Now i have observed that when internet connection is there in windows xp ping = Reply.Status returns 0 (which is for success).Same is the case in Windows 8 also.But when internet connection is not there windows xp returns ping value as 11003(which means no internet connection).But in windows 8 it still returns 0 which is for success.Code:Public Function ping(ByVal sAddress As String, ByVal time_out As Long, Reply As ICMP_ECHO_REPLY) As Long On Error GoTo ping_EH Dim hIcmp As Long Dim lAddress As Long Dim lTimeOut As Long Dim StringToSend As String 'Short string of data to send StringToSend = "hello" 'ICMP (ping) timeout lTimeOut = time_out ''ms 'Convert string address to a long representation. lAddress = inet_addr(sAddress) If (lAddress <> -1) And (lAddress <> 0) Then 'Create the handle for ICMP requests. hIcmp = IcmpCreateFile() If hIcmp Then 'Ping the destination IP address. Call IcmpSendEcho(hIcmp, lAddress, StringToSend, Len(StringToSend), 0, Reply, Len(Reply), lTimeOut) 'Reply status ping = Reply.Status 'Close the Icmp handle. IcmpCloseHandle hIcmp Else 'Debug.Print "failure opening icmp handle." ping = -1 End If Else ping = -1 End If Exit Function ping_EH: Call msglog(Err.Description & Space(10) & "ping", False) End Function
So i think it is problem with IcmpSendEcho function which returns wrong value
i have defined following also
Code:Private Declare Function IcmpSendEcho Lib "icmp.dll" _ (ByVal IcmpHandle As Long, _ ByVal DestinationAddress As Long, _ ByVal RequestData As String, _ ByVal RequestSize As Long, _ ByVal RequestOptions As Long, _ ReplyBuffer As ICMP_ECHO_REPLY, _ ByVal ReplySize As Long, _ ByVal Timeout As Long) As Long 'This structure describes the options that will be included in the header of an IP packet. 'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcetcpip/htm/cerefIP_OPTION_INFORMATION.asp Private Type IP_OPTION_INFORMATION Ttl As Byte Tos As Byte Flags As Byte OptionsSize As Byte OptionsData As Long End Type 'This structure describes the data that is returned in response to an echo request. 'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_icmp_echo_reply.asp Public Type ICMP_ECHO_REPLY address As Long Status As Long RoundTripTime As Long DataSize As Long Reserved As Integer ptrData As Long Options As IP_OPTION_INFORMATION Data As String * 250 End Type
Hint:also in link IcmpSendEcho IP_OPTION_INFORMATION for 64 bit pc is different etc.. etc..
So please help me to solve the problem




Reply With Quote