VB and VBA Users Source Code: Converting a host name to an IP address and back (plus pinging a machine)
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Converting a host name to an IP address and back (plus pinging a machine)
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, July 23, 2001
Hits:
2471
Category:
Internet/Remote Comms
Article:
The following code demonstrates how to convert a machine name into an ip address and vice versa, plus demonstrates how to ping an address. Option Explicit Private Const IP_SUCCESS As Long = 0 Private Const PING_TIMEOUT As Long = 2000 'Wait 2 secs Private Const SOCKET_ERROR As Long = -1 Private Const INADDR_NONE As Long = &HFFFFFFFF Private Type HOSTENT h_name As Long h_aliases As Long h_addrtype As Integer h_length As Integer h_addr_list As Long End Type Private Type ICMP_OPTIONS ttl As Byte Tos As Byte Flags As Byte OptionsSize As Byte OptionsData As Long End Type Private Type ICMP_ECHO_REPLY Address As Long Status As Long RoundTripTime As Long datasize As Long DataPointer As Long Options As ICMP_OPTIONS Data As String * 250 End Type Private Const MAX_WSADescription = 256, MAX_WSASYSStatus = 128 Private Const WS_VERSION_REQD = &H101 Private Type WSADATA wVersion As Integer wHighVersion As Integer szDescription(0 To MAX_WSADescription) As Byte szSystemStatus(0 To MAX_WSASYSStatus) As Byte wMaxSockets As Long wMaxUDPDG As Long dwVendorInfo As Long End Type Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long 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 Private Declare Function WSAGetLastError Lib "wsock32.dll" () As Long Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long Private Declare Function WSACleanup Lib "wsock32.dll" () As Long Private Declare Function gethostname Lib "wsock32.dll" (ByVal szHost As String, ByVal dwHostLen As Long) As Long Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal szHost As String) As Long Private Declare Function inet_addr Lib "wsock32.dll" (ByVal s As String) As Long Private Declare Function gethostbyaddr Lib "wsock32.dll" (haddr As Long, ByVal hnlen As Long, ByVal addrtype As Long) As Long Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, ByVal nbytes As Long) Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Any) As Long Private Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As String, ByVal Ptr As Long) As Long Private Declare Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long 'Purpose : Pings an IP address, can be a host name or a dot address 'Inputs : sAddress The address to ping. Can be a dot address or a machine name 'Outputs : If succeeds returns 0, else returns an error code. 'Author : Andrew Baker 'Date : 13/Jul/2001 'Notes : Public Function PingAddress(ByVal sAddress As String) As Long Const sSendData As String = "TESTMESSAGE" Const IP_REQ_TIMED_OUT As Long = (11000 + 10) Dim echo As ICMP_ECHO_REPLY Dim lhwndPort As Long Dim lAddress As Long Dim WSAD As WSADATA If WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS Then 'Converts a string containing an (Ipv4) Internet Protocol dotted address 'into a proper address for the IN_ADDR structure lAddress = inet_addr(sAddress) If lAddress = SOCKET_ERROR Then 'Try resolving a host name address sAddress = HostNameToIP(sAddress) 'Convert to long address lAddress = inet_addr(sAddress) End If If lAddress <> INADDR_NONE Then 'Address is valid, create a handle on which Internet Control 'Message Protocol (ICMP) requests can be issued. lhwndPort = IcmpCreateFile If lhwndPort Then 'Ping the address Call IcmpSendEcho(lhwndPort, lAddress, sSendData, Len(sSendData), 0, echo, Len(echo), PING_TIMEOUT) 'Return the ping status PingAddress = echo.Status If Err.LastDllError Then Debug.Print "Failed to ping address, error " & Err.LastDllError End If 'Close port Call IcmpCloseHandle(lhwndPort) WSACleanup End If Else 'the address format was probably invalid PingAddress = INADDR_NONE End If End If End Function 'Purpose : Converts a host name to an IP address. 'Inputs : sHostName The host name to convert to an IP address, if empty returns local IP address. 'Outputs : If succeeds returns an IP address, else returns an empty string. 'Author : Andrew Baker 'Date : 13/Jul/2001 'Notes : This routine effectively performs a trace root(tracert.exe) to trace the path ' a packet takes through a network. Function HostNameToIP(Optional ByVal sHostName As String) As String Dim lAddress As Long, lIPAddress As Long Dim lHosent As Long, lName As Long lHosent = gethostbyname(sHostName & vbNullChar) If lHosent <> 0 Then 'If using the DNS resolution system, it is the 'Fully Qualified Domain Name (FQDN). If using a 'local hosts file, it is the first entry after the IP address. lName = lHosent 'The address is offset by 12 bytes. lAddress = lHosent + 12 'Get IP address CopyMemory lAddress, ByVal lAddress, 4 CopyMemory lIPAddress, ByVal lAddress, 4 CopyMemory lAddress, ByVal lIPAddress, 4 'Format address lAddress = inet_ntoa(lAddress) 'Return address HostNameToIP = StrFromPtrA(lAddress) End If End Function 'Purpose : Converts a pointer an ansi string into a string. 'Inputs : lptrString A long pointer to a string held in memory 'Outputs : The string held at the specified memory address 'Author : Andrew Baker 'Date : 03/08/2000 19:14 'Notes : 'Revisions : Function StrFromPtrA(ByVal lptrString As Long) As String 'Create buffer StrFromPtrA = String$(lstrlenA(ByVal lptrString), 0) 'Copy memory Call lstrcpyA(ByVal StrFromPtrA, ByVal lptrString) End Function 'Purpose : Return the error message associated with LastDLLError 'Inputs : lLastDLLError The error number of the last DLL error (from Err.LastDllError) 'Outputs : Returns the error message associated with the DLL error number 'Author : Andrew Baker 'Date : 13/11/2000 10:14 'Notes : 'Revisions : Public Function DLLErrorText(ByVal lLastDLLError As Long) As String Dim sBuff As String * 256 Dim lCount As Long Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100, FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000 Const FORMAT_MESSAGE_FROM_HMODULE = &H800, FORMAT_MESSAGE_FROM_STRING = &H400 Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000, FORMAT_MESSAGE_IGNORE_INSERTS = &H200 Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF lCount = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0) If lCount Then DLLErrorText = Left$(sBuff, lCount - 2) 'Remove line feeds End If End Function 'Purpose : Resolves a host name to an IP address (i.e. converts IP address to a machine name) 'Inputs : IPAddress The IP address to convert to a machine name 'Outputs : Returns an the machine name for the IP address or "FAILED" if it was not successfull 'Author : Andrew Baker 'Date : 13/11/2000 10:14 'Notes : 'Revisions : Function HostNameFromIP(IPAddress As String) As String Const AF_INET = 2 Const IPM_ISBLANK = &H469 Const IPM_GETADDRESS = &H466 Dim tHostInfo As HOSTENT 'Type containing info about the host computer Dim tSockInfo As WSADATA 'Type containing info about the Winsock implementation Dim lNumIPAddress As Long 'IP address (network byte order) Dim lpHostinfo As Long Dim lRetVal As Long Dim sDomainName As String 'The primary domain name of the host computer On Error Resume Next 'Open up a Winsock v2.2 session. lRetVal = WSAStartup(&H202, tSockInfo) If lRetVal <> 0 Then HostNameFromIP = "FAILED" 'Attempt to open Winsock failed Else 'Convert the IP address into network byte order. lNumIPAddress = inet_addr(IPAddress) 'Get information about the host computer. lpHostinfo = gethostbyaddr(lNumIPAddress, 4, AF_INET) If lpHostinfo = 0 Then HostNameFromIP = "FAILED" 'Could not find a host with the specified IP address. Else 'Copy the data into the structure. CopyMemory tHostInfo, ByVal lpHostinfo, Len(tHostInfo) 'Copy the host domain name into a string. sDomainName = Space(lstrlen(tHostInfo.h_name)) lRetVal = lstrcpyA(sDomainName, tHostInfo.h_name) HostNameFromIP = sDomainName End If 'End the Winsock session. lRetVal = WSACleanup() End If End Function 'Demonstration routine Sub Test() Dim sIPAddress As String 'Ping an address If PingAddress(Environ("ComputerName")) = 0 Then MsgBox "Successfully pinged local machine!" Else MsgBox "Failed to ping local machine!" End If 'Get the IP address of a machine sIPAddress = HostNameToIP(Environ("ComputerName")) MsgBox "The IP address of this machine is " & sIPAddress 'Convert (resolve) the IP address back to a machine name MsgBox "The machine name for the IP address " & sIPAddress & " is " & HostNameFromIP(sIPAddress) End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
