无法在64位VBA中查找IP地址
我的基本问题是，我有一个电子表格，其中有10个数以千计的FQDN（完全合格的域名）条目，我需要检查FQDN是否是公共Internet上的有效DNS条目。 我正在做每个FQDN的DNS查询，并想指定一个公共的DNS服务器。 如果对DNS的调用返回一个IP地址，我将假定FQDN是有效的。 我在Excel 64位工作，但需要一个解决scheme，也将编译和工作在32位，所以我想要相同的源代码能够被编译在两个。 由于电子表格中有很多行，所以我不想使用为每个查找创build一个临时文件的函数。 （当系统调用可用时，我是关于不需要的临时文件的OCD）。
我相信函数“getaddrinfoex”提供了指定什么名字服务器被查询的能力，但是我一直没能find任何使用getaddrinfoex或较小版本的getaddrinfo（不允许指定DNS服务器）的VBA片段。 我find几个调用gethostbyname的例子，但都是32位的Excel。 此外，微软已经发布，gethostbyname已被弃用（ https://msdn.microsoft.com/en-us/library/windows/desktop/ms738524(v=vs.85).aspx ），所以我试图使用build议更换getaddrinfo
如何使用Microsoft Access与Visual Basic进行networking连接？
在上面链接的问题中，@david在答案中发布的代码片段看起来具有32位和64位兼容的正确语法。 但是这个例子并没有包含对gethostbyname的调用，它只提供了函数的声明。
getaddrinfoex在VBA中可用吗？ 有人有一个使用getaddrinfoex的例子，这将在32位和64位工作？
我将不胜感激任何帮助。 我有很多年没有编码，所以我的技能非常过时。 因此，我正在进行大量search以find我所需要的东西。
这里是我通过在线结合各种search创build的代码。
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 只要不移动到加载项（.xlam），我现在就可以工作了。 如果我把它移动到一个加载项，这个完全相同的代码在调用getaddrinfo时会崩溃。 我将继续努力。
该过程需要一个参数（主机名作为string传递）。 第二个参数是要返回的IP地址的最大数量（以整数forms传递），但是是可选的。 如果第二个参数为空，则返回所有IP地址。 当设置为非零值时，该值将是主机的最大IP地址数。
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