Unable to look up IP address in 64-bit VBA - vba

Question

My base problem is that I have a spreadsheet with 10's of thousands of FQDN (fully qualified domain name) entries that I need to check if the FQDN is a valid DNS entry on the public internet. I am doing a DNS lookup of each FQDN and would like to specify a public DNS server. If the call to the DNS returns an IP address, I will assume the FQDN is valid. I am working in excel 64-bit, but need a solution that will also compile and work in 32-bit, so I want the same source code to be able to be compiled in both. Since there are so many rows in the spreadsheet, I don't want to use a function that creates a temporary file for each lookup. (I am OCD about unneeded temporary files when a system call is available).
I believe that the function "getaddrinfoex" provides the ability to specify what name server is queried, but I have not been able to find any VBA snippets that use getaddrinfoex or the lesser version of getaddrinfo (which does not allow specifying the DNS server). I have found several examples of calls to gethostbyname, but all are for 32-bit Excel. Also, Microsoft has published that gethostbyname has been deprecated (https://msdn.microsoft.com/en-us/library/windows/desktop/ms738524(v=vs.85).aspx), so I was trying to use the recommended replacement getaddrinfo
How can I make a network connection with Visual Basic from Microsoft Access?
The snippet posted in the answer by #david in the question I linked above looks to have the proper syntax to be both 32-bit and 64-bit compatible. But the example did not include the call to gethostbyname, it only provided the declaration of the function.
Is getaddrinfoex available in VBA? Does someone have an example of using getaddrinfoex which will work in both 32-bit and 64-bit?
I would appreciate any help. I have not coded in MANY years, so my skills are very dated. Thus I am doing a lot of searches to find what I need.
Here is the code I have created from combining various searches on-line.
Private Type HOSTENT
hName As LongPtr
hAliases As LongPtr
hAddrType As Integer
hLen As Integer
hAddrList As LongPtr
End Type
#if Not VBA7 then
' used by 32-bit compiler
Private Declare Function gethostbyname Lib "wsock32.dll" _
(ByVal HostName As String) As LongPtr
Private Declare Function getaddrinfo Lib "wsock32.dll" _
(ByVal HostName As String) As LongPtr
Public Declare Function WSAStartup Lib "wsock32.dll" _
(ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As LongPtr
#else
' used by 64-bit compiler
Private Declare PtrSafe Function gethostbyname Lib "wsock32.dll" _
(ByVal HostName As String) As LongPtr
Private Declare PtrSafe Function getaddrinfo Lib "wsock32.dll" _
(ByVal HostName As String) As LongPtr
Public Declare PtrSafe Function WSAStartup Lib "wsock32.dll" _
(ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As LongPtr
#endif
Public Function GetIPAddressFromHostName(ByVal HostName As String) _
As LongPtr
Dim HostEntry As HOSTENT
Dim HostEntry2 as HOSTENT
Dim HostEntryPtr As LongPtr
Dim HostEntryPtr2 As LongPtr
Dim IPAddressesPtr As LongPtr
Dim Result As Long
If InitializeSockets Then
' I added the call do getaddrinfo as an example
' I have been able to get it to work at all
HostEntryPtr2 = getaddrinfo(HostName & vbNullChar)
HostEntryPtr = gethostbyname(HostName & vbNullChar)
If HostEntryPtr > 0 Then
CopyMemory HostEntry, ByVal HostEntryPtr, Len(HostEntryPtr)
CopyMemory IPAddressesPtr, ByVal HostEntry.hAddrList, _
Len(IPAddressesPtr)
CopyMemory Result, ByVal IPAddressesPtr, Len(Result)
GetIPAddressFromHostName = Result
End If
End If
End Function
Public Function InitializeSockets() As Boolean
' Initialize Windows sockets.
Dim WinSockData As WSADATA
InitializeSockets = WSAStartup(WS_VERSION_REQD, WinSockData) = 0
End Function

Answer 1

I have it working now as long as it is not moved to an add-in (.xlam). If I move it to an add-in this exact same code crashes on the call to getaddrinfo. I will continue to work on that.
The procedure requires one argument (hostname passed as a string). The second argument is the maximum number of IP addresses to return (passed as an integer), but is optional. If the second argument is blank, all IP address are returned. When set to a value other than zero, that value will be the maximum number of ip addresses for the host.
Private Const AF_UNSPEC As Long = 0
Private Const AF_INET As Long = 2
Private Const AF_INET6 As Long = 23
Private Const SOCK_STREAM As Long = 1
Private Const INADDR_ANY As Long = 0
Private Const IPPROTO_TCP As Long = 6
' Getaddrinfo return status codes
Private Const WAS_NOT_ENOUGH_MEMORY = 8 ' Insufficient memory available.
Private Const WASEINVAL = 10022 ' Invalid argument.
Private Const WASESOCKTNOSUPPORT = 10044 ' Socket type not supported.
Private Const WASEAFNOSUPPORT = 10047 ' Address family not supported by protocol family.
Private Const WASNOTINITIALISED = 10093 ' Successful WSAStartup not yet performed.
Private Const WASTYPE_NOT_FOUND = 10109 ' Class type not found.
Private Const WASHOST_NOT_FOUND = 11001 ' Host not found.
Private Const WASTRY_AGAIN = 11002 ' Nonauthoritative host not found.
Private Const WASNO_RECOVERY = 11003 ' This is a nonrecoverable error.
Private Const WASNO_DATA = 11004 ' Valid name, no data record of requested type.
'AI_flags
Private Const AI_PASSIVE As Long = &H1
Private Const ai_canonName As Long = &H2
Private Const AI_NUMERICHOST As Long = &H4
Private Const AI_ALL As Long = &H100
Private Const AI_ADDRCONFIG As Long = &H400
Private Const AI_V4MAPPED As Long = &H800
Private Const AI_NON_AUTHORITATIVE As Long = &H4000
Private Const AI_SECURE As Integer = &H8000
Private Const AI_RETURN_PREFERRED_NAMES As Long = &H10000
Private Const AI_FQDN As Long = &H20000
Private Const AI_FILESERVER As Long = &H40000
Dim hSocket As Long
Dim sServer As String
' To initialize Winsock.
Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(256 + 1) As Byte
szSystemstatus(128 + 1) As Byte
iMaxSockets As Integer
iMaxUpdDg As Integer
lpVendorInfo As Long
End Type
Private Type in_addr
s_addr As LongPtr
End Type
Private Type sockaddr_in
sin_family As Integer '2 bytes
sin_port As Integer '2 bytes
sin_addr As in_addr '4 bytes or 8 bytes
sin_zero(7) As Byte '8 bytes
End Type 'Total 16 bytes or 24 bytes
Private Type sockaddr
sa_family As Integer '2 bytes
sa_data(25) As Byte '26 bytes
End Type 'Total 28 bytes
Private Type addrinfo
ai_flags As Long
ai_family As Long
ai_socktype As Long
ai_protocol As Long
ai_addrlen As Long
ai_canonName As LongPtr 'strptr
ai_addr As LongPtr 'p sockaddr
ai_next As LongPtr 'p addrinfo
End Type
Private Declare PtrSafe Function API_Socket Lib "ws2_32.dll" Alias "socket" (ByVal af As Long, ByVal stype As Long, ByVal Protocol As Long) As Long
Private Declare PtrSafe Function API_GetAddrInfo Lib "ws2_32.dll" Alias "getaddrinfo" (ByVal NodeName As String, ByVal ServName As String, ByVal lpHints As LongPtr, lpResult As LongPtr) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare PtrSafe Function ntohs Lib "ws2_32.dll" (ByVal netshort As Long) As Integer
Public Function NameToIPaddress(hostname As String, Optional MaxReturn As Integer = 0) As String
Dim sa_local As sockaddr_in
Dim sa_dest As sockaddr
Dim lRet As Long
Dim Hints As addrinfo
Dim ptrResult As LongPtr
Dim IPaddress As String
Dim AddressList As String
Dim AddressType As Long
Dim Cnt As Integer
AddressType = AF_INET
If hostname = "" Then
NameToIPaddress = ""
Exit Function
End If
'Create TCP socket
hSocket = API_Socket(AddressType, SOCK_STREAM, IPPROTO_TCP)
If hSocket = 0 Then
MsgBox ("Failed to create socket!")
Exit Function
End If
'Populate the local sockaddr
sa_local.sin_family = AddressType
sa_local.sin_port = ntohs(0&)
sa_local.sin_addr.s_addr = INADDR_ANY
'Recover info about the destination.
'Hints.ai_flags = AI_NON_AUTHORITATIVE
Hints.ai_flags = 0
Hints.ai_family = AddressType
sServer = hostname & vbNullChar 'Null terminated string
sServer = hostname
lRet = API_GetAddrInfo(sServer, 0, VarPtr(Hints), ptrResult)
If lRet <> 0 Then
If lRet = WASHOST_NOT_FOUND Then
NameToIPaddress = "not found"
Exit Function
End If
Dim errorText As String
Select Case lRet
Case WAS_NOT_ENOUGH_MEMORY
errorText = "Insufficient memory available"
Case WASEINVAL
errorText = "Invalid argument"
Case WASESOCKTNOSUPPORT
errorText = "Socket type not supported"
Case WASEAFNOSUPPOR
errorText = "Address family not supported by protocol family"
Case WASNOTINITIALISED
errorText = "Successful WSAStartup not yet performed"
Case WASTYPE_NOT_FOUND
errorText = "Class type not found"
Case WASHOST_NOT_FOUND
errorText = "Host not found"
Case WASTRY_AGAIN
errorText = "Nonauthoritative host not found"
Case WASNO_RECOVERY
errorText = "This is a nonrecoverable error"
Case WASNO_DATA
errorText = "Valid name, no data record of requested type"
Case Else
errorText = "unknown error condition"
End Select
'MsgBox ("Error in GetAddrInfo: " & lRet & " - " & errorText)
NameToIPaddress = "#Error in lookup"
Exit Function
End If
Cnt = 0
Hints.ai_next = ptrResult 'Pointer to first structure in linked list
Do While Hints.ai_next > 0 And (Cnt < MaxReturn Or MaxReturn = 0)
CopyMemory Hints, ByVal Hints.ai_next, LenB(Hints) 'Copy next address info to Hints
CopyMemory sa_dest, ByVal Hints.ai_addr, LenB(sa_dest) 'Save sockaddr portion
Select Case sa_dest.sa_family
Case AF_INET
IPaddress = sa_dest.sa_data(2) & "." & sa_dest.sa_data(3) & "." & sa_dest.sa_data(4) & "." & sa_dest.sa_data(5)
Case AF_INET6
IPaddress = sa_dest.sa_data(0) & ":" & sa_dest.sa_data(1) & ":" & sa_dest.sa_data(2) & "::" & sa_dest.sa_data(3) & ":" & sa_dest.sa_data(4)
Case Else
IPaddress = ""
End Select
Cnt = Cnt + 1
If AddressList = "" Then
AddressList = IPaddress
Else
AddressList = AddressList & "," & IPaddress
End If
Loop
NameToIPaddress = AddressList
End Function