无法查找 64 位 IP 地址 VBA
Unable to look up IP address in 64-bit VBA
我的基本问题是我有一个电子表格，其中包含数以千计的 FQDN（完全限定域名）条目，我需要检查 FQDN 是否是 public 互联网上的有效 DNS 条目。我正在对每个 FQDN 进行 DNS 查找，并想指定一个 public DNS 服务器。如果调用 DNS returns 一个 IP 地址，我将假定 FQDN 是有效的。我在 excel 64 位中工作，但需要一个也能在 32 位中编译和工作的解决方案，所以我希望相同的源代码能够在两者中编译。由于电子表格中的行太多，我不想使用为每次查找创建临时文件的函数。 （当系统调用可用时，我对不需要的临时文件有强迫症）。
我相信函数 "getaddrinfoex" 提供了指定查询名称服务器的能力，但我无法找到任何使用 getaddrinfoex 或较低版本的 getaddrinfo 的 VBA 片段（不允许指定 DNS 服务器）。我发现了几个调用 gethostbyname 的例子，但都是针对 32 位 Excel。此外，Microsoft 已发布 gethostbyname 已被弃用 (https://msdn.microsoft.com/en-us/library/windows/desktop/ms738524(v=vs.85).aspx)，因此我尝试使用推荐的替代方法 getaddrinfo
How can I make a network connection with Visual Basic from Microsoft Access?
@david 在我上面链接的问题的答案中发布的片段看起来具有与 32 位和 64 位兼容的正确语法。但是例子中并没有调用gethostbyname，只是提供了函数的声明。
getaddrinfoex 在 VBA 中可用吗？有人有使用 getaddrinfoex 的例子吗，它可以在 32 位和 64 位上工作？
如有任何帮助，我将不胜感激。我已经很多年没有编码了，所以我的技能已经过时了。因此我做了很多搜索来找到我需要的东西。
这是我结合各种在线搜索创建的代码。
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
只要不移动到 add-in (.xlam)，我现在就可以使用它。如果我将它移动到 add-in，则完全相同的代码会在调用 getaddrinfo 时崩溃。我会继续努力。
该过程需要一个参数（作为字符串传递的主机名）。第二个参数是 return 的最大 IP 地址数（作为整数传递），但它是可选的。如果第二个参数为空，则所有 IP 地址都是 returned。当设置为非零值时，该值将是主机的最大 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
我的基本问题是我有一个电子表格，其中包含数以千计的 FQDN（完全限定域名）条目，我需要检查 FQDN 是否是 public 互联网上的有效 DNS 条目。我正在对每个 FQDN 进行 DNS 查找，并想指定一个 public DNS 服务器。如果调用 DNS returns 一个 IP 地址，我将假定 FQDN 是有效的。我在 excel 64 位中工作，但需要一个也能在 32 位中编译和工作的解决方案，所以我希望相同的源代码能够在两者中编译。由于电子表格中的行太多，我不想使用为每次查找创建临时文件的函数。 （当系统调用可用时，我对不需要的临时文件有强迫症）。
我相信函数 "getaddrinfoex" 提供了指定查询名称服务器的能力，但我无法找到任何使用 getaddrinfoex 或较低版本的 getaddrinfo 的 VBA 片段（不允许指定 DNS 服务器）。我发现了几个调用 gethostbyname 的例子，但都是针对 32 位 Excel。此外，Microsoft 已发布 gethostbyname 已被弃用 (https://msdn.microsoft.com/en-us/library/windows/desktop/ms738524(v=vs.85).aspx)，因此我尝试使用推荐的替代方法 getaddrinfo
How can I make a network connection with Visual Basic from Microsoft Access?
@david 在我上面链接的问题的答案中发布的片段看起来具有与 32 位和 64 位兼容的正确语法。但是例子中并没有调用gethostbyname，只是提供了函数的声明。
getaddrinfoex 在 VBA 中可用吗？有人有使用 getaddrinfoex 的例子吗，它可以在 32 位和 64 位上工作？
如有任何帮助，我将不胜感激。我已经很多年没有编码了，所以我的技能已经过时了。因此我做了很多搜索来找到我需要的东西。
这是我结合各种在线搜索创建的代码。
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
只要不移动到 add-in (.xlam)，我现在就可以使用它。如果我将它移动到 add-in，则完全相同的代码会在调用 getaddrinfo 时崩溃。我会继续努力。
该过程需要一个参数（作为字符串传递的主机名）。第二个参数是 return 的最大 IP 地址数（作为整数传递），但它是可选的。如果第二个参数为空，则所有 IP 地址都是 returned。当设置为非零值时，该值将是主机的最大 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