Function to convert IP Address to Hostname (64 bit)

NewOrderFac33

Well-known Member
Joined
Sep 26, 2011
Messages
1,283
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
Good afternoon - since our upgrade to Win 10/Office 2016 64 bit, a lot of my functions, including those to extract IP addresses from HostNames and vice versa no longer work (no surprise there, then)

Even when I add PtrSafe to my existing functions that worked in Win7/Office 2010 32 bit, the Excel instance just crashes.

I've Googled for a while, and whilst I have found a function to extract the IP address from a HostName, I still haven't been able to find a function to do the reverse, so, can any of you nice folks out there help me, please?

P.S. Any HostName->IP functions that are neater than what I already have would also be welcome!

Thanks in advance

Pete
 
Last edited:

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
What do you already have? It may be that you simply need to change a few variables to LongPtr.
 
Upvote 0
Hi, Rory - here it is:

Code:
'----------------------------------------------------------------------
'Name:      Get IPAddress+HostName.xlsm
'Date:      2015-07-06
'Module:    Mod_01_Procedures
'Source:    http://access.mvps.org/access/api/api0067.htm
'Comments:  Since a machine can have multiple IP addresses bound to it,
'           a call to fGetHostIPAddresses will return a VBA collection
'           filled with all the possible IP addresses.
'           A call to fGetHostName will return only one IP address
'           since IP Addresses will be unique.


'Usage:     MsgBox (fGetHostIPAddresses("MyHostName").Item(1))
'           MsgBox (fGetHostName("99.99.99.99"))
'----------------------------------------------------------------------


Dim MrCell As Range
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const AF_INET = 2


Private Type WSADATA
    wversion As Integer
    wHighVersion As Integer
    szDescription(MAX_WSADescription) As Byte
    szSystemStatus(MAX_WSASYSStatus) As Byte
    wMaxSockets As Long
    wMaxUDPDG As Long
    dwVendorInfo As Long
End Type
  
Private Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLength As Integer
    hAddrList As Long
End Type
 
' returns the standard host name for the local machine
Private Declare PtrSafe Function apiGetHostName _
    Lib "wsock32" Alias "gethostname" _
    (ByVal name As String, _
    ByVal nameLen As Long) _
    As Long
 
' retrieves host information corresponding to a host name
' from a host database
Private Declare PtrSafe Function apiGetHostByName _
    Lib "wsock32" Alias "gethostbyname" _
    (ByVal hostname As String) _
    As Long
 
' retrieves the host information corresponding to a network address
Private Declare PtrSafe Function apiGetHostByAddress _
    Lib "wsock32" Alias "gethostbyaddr" _
    (addr As Long, _
    ByVal dwLen As Long, _
    ByVal dwType As Long) _
    As Long
 
' moves memory either forward or backward, aligned or unaligned,
' in 4-byte blocks, followed by any remaining bytes
Private Declare PtrSafe Function sapiCopyMem _
    Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)
 
' converts a string containing an (Ipv4) Internet Protocol
' dotted address into a proper address for the IN_ADDR structure
Private Declare PtrSafe Function apiInetAddress _
    Lib "wsock32" Alias "inet_addr" _
    (ByVal cp As String) _
    As Long


' function initiates use of Ws2_32.dll by a process
Private Declare PtrSafe Function apiWSAStartup _
    Lib "wsock32" Alias "WSAStartup" _
    (ByVal wVersionRequired As Integer, _
    lpWsaData As WSADATA) _
    As Long
 
Private Declare PtrSafe Function apilstrlen _
    Lib "kernel32" Alias "lstrlen" _
    (ByVal lpString As Long) _
    As Long
 
Private Declare PtrSafe Function apilstrlenW _
    Lib "kernel32" Alias "lstrlenW" _
    (ByVal lpString As Long) _
    As Long


'function terminates use of the Ws2_32.dll
Private Declare PtrSafe Function apiWSACleanup _
    Lib "wsock32" Alias "WSACleanup" _
    () As Long
    
Function fGetHostIPAddresses(strHostName As String) As Collection
'
' Resolves the English HostName and returns
' a collection with all the IPs bound to the card
'
On Error GoTo ErrHandler
Dim lngRet As Long
Dim lpHostEnt As HOSTENT
Dim strOut As String
Dim colOut As Collection
Dim lngIPAddr As Long
Dim abytIPs() As Byte
Dim i As Integer


    Set colOut = New Collection
    
    If fInitializeSockets() Then
        strOut = String$(255, vbNullChar)
        lngRet = apiGetHostByName(strHostName)
        If lngRet Then
        
            Call sapiCopyMem( _
                    lpHostEnt, _
                    ByVal lngRet, _
                    Len(lpHostEnt))
                    
            Call sapiCopyMem( _
                    lngIPAddr, _
                    ByVal lpHostEnt.hAddrList, _
                    Len(lngIPAddr))
                    
            Do While (lngIPAddr)
                With lpHostEnt
                    ReDim abytIPs(0 To .hLength - 1)
                    strOut = vbNullString
                    Call sapiCopyMem( _
                        abytIPs(0), _
                        ByVal lngIPAddr, _
                        .hLength)
                    For i = 0 To .hLength - 1
                        strOut = strOut & abytIPs(i) & "."
                    Next
                    strOut = Left$(strOut, Len(strOut) - 1)
                    .hAddrList = .hAddrList + Len(.hAddrList)
                    Call sapiCopyMem( _
                            lngIPAddr, _
                            ByVal lpHostEnt.hAddrList, _
                            Len(lngIPAddr))
                    If Len(Trim$(strOut)) Then colOut.Add strOut
                End With
            Loop
        End If
    End If
    Set fGetHostIPAddresses = colOut
