Attribute VB_Name = "modPING" Option Explicit '============================================================================================================= ' ' modPING Module ' -------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Last Update : February 27, 2001 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : modWINSOCK.bas (Winsock Visual Basic module by Kevin Wilson - Wilson Media) ' ICMP.DLL (Internet Control Message Protocol Dynamic Link Library) ' Windows Sockets version 1.1 or greater (or an OS that comes with at least Winsock v1.1) ' ' Description : This module makes it easy for you to resolve the IP address(es) of any given host name, resolve ' the host name of the current computer, translate IP addresses to and from their "standard" long ' notation, and PING a given server and get back detailed results of that PING. ' ' This module also demonstrates the proper way to initialize, use, and clean up the Winsock DLLs. ' ' See Also: ' --------- ' http://msdn.microsoft.com/library/default.asp?URL=/library/wcedoc/wcesdkr/network_44.htm ' http://msdn.microsoft.com/library/default.asp?URL=/library/wcedoc/wcesdkr/network_43.htm ' http://msdn.microsoft.com/library/default.asp?URL=/library/wcedoc/wcesdkr/network_45.htm ' http://msdn.microsoft.com/library/wcedoc/wcesdkr/_wcesdk_icmp_echo_reply.htm ' ICMPAPI.H ' IPEXPORT.H '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= '------------------------------------------------------------------------------------------------------------- ' The following are type definitions that are necisary to understand because when making the transfer from ' C (Win32 API) to Visual Basic, you need to know the data type's size in bytes to match it up with the ' correct corisponding VB data type. '------------------------------------------------------------------------------------------------------------- ' typedef unsigned long IPAddr; // An IP address. ' typedef unsigned long IPMask; // An IP subnet mask. ' typedef unsigned long IP_STATUS; // Status code returned from IP APIs. '------------------------------------------------------------------------------------------------------------- ' Type Declarations Public Type IP_OPTION_INFORMATION ' The ip_option_information structure describes the options to be included in the header of an IP packet. The TTL, TOS, and Flags values are carried in specific fields in the header. The OptionsData bytes are carried in the options area following the standard IP header. With the exception of source route options, this data must be in the format to be transmitted on the wire as specified in RFC 791. A source route option should contain the full route - first hop thru final destination - in the route data. The first hop will be pulled out of the data and the option will be reformatted accordingly. Otherwise, the route option should be formatted as specified in RFC 791. Ttl As Byte 'unsigned char // Time To Live Tos As Byte 'unsigned char // Type Of Service Flags As Byte 'unsigned char // IP header flags OptionsSize As Byte 'unsigned char // Size in bytes of options data OptionsData As Long 'unsigned char FAR * // Pointer to options data End Type Public Type ICMP_ECHO_REPLY 'The ICMP_ECHO_REPLY structure describes the data returned in response to an echo request. Address As Long 'IPAddr // Replying address Status As Long 'unsigned long // Reply IP_STATUS RoundTripTime As Long 'unsigned long // RTT in milliseconds DataSize As Integer 'unsigned short // Reply data size in bytes Reserved As Integer 'unsigned short // Reserved for system use DataPointer As Long 'void FAR * // Pointer to the reply data Options As IP_OPTION_INFORMATION 'IP_OPTION_INFORMATION // Reply options Data As String * MAX_PATH ' // Reply data pointed to by "DataPointer" End Type ' Constants - IP_STATUS codes returned from IP APIs Public Const IP_STATUS_BASE = 11000 Public Const IP_SUCCESS = 0 Public Const IP_BUF_TOO_SMALL = (IP_STATUS_BASE + 1) Public Const IP_DEST_NET_UNREACHABLE = (IP_STATUS_BASE + 2) Public Const IP_DEST_HOST_UNREACHABLE = (IP_STATUS_BASE + 3) Public Const IP_DEST_PROT_UNREACHABLE = (IP_STATUS_BASE + 4) Public Const IP_DEST_PORT_UNREACHABLE = (IP_STATUS_BASE + 5) Public Const IP_NO_RESOURCES = (IP_STATUS_BASE + 6) Public Const IP_BAD_OPTION = (IP_STATUS_BASE + 7) Public Const IP_HW_ERROR = (IP_STATUS_BASE + 8) Public Const IP_PACKET_TOO_BIG = (IP_STATUS_BASE + 9) Public Const IP_REQ_TIMED_OUT = (IP_STATUS_BASE + 10) Public Const IP_BAD_REQ = (IP_STATUS_BASE + 11) Public Const IP_BAD_ROUTE = (IP_STATUS_BASE + 12) Public Const IP_TTL_EXPIRED_TRANSIT = (IP_STATUS_BASE + 13) Public Const IP_TTL_EXPIRED_REASSEM = (IP_STATUS_BASE + 14) Public Const IP_PARAM_PROBLEM = (IP_STATUS_BASE + 15) Public Const IP_SOURCE_QUENCH = (IP_STATUS_BASE + 16) Public Const IP_OPTION_TOO_BIG = (IP_STATUS_BASE + 17) Public Const IP_BAD_DESTINATION = (IP_STATUS_BASE + 18) ' The next group are status codes passed up on status indications to transport layer protocols. Public Const IP_ADDR_DELETED = (IP_STATUS_BASE + 19) Public Const IP_SPEC_MTU_CHANGE = (IP_STATUS_BASE + 20) Public Const IP_MTU_CHANGE = (IP_STATUS_BASE + 21) Public Const IP_UNLOAD = (IP_STATUS_BASE + 22) Public Const IP_ADDR_ADDED = (IP_STATUS_BASE + 23) Public Const IP_MEDIA_CONNECT = (IP_STATUS_BASE + 24) Public Const IP_MEDIA_DISCONNECT = (IP_STATUS_BASE + 25) Public Const IP_BIND_ADAPTER = (IP_STATUS_BASE + 26) Public Const IP_UNBIND_ADAPTER = (IP_STATUS_BASE + 27) Public Const IP_DEVICE_DOES_NOT_EXIST = (IP_STATUS_BASE + 28) Public Const IP_DUPLICATE_ADDRESS = (IP_STATUS_BASE + 29) Public Const IP_INTERFACE_METRIC_CHANGE = (IP_STATUS_BASE + 30) Public Const IP_RECONFIG_SECFLTR = (IP_STATUS_BASE + 31) Public Const IP_NEGOTIATING_IPSEC = (IP_STATUS_BASE + 32) Public Const IP_INTERFACE_WOL_CAPABILITY_CHANGE = (IP_STATUS_BASE + 33) Public Const IP_DUPLICATE_IPADD = (IP_STATUS_BASE + 34) Public Const IP_GENERAL_FAILURE = (IP_STATUS_BASE + 50) Public Const IP_PENDING = (IP_STATUS_BASE + 255) ' Constants - IP_OPTION_INFORMATION.Flags Public Const IP_FLAG_DF = &H2 'Don't fragment this packet. ' Constants - IP_OPTION_INFORMATION.OptionsData (Supported IP Option Types) Public Const IP_OPT_EOL = 0 'End of list option Public Const IP_OPT_NOP = 1 'No operation Public Const IP_OPT_SECURITY = &H82 'Security option Public Const IP_OPT_LSRR = &H83 'Loose source route Public Const IP_OPT_SSRR = &H89 'Strict source route Public Const IP_OPT_RR = &H7 'Record route Public Const IP_OPT_TS = &H44 'Timestamp Public Const IP_OPT_SID = &H88 'Stream ID (obsolete) Public Const IP_OPT_ROUTER_ALERT = &H94 'Router Alert Option ' Constants - IP_OPTION_INFORMATION (OptionsSize / OptionsData) Public Const MAX_OPT_SIZE = 40 'Maximum length of IP options in bytes ' Constants - WSAStartup.wVersionRequested Private Const REQUIRED_VER_11 As Integer = &H101 '(LOBYTE [Major Version] = 1, HIBYTE [Minor Version] = 1) Private Const REQUIRED_VER_20 As Integer = &H2 '(LOBYTE [Major Version] = 2, HIBYTE [Minor Version] = 0) Private Const REQUIRED_VER_22 As Integer = &H202 '(LOBYTE [Major Version] = 2, HIBYTE [Minor Version] = 2) Private Const REQUIRED_MAJOR As Byte = 1 Private Const REQUIRED_MINOR As Byte = 1 ' Variable Declarations Private boolInitialized As Boolean Private strWinsockVer As String Private strCompName As String Private IPCount As Integer Private IPs() As String '============================================================================================================= ' IcmpCloseHandle ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' Closes a handle opened by ICMPOpenFile. ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' IcmpHandle [in] The handle to close ' ' Return: ' ¯¯¯¯¯¯¯ ' TRUE if the handle was closed successfully, otherwise FALSE. ' Extended error information is available by calling GetLastError(). ' ____________________________________________________________________________________________________________ ' BOOL IcmpCloseHandle (HANDLE IcmpHandle); '============================================================================================================= Public Declare Function IcmpCloseHandle Lib "ICMP.DLL" (ByVal IcmpHandle As Long) As Long '============================================================================================================= ' IcmpCreateFile ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' Opens a handle on which ICMP Echo Requests can be issued. ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' None ' ' Return: ' ¯¯¯¯¯¯¯ ' An open file handle or INVALID_HANDLE_VALUE. ' Extended error information is available by calling GetLastError(). ' ____________________________________________________________________________________________________________ ' HANDLE IcmpCreateFile (VOID); '============================================================================================================= Public Declare Function IcmpCreateFile Lib "ICMP.DLL" () As Long '============================================================================================================= ' IcmpSendEcho ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' Sends an ICMP Echo request and returns any replies. The call returns when the timeout has expired or ' the reply buffer is filled. ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' IcmpHandle [in] An open handle returned by ICMPCreateFile. ' DestinationAddress [in] The destination of the echo request. ' RequestData [in] A buffer containing the data to send in the request. ' RequestSize [in] The number of bytes in the request data buffer. ' RequestOptions [in] Pointer to the IP header options for the request. May be NULL. ' ReplyBuffer [out] A buffer to hold any replies to the request. On return, the buffer will ' contain an array of ICMP_ECHO_REPLY structures followed by the options ' and data for the replies. The buffer should be large enough to hold at ' least one ICMP_ECHO_REPLY structure plus MAX(RequestSize, 8) bytes of ' data since an ICMP error message contains 8 bytes of data. ' ReplySize [in] The size in bytes of the reply buffer. ' Timeout [in] The time in milliseconds to wait for replies. ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns the number of ICMP_ECHO_REPLY structures stored in ReplyBuffer. The status of each reply ' is contained in the structure. If the return value is zero, extended error information is available ' via GetLastError(). ' ____________________________________________________________________________________________________________ ' DWORD IcmpSendEcho (HANDLE IcmpHandle, IPAddr DestinationAddress, LPVOID RequestData, WORD RequestSize, PIP_OPTION_INFORMATION RequestOptions, LPVOID ReplyBuffer, DWORD ReplySize, DWORD Timeout); '============================================================================================================= Public 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, _ ByRef ReplyBuffer As ICMP_ECHO_REPLY, _ ByVal ReplySize As Long, _ ByVal Timeout As Long) As Long 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX '============================================================================================================= ' Conv_AddressToLong ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' Converts a "readable" IP address (255.255.255.255) and converts it to a long value that represents the IP. ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' IpAddress [in] The IP address to convert in "readable" format (255.255.255.255) ' PreferredIpIndex [in] Optional. If IpAddress specifies the name of an address (www.Microsoft.com), then ' an attempt is made to resolve at least one IP address from that address. If more ' than one are found then this parameter is used to specify which one to use. ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns the converted IP address in standard LONG format (what most APIs use) '============================================================================================================= Public Function Conv_AddressToLong(ByVal IpAddress As String, _ Optional ByVal PreferredIpIndex As Integer = 1) As Long Dim TempIPs() As String Dim TempIPCount As Integer ' Check to make sure the address is a valid IP address IpAddress = Trim(IpAddress) If IpAddress = "" Then Exit Function If P_IsIpAddress(IpAddress) = False Then If P_GetALL_IPs(IpAddress, TempIPs, TempIPCount, False) = False Then Exit Function If TempIPCount <= 0 Then Exit Function If PreferredIpIndex <= 0 Then PreferredIpIndex = 1 If PreferredIpIndex > TempIPCount Then PreferredIpIndex = TempIPCount IpAddress = TempIPs(PreferredIpIndex) If P_IsIpAddress(IpAddress) = False Then Exit Function End If ' It is possible to assemble the value, but calling the API seems more efficient and fail-safe ' Conv_AddressToLong = Val("&H" & Right("00" & Hex(DotSection(4)), 2) & _ ' Right("00" & Hex(DotSection(3)), 2) & _ ' Right("00" & Hex(DotSection(2)), 2) & _ ' Right("00" & Hex(DotSection(1)), 2)) ' Use the "inet_addr" API to get the internet address in the form of a long (what APIs use) Conv_AddressToLong = inet_addr(IpAddress) If Conv_AddressToLong = INADDR_NONE Then Conv_AddressToLong = 0 Exit Function End If End Function '============================================================================================================= ' Conv_LongToAddress ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' Takes the specified long value that represents an IP address and converts it to a "readable" IP address. ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' lngAddress [in] Specifies the IP address in the form of a LONG and converts it to "readable" format ' (for example : 255.255.255.255) ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns the converted IP address in "readable" format '============================================================================================================= Public Function Conv_LongToAddress(ByVal lngAddress As Long) As String Dim StringPointer As Long ' Use the "inet_ntoa" API to get the readable IP address from the long version Conv_LongToAddress = String(MAX_PATH, Chr(0)) StringPointer = inet_ntoa(lngAddress) If StringPointer <> 0 Then StringFromPointer Conv_LongToAddress, StringPointer End If Conv_LongToAddress = Left(Conv_LongToAddress, InStr(Conv_LongToAddress, Chr(0)) - 1) End Function '============================================================================================================= ' P_GetALL_IPs ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' Takes the specified host name (like "www.Microsoft.com") and returns all the IP addresses found for that ' name as a string array. ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' HostName [in] Specifies the address to get the IP addresses for (ie - www.microsoft.com) ' Return_IpArray [out] Returns an array of strings that represent all the IP addresses found for the ' specified address. ' Return_IPCount [out] Specifies how many IP addresses were found for the specified host name. ' DisplayErrorMessages [in] Optional. If set to TRUE and an error occurs, an error message will be displayed. ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns TRUE if the function executed without any errors. ' Returns FALSE if an error occured. '============================================================================================================= Public Function P_GetALL_IPs(ByVal HostName As String, _ ByRef Return_IpArray() As String, _ ByRef Return_IPCount As Integer, _ Optional ByVal DisplayErrorMessages As Boolean = True) As Boolean Dim HostInfo_Pointer As Long Dim HostInfo As HOSTENT Dim IP_Pointer As Long Dim IP_Bytes() As Byte Dim MyCounter As Integer ' Check if connected If boolInitialized = False Then If DisplayErrorMessages = True Then MsgBox "Winsock not yet initialized." & Chr(13) & "Call the 'P_Initialize' function to initialize Winsock before continuing.", vbOKOnly + vbExclamation, " Windows Sockets Not Yet Initialized" End If Exit Function End If ' Erase the current IP information Erase Return_IpArray Return_IPCount = 0 ' Make sure there is a valid host name provided and that it is NULL terminated If HostName = "" Then HostName = strCompName End If If Right(HostName, 1) <> Chr(0) Then HostName = HostName & Chr(0) ' Get a pointer to the HOSTENT information that has the IP info HostInfo_Pointer = gethostbyname(HostName) If HostInfo_Pointer = 0 Then GetLastWinsockErr WSAGetLastError, "WSAGetHostByName", , , DisplayErrorMessages Exit Function Else CopyMemory HostInfo, HostInfo_Pointer, LenB(HostInfo) CopyMemory IP_Pointer, HostInfo.hAddrList, 4 End If ' Loop through all the IPs for this computer While IP_Pointer <> 0 ' Increment the number of IP's Return_IPCount = Return_IPCount + 1 ReDim Preserve Return_IpArray(1 To Return_IPCount) As String ' Copy the IP info into a BYTE array ReDim IP_Bytes(1 To HostInfo.hLength) CopyMemory IP_Bytes(1), IP_Pointer, HostInfo.hLength ' Compile the byte array into a valid IP address string For MyCounter = 1 To HostInfo.hLength Return_IpArray(Return_IPCount) = Return_IpArray(Return_IPCount) & CStr(IP_Bytes(MyCounter)) & "." Next Return_IpArray(Return_IPCount) = Left(Return_IpArray(Return_IPCount), Len(Return_IpArray(Return_IPCount)) - 1) ' Get the next IP address (if one exists) HostInfo.hAddrList = HostInfo.hAddrList + LenB(HostInfo.hAddrList) CopyMemory IP_Pointer, HostInfo.hAddrList, 4 Wend ' Function succeeded P_GetALL_IPs = True End Function '============================================================================================================= ' P_GetMyIP ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' Returns the IP address for this machine (found when the P_Initialize function is called) based on the IP ' address index provided in the Index parameter. ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' Return_IP [out] Returns the IP address in "readable" format (ie - 255.255.255.255) ' Index [in] Optional. Specifies which of the IP addresses to return if more than one were ' found for this computer. 1 is the default. ' DisplayErrorMessages [in] Optional. If set to TRUE and an error occurs, an error message will be displayed. ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns TRUE if the function executed without any errors. ' Returns FALSE if an error occured. '============================================================================================================= Public Function P_GetMyIP(ByRef Return_IP As String, _ Optional ByVal Index As Integer = 1, _ Optional ByVal DisplayErrorMessages As Boolean = True) As Boolean ' Check if connected If boolInitialized = False Then If DisplayErrorMessages = True Then MsgBox "Winsock not yet initialized." & Chr(13) & "Call the 'P_Initialize' function to initialize Winsock before continuing.", vbOKOnly + vbExclamation, " Windows Sockets Not Yet Initialized" End If Exit Function End If ' Make sure that the index is valid If Index > IPCount Or Index < 1 Then Exit Function ' Return the Winsock version number Return_IP = IPs(Index) P_GetMyIP = True End Function '============================================================================================================= ' P_GetMyName ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' Returns the network name for this computer. This can be set through Windows by going to : ' Control Panel -> Network -> Identification ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' Return_Name [out] Returns the name of this computer that uniquely identifies it on a network ' DisplayErrorMessages [in] Optional. If set to TRUE and an error occurs, an error message will be displayed. ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns TRUE if the function executed without any errors. ' Returns FALSE if an error occured. '============================================================================================================= Public Function P_GetMyName(Optional ByRef Return_Name As String, _ Optional ByVal DisplayErrorMessages As Boolean = True) As Boolean ' Check if connected If boolInitialized = False Then If DisplayErrorMessages = True Then MsgBox "Winsock not yet initialized." & Chr(13) & "Call the 'P_Initialize' function to initialize Winsock before continuing.", vbOKOnly + vbExclamation, " Windows Sockets Not Yet Initialized" End If Exit Function End If ' Get the name of this computer strCompName = String(MAX_PATH, Chr(0)) If gethostname(strCompName, MAX_PATH) = 0 Then strCompName = Left(strCompName, InStr(strCompName, Chr(0)) - 1) Return_Name = strCompName P_GetMyName = True Else GetLastWinsockErr WSAGetLastError, "gethostname", , , DisplayErrorMessages End If End Function '============================================================================================================= ' P_GetMyWsVer ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' Returns the version of Windows Sockets that the user currently has installed on their computer (assuming ' they have at least version 1.1). ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' Return_Version [out] Returns the version number for the version of Winsock currently installed. ' DisplayErrorMessages [in] Optional. If set to TRUE and an error occurs, an error message will be displayed. ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns TRUE if the function executed without any errors. ' Returns FALSE if an error occured. '============================================================================================================= Public Function P_GetMyWsVer(ByRef Return_Version As String, _ Optional ByVal DisplayErrorMessages As Boolean = True) As Boolean ' Check if connected If boolInitialized = False Then If DisplayErrorMessages = True Then MsgBox "Winsock not yet initialized." & Chr(13) & "Call the 'P_Initialize' function to initialize Winsock before continuing.", vbOKOnly + vbExclamation, " Windows Sockets Not Yet Initialized" End If Exit Function End If ' Return the Winsock version number Return_Version = strWinsockVer P_GetMyWsVer = True End Function '============================================================================================================= ' P_Initialize ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' Initializes the WSOCK32.DLL and/or WS2_32.DLL so that future calls to it/them can be completed successfuly. ' Failure to call this function successfuly first before calling other functions will result in an error or ' the function failing. ' ' NOTE - You MUST call the "P_Terminate" function after a successful call to this function in order to clean ' up the memory reserved by Windows Sockets. ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' DisplayErrorMessages [in] Optional. If set to TRUE and an error occurs, an error message will be displayed. ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns TRUE if the function executed without any errors. ' Returns FALSE if an error occured. '============================================================================================================= Public Function P_Initialize(Optional ByVal DisplayErrorMessages As Boolean = True) As Boolean Dim ReturnVal As Integer Dim WSData As WSADATA Dim VerMajor As Integer Dim VerMinor As Integer ' Disconnect any existing connection P_Terminate ' Initialize the Winsock DLL(s) ReturnVal = WSAStartup(REQUIRED_VER_11, WSData) If ReturnVal = 0 Then boolInitialized = True With WSData ' Get the version of Winsock strWinsockVer = CStr(HIBYTE(.wHighVersion)) & "." & CStr(LOBYTE(.wHighVersion)) ' See if the minimum required version is met VerMajor = HIBYTE(.wVersion) VerMinor = LOBYTE(.wVersion) If VerMajor <> REQUIRED_MAJOR Or VerMinor <> REQUIRED_MINOR Then If DisplayErrorMessages = True Then MsgBox "This application requires that you have at least Winsock version 1.1 installed. You currently have version " & strWinsockVer & " installed.", vbOKOnly + vbExclamation, " Invalid Winsock Version" P_Terminate Exit Function End If End If ' Get the name of this computer P_GetMyName , DisplayErrorMessages ' Get the IP addresses for this computer P_GetALL_IPs strCompName, IPs, IPCount, DisplayErrorMessages ' Return succeeded P_Initialize = True End With Else GetLastWinsockErr ReturnVal, "WSAStartup", , , DisplayErrorMessages P_Terminate End If End Function '============================================================================================================= ' P_Initialized_OK ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' Returns whether a successful call to the "P_Initialize" function has been made or not. ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' None ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns TRUE if P_Initialize has successfuly been called and Winsock is initialized. ' Returns FALSE if Winsock has not yet been initialized. '============================================================================================================= Public Function P_Initialized_OK() As Boolean P_Initialized_OK = boolInitialized End Function '============================================================================================================= ' P_IsIpAddress ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' This function takes the specified address and tests it to see if it appears to be an IP address or not. ' Valid IP addresses have the following format: 255.255.255.255 ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' AddressToTest [in] Specifies the address to test. ' Return_Dot1 [out] Optional. Returns the first set of numbers in the IP address if it is an IP address. ' Return_Dot2 [out] Optional. Returns the second set of numbers in the IP address if it is an IP address. ' Return_Dot3 [out] Optional. Returns the third set of numbers in the IP address if it is an IP address. ' Return_Dot4 [out] Optional. Returns the fourth set of numbers in the IP address if it is an IP address. ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns TRUE if the function executed without any errors. ' Returns FALSE if an error occured. '============================================================================================================= Public Function P_IsIpAddress(ByVal AddressToTest As String, _ Optional ByRef Return_Dot1 As Byte, _ Optional ByRef Return_Dot2 As Byte, _ Optional ByRef Return_Dot3 As Byte, _ Optional ByRef Return_Dot4 As Byte) As Boolean Dim StartPoint As Long Dim EndPoint As Long Dim Dot1 As String Dim Dot2 As String Dim Dot3 As String Dim Dot4 As String Dim TestNum As String ' Clear the passed values Return_Dot1 = 0 Return_Dot2 = 0 Return_Dot3 = 0 Return_Dot4 = 0 ' Clean up the address AddressToTest = Trim(AddressToTest) ' Check if the address passed is blank If AddressToTest = "" Then Exit Function ' Check if there are dots in the address ElseIf InStr(AddressToTest, ".") = 0 Then Exit Function End If ' Go through the address and get the different numbers StartPoint = 1 EndPoint = InStr(AddressToTest, ".") Dot1 = Mid(AddressToTest, StartPoint, EndPoint - StartPoint) TestNum = Dot1 GoSub CheckNum StartPoint = EndPoint + 1 EndPoint = InStr(StartPoint, AddressToTest, ".") Dot2 = Mid(AddressToTest, StartPoint, EndPoint - StartPoint) TestNum = Dot2 GoSub CheckNum StartPoint = EndPoint + 1 EndPoint = InStr(StartPoint, AddressToTest, ".") Dot3 = Mid(AddressToTest, StartPoint, EndPoint - StartPoint) TestNum = Dot3 GoSub CheckNum StartPoint = EndPoint + 1 EndPoint = Len(AddressToTest) + 1 Dot4 = Mid(AddressToTest, StartPoint, EndPoint - StartPoint) TestNum = Dot4 GoSub CheckNum ' Return the values collected Return_Dot1 = CByte(Dot1) Return_Dot2 = CByte(Dot2) Return_Dot3 = CByte(Dot3) Return_Dot4 = CByte(Dot4) ' Passed address appears to be a valid IP address P_IsIpAddress = True Exit Function CheckNum: TestNum = Trim(TestNum) If TestNum = "" Then Exit Function ElseIf IsNumeric(TestNum) = False Then Exit Function ElseIf Len(TestNum) > 3 Then Exit Function ElseIf CInt(TestNum) < 0 Or CInt(TestNum) > 255 Then Exit Function End If Return End Function '============================================================================================================= ' P_PING ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' This function sends a "PING" or echo request to the specified server and returns the results of the ping. ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' AddressToPing [in] Specifies the server to ping. This can be an IP address (255.255.255.255) or ' a full address (www.Microsoft.com). If an IP address is used, this function ' will execute quicker and more efficiently because it doesn't have to resolve ' the IP address. ' Timeout [in] Optional. Specifies the amount of time (in milliseconds) to wait for a response ' from the specified server before timing out and returning unsuccessfuly. ' PingData [in] Optional. Specifies a string value to be sent as the PING data. This is not ' really important, as long as it's a string of some kind. If this is not ' specified, the title of this application is used instead. ' PreferredIpIndex [in] Optional. If the "AddressToPing" parameter is an address rather than an IP, and ' that address resolved more than one IP address, this parameter is used to specify ' which IP address to PING. The default is 1. ' Return_PingTime [out] Optional. This returns the time (in milliseconds) it took to send the PingData to ' the specified server and get a response back. ' Return_DataMatched [out] Optional. If the data that was returned as a result of the PING matches the data ' that was returned from the server, this parameter is set to TRUE. This tests the ' integrity of the PING data that was sent back and forth. ' Return_IpUsed [out] Optional. Returns the IP address of the server that actually responded to the ' PING request. It is possible that the reply server is different than the one ' that was initially pinged. This depends on how the server is setup. ' Return_StatusNum [out] Optional. Returns a status code / error code of the ping result. ' Return_StatusDesc [out] Optional. Returns a description of the status code / error code. ' DisplayErrorMessages [in] Optional. If set to TRUE and an error occurs, an error message will be displayed. ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns TRUE if the function executed without any errors. ' Returns FALSE if an error occured. '============================================================================================================= Public Function P_PING(ByVal AddressToPing As String, _ Optional ByVal Timeout As Long = 2500, _ Optional ByVal PingData As String = "PING THIS", _ Optional ByVal PreferredIpIndex As Integer = 1, _ Optional ByRef Return_PingTime As Long, _ Optional ByRef Return_DataMatched As Boolean, _ Optional ByRef Return_IpUsed As String, _ Optional ByRef Return_StatusNum As Long, _ Optional ByRef Return_StatusDesc As String, _ Optional ByVal DisplayErrorMessages As Boolean = True) As Boolean Dim hICMP As Long Dim lngAddress As Long Dim BufferCount As Long Dim EchoReply As ICMP_ECHO_REPLY ' Check if connected If boolInitialized = False Then If DisplayErrorMessages = True Then MsgBox "Winsock not yet initialized." & Chr(13) & "Call the 'P_Initialize' function to initialize Winsock before continuing.", vbOKOnly + vbExclamation, " Windows Sockets Not Yet Initialized" End If Exit Function End If ' Check if the passed address is an IP address, or a domain name AddressToPing = Trim(AddressToPing) If AddressToPing = "" Then Exit Function lngAddress = Conv_AddressToLong(AddressToPing, PreferredIpIndex) If lngAddress = 0 Then Exit Function ' If no ping data is specified, use the title of this application If PingData = "" Then PingData = App.Title & Chr(0) If Right(PingData, 1) <> Chr(0) Then PingData = PingData & Chr(0) ' Initialize the PING library hICMP = IcmpCreateFile If hICMP = 0 Then GetLastWin32Err Err.LastDllError, "IcmpCreateFile", Return_StatusNum, Return_StatusDesc, DisplayErrorMessages Exit Function End If ' Ping the specified address and return the results ' NOTE : When the "IcmpSendEcho" API is called, it is possible for the API to return several results. ' The way this is setup, it only returns the first one (which is usually all that is returned). ' To get all of them, change the "ReplyBuffer" from ICMP_ECHO_REPLY to LONG... then use CopyMemory ' to retrieve each structure in turn using the return value for the API. BufferCount = IcmpSendEcho(hICMP, lngAddress, PingData, Len(PingData), 0, EchoReply, Len(EchoReply), Timeout) If BufferCount = 0 Then Return_PingTime = -1 GetLastWin32Err Err.LastDllError, "IcmpSendEcho", Return_StatusNum, Return_StatusDesc, DisplayErrorMessages If Trim(Return_StatusDesc) = "" Then GetLastWinsockErr Return_StatusNum, "IcmpSendEcho", Return_StatusNum, Return_StatusDesc, DisplayErrorMessages End If Else With EchoReply Return_PingTime = .RoundTripTime Return_IpUsed = Conv_LongToAddress(.Address) Return_StatusNum = .Status Return_StatusDesc = GetStatus(.Status) If UCase(Trim(Left(.Data, InStr(.Data, Chr(0)) - 1))) & Chr(0) = UCase(Trim(PingData)) Then Return_DataMatched = True End With P_PING = True End If ' Release the memory taken by the ICMP library If IcmpCloseHandle(hICMP) = 0 Then GetLastWin32Err Err.LastDllError, "IcmpCloseHandle", Return_StatusNum, Return_StatusDesc, DisplayErrorMessages End If End Function '============================================================================================================= ' P_Terminate ' ' Description: ' ¯¯¯¯¯¯¯¯¯¯¯¯ ' This function terminates use of Windows Sockets and cleans up all memory used by it. This function MUST be ' called after a successful call to the "P_Initialize" function in order to avoid memory leaks. ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' None ' ' Return: ' ¯¯¯¯¯¯¯ ' None '============================================================================================================= Public Sub P_Terminate() ' Clean up the memory taken by Winsock WSACleanup ' Return variables to their default values boolInitialized = False strWinsockVer = "" strCompName = "" IPCount = 0 Erase IPs End Sub 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX Private Function GetStatus(ByVal lngStatus As Long) As String Select Case lngStatus Case IP_SUCCESS: GetStatus = "Success" Case IP_BUF_TOO_SMALL: GetStatus = "Buffer Too Small" Case IP_DEST_NET_UNREACHABLE: GetStatus = "Destination Net Unreachable" Case IP_DEST_HOST_UNREACHABLE: GetStatus = "Destination Host Unreachable" Case IP_DEST_PROT_UNREACHABLE: GetStatus = "Destination Prot Unreachable" Case IP_DEST_PORT_UNREACHABLE: GetStatus = "Destination Port Unreachable" Case IP_NO_RESOURCES: GetStatus = "No Resources" Case IP_BAD_OPTION: GetStatus = "Bad Option" Case IP_HW_ERROR: GetStatus = "HW Error" Case IP_PACKET_TOO_BIG: GetStatus = "Packet Too Big" Case IP_REQ_TIMED_OUT: GetStatus = "Request Timed Out" Case IP_BAD_REQ: GetStatus = "Bad Request" Case IP_BAD_ROUTE: GetStatus = "Bad Route" Case IP_TTL_EXPIRED_TRANSIT: GetStatus = "TTL Expired Transit" Case IP_TTL_EXPIRED_REASSEM: GetStatus = "TTL Expired Reassem" Case IP_PARAM_PROBLEM: GetStatus = "Param Problem" Case IP_SOURCE_QUENCH: GetStatus = "Source Quench" Case IP_OPTION_TOO_BIG: GetStatus = "Option Too Big" Case IP_BAD_DESTINATION: GetStatus = "Bad Destination" Case IP_ADDR_DELETED: GetStatus = "Addr Deleted" Case IP_SPEC_MTU_CHANGE: GetStatus = "Spec MTU change" Case IP_MTU_CHANGE: GetStatus = "MTU change" Case IP_UNLOAD: GetStatus = "Unload" Case IP_ADDR_ADDED: GetStatus = "Addr Added" Case IP_MEDIA_CONNECT: GetStatus = "Media Connect" Case IP_MEDIA_DISCONNECT: GetStatus = "Media Disconnect" Case IP_BIND_ADAPTER: GetStatus = "Bind Adapter" Case IP_UNBIND_ADAPTER: GetStatus = "Unbind Adapter" Case IP_DEVICE_DOES_NOT_EXIST: GetStatus = "Device Does Not Exist" Case IP_DUPLICATE_ADDRESS: GetStatus = "Duplicate Address" Case IP_INTERFACE_METRIC_CHANGE: GetStatus = "Interface Metric Change" Case IP_RECONFIG_SECFLTR: GetStatus = "Reconfig Secfltr" Case IP_NEGOTIATING_IPSEC: GetStatus = "Negotiating IPSEC" Case IP_INTERFACE_WOL_CAPABILITY_CHANGE: GetStatus = "Interface WOL Capability Change" Case IP_DUPLICATE_IPADD: GetStatus = "Duplicate IP Address" Case IP_GENERAL_FAILURE: GetStatus = "General Failure" Case IP_PENDING: GetStatus = "Pending" Case Else: GetStatus = "Unknown Status" End Select End Function Private Function HIBYTE(ByVal wValue As Integer) As Byte HIBYTE = Val("&H" & Left(Right("0000" & Hex(wValue), 4), 2)) End Function Private Function LOBYTE(ByVal wValue As Integer) As Byte LOBYTE = Val("&H" & Right("00" & Hex(wValue), 2)) End Function Private Function MAKEWORD(ByVal bHigh As Byte, ByVal bLow As Byte) As Integer MAKEWORD = Val("&H" & Right("00" & Hex(bHigh), 2) & Right("00" & Hex(bLow), 2)) End Function