Resolving hostnames and IP Addresses with VB6

By | 2016-02-18

Some time ago, I wrote an app that required the ability to resolve hostnames to IP Addresses, and vice versa.  After some searching around, I found this gem.

I don’t recall exactly where I found it, but this little chunk of code has served me well, lo these many years.  It contains two functions:

  • GetHostNameFromIP
  • GetIPFromHostName

The functions do exactly what the name says. The first one resolves a hostname to an IP address, while the second one does a reverse, resolving an IP address to a hostname.  It performs both of these functions by leveraging Windows Sockets, or WinSock, to perform DNS lookups of the requested item.

Usage is pretty simple.  To resolve a hostname to an IP address, you can use this piece of code:

' make sure that windows sockets is initialized, and uses DNS to resolve the hostname to an IP address.
If SocketsInitialize() Then                                 
    RetrievedIPAddress = GetIPFromHostName(MyHostName)
    SocketsCleanup                                          
Else                                                        
    MsgBox "ER Sockets Failure - " &_
    "Check WinSock Install. Windows Sockets for 32 bit Windows is not successfully responding."
End If

But the meat of the program is elsewhere. Create a new module, and drop the below code into it, and you’ll be resolving names and IP addresses in no time!

Private Declare Function WSAStartup Lib "wsock32" _
  (ByVal VersionReq As Long, WSADataReturn As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32" () As Long
Private Declare Function inet_addr Lib "wsock32" (ByVal s As String) As Long
Private Declare Function gethostbyaddr Lib "wsock32" _
  (haddr As Long, ByVal hnlen As Long, ByVal addrtype 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" _
  Alias "lstrlenA" (lpString As Any) As Long
Public Const IP_SUCCESS As Long = 0
Public Const MAX_WSADescription As Long = 256
Public Const MAX_WSASYSStatus As Long = 128
Public Const WS_VERSION_REQD As Long = &H101
Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD As Long = 1
Public Const SOCKET_ERROR As Long = -1
Private Const WSADescription_Len As Long = 256
Private Const WSASYS_Status_Len As Long = 128
Private Const AF_INET As Long = 2

Public 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 gethostbyname Lib "wsock32" (ByVal hostname As String) As Long

Private Declare Function lstrlenA Lib "kernel32" (lpString As Any) As Long

Public Function SocketsInitialize() As Boolean

Dim WSAD As WSADATA
Dim SUCCESS As Long

SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
    
End Function

Public Sub SocketsCleanup()

If WSACleanup() <> 0 Then
   MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
End If
    
End Sub

Public Function GetIPFromHostName(ByVal sHostName As String) As String

Dim nbytes As Long
Dim ptrHosent As Long
Dim ptrName As Long
Dim ptrAddress As Long
Dim ptrIPAddress As Long
Dim sAddress As String

sAddress = Space$(4)
ptrHosent = gethostbyname(sHostName & vbNullChar)

If ptrHosent <> 0 Then
  ptrAddress = ptrHosent + 12
  CopyMemory ptrAddress, ByVal ptrAddress, 4            'get the IP address
  CopyMemory ptrIPAddress, ByVal ptrAddress, 4
  CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4
  GetIPFromHostName = IPToText(sAddress)
End If
   
End Function

Private Function IPToText(ByVal IPAddress As String) As String

IPToText = CStr(Asc(IPAddress)) & "." & _
          CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
          CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
          CStr(Asc(Mid$(IPAddress, 4, 1)))
              
End Function

Public Function GetHostNameFromIP(ByVal sAddress As String) As String

Dim ptrHosent As Long
Dim hAddress As Long
Dim nbytes As Long

If SocketsInitialize() Then
 
  hAddress = inet_addr(sAddress)                    'convert string address to long
  
  If hAddress <> SOCKET_ERROR Then
    
     ptrHosent = gethostbyaddr(hAddress, 4, AF_INET) 'obtain a pointer to the HOSTENT structure
                                                     'that contains the name and address
     If ptrHosent <> 0 Then                          'corresponding to the given network address.
     
        CopyMemory ptrHosent, ByVal ptrHosent, 4    'convert address and
        nbytes = lstrlen(ByVal ptrHosent)           'get resolved hostname
     
        If nbytes > 0 Then
           sAddress = Space$(nbytes)
           CopyMemory ByVal sAddress, ByVal ptrHosent, nbytes
           GetHostNameFromIP = sAddress
        End If
     
     Else: MsgBox "Call to gethostbyaddr failed."
     End If                                         'If ptrHosent
  
  SocketsCleanup
  
  Else: MsgBox "String passed is an invalid IP."
  End If                                            'If hAddress

Else: MsgBox "Sockets failed to initialize."
End If                                               'If SocketsInitialize
      
End Function

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.