ExitHere:
    Call apiWSACleanup
    Set colOut = Nothing
    Exit Function
ErrHandler:
    With Err
        MsgBox "Error: " & .Number & vbCrLf & .Description, _
            vbOKOnly Or vbCritical, _
            .Source
    End With
    Resume ExitHere
End Function
 
Function fGetHostName(strIPAddress As String) As String
'
' Looks up a given IP address and returns the
' machine name it's bound to
'
On Error GoTo ErrHandler
Dim lngRet As Long
Dim lpAddress As Long
Dim strOut As String
Dim lpHostEnt As HOSTENT
 
    If fInitializeSockets() Then
        lpAddress = apiInetAddress(strIPAddress)
        lngRet = apiGetHostByAddress(lpAddress, 4, AF_INET)
        If lngRet Then
            Call sapiCopyMem( _
                lpHostEnt, _
                ByVal lngRet, _
                Len(lpHostEnt))
            fGetHostName = fStrFromPtr(lpHostEnt.hName, False)
        End If
    End If
ExitHere:
    Call apiWSACleanup
    Exit Function
ErrHandler:
    With Err
        MsgBox "Error: " & .Number & vbCrLf & .Description, _
            vbOKOnly Or vbCritical, _
            .Source
    End With
    Resume ExitHere
End Function
 
Private Function fInitializeSockets() As Boolean
Dim lpWsaData As WSADATA
Dim wVersionRequired As Integer
 
    wVersionRequired = fMakeWord(2, 2)
    fInitializeSockets = ( _
        apiWSAStartup(wVersionRequired, lpWsaData) = 0)
 
End Function
 
Private Function fMakeWord( _
                            ByVal low As Integer, _
                            ByVal hi As Integer) _
                            As Integer
Dim intOut As Integer
    Call sapiCopyMem( _
        ByVal VarPtr(intOut) + 1, _
        ByVal VarPtr(hi), _
        1)
    Call sapiCopyMem( _
        ByVal VarPtr(intOut), _
        ByVal VarPtr(low), _
        1)
    fMakeWord = intOut
End Function
 
Private Function fStrFromPtr( _
                                    pBuf As Long, _
                                    Optional blnIsUnicode As Boolean) _
                                    As String
Dim lngLen As Long
Dim abytBuf() As Byte
 
    If blnIsUnicode Then
        lngLen = apilstrlenW(pBuf) * 2
    Else
        lngLen = apilstrlen(pBuf)
    End If
    ' if it's not a ZLS
    If lngLen Then
        ReDim abytBuf(lngLen)
        ' return the buffer
        If blnIsUnicode Then
            'blnIsUnicode is True not tested
            Call sapiCopyMem(abytBuf(0), ByVal pBuf, lngLen)
            fStrFromPtr = abytBuf
        Else
            ReDim Preserve abytBuf(UBound(abytBuf) - 1)
            Call sapiCopyMem(abytBuf(0), ByVal pBuf, lngLen)
            fStrFromPtr = StrConv(abytBuf, vbUnicode)
        End If
    End If
End Function
 
Last edited:
Upvote 0
Yes, you've definitely got some pointers there that will need conversion. I'll have a look tomorrow when I have access to 64bit.
 
Upvote 0
Yes, you've definitely got some pointers there that will need conversion. I'll have a look tomorrow when I have access to 64bit.
Hi, Rory - I don't suppose you got a chance to take a look at this for me, did you?
 
Upvote 0
Only briefly I'm afraid and the CopyMemory kept crashing my VM. Can you just test if this works for you for getting the IP address from a hostname:

Code:
Function fWMIGetIPAddress(strComputer As String) As String
   Dim objWMIService, colItems, objItem
   Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
   Set colItems = objWMIService.ExecQuery _
                  ("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

   For Each objItem In colItems
      fWMIGetIPAddress = objItem.IPAddress(0)
      Exit For
   Next objItem
End Function
 
Upvote 0
Code:
Sub test_HostName()
  MsgBox HostName("99.99.99.99")
End Sub

Function HostName(ip$)
  Dim s As String, a
  s = CreateObject("Wscript.Shell").Exec("nslookup " & ip).StdOut.ReadAll
  a = Split(s, vbCrLf)
  If UBound(a) > 2 Then HostName = Right(a(3), Len(a(3)) - 9)
End Function
 
Last edited:
Upvote 0
Rory - yes, this works fine, thanks very much!
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,248
Members
452,623
Latest member
cliftonhandyman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top