Question

我的基本问题是我有一个电子表格，其中包含数以万计的FQDN（完全限定的域名）条目，我需要检查FQDN是否是公共互联网上的有效DNS条目。我正在对每个FQDN进行DNS查找，并希望指定一个公共DNS服务器。如果对DNS的调用返回IP地址，我将假设FQDN有效。我在excel 64位工作，但需要一个也将编译并在32位工作的解决方案，所以我希望能够在两者中编译相同的源代码。由于电子表格中有这么多行，我不想使用为每次查找创建临时文件的函数。（当系统调用可用时，我是关于不需要的临时文件的OCD）。

我相信功能＆＃34; getaddrinfoex＆＃34;提供了指定查询名称服务器的功能，但是我无法找到任何使用getaddrinfoex或较小版本的getaddrinfo（不允许指定DNS服务器）的VBA片段。我找到了几个调用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的调用，它只提供了函数的声明。

VBA中有getaddrinfoex吗？有人有一个使用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

Answer 1

我现在可以使用它，只要它没有移动到加载项（.xlam）。如果我将它移动到一个加载项，这个完全相同的代码会在调用getaddrinfo时崩溃。我将继续努力。

该过程需要一个参数（主机名作为字符串传递）。第二个参数是要返回的最大IP地址数（作为整数传递），但是是可选的。如果第二个参数为空，则返回所有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

无法在64位VBA

1 个答案: