64 비트 VBA에서 IP 주소를 찾을 수 없습니다.

Question

내 기본 문제는 FQDN이 유효한 DNS 항목인지 확인해야하는 수십 개의 FQDN (정규화 된 도메인 이름) 항목이있는 스프레드 시트가 있다는 것입니다. 공공 인터넷. 각 FQDN에 대한 DNS 조회를 수행 중이며 공용 DNS 서버를 지정하려고합니다. DNS 호출이 IP 주소를 반환하면 FQDN이 유효하다고 가정합니다. 필자는 64 비트를 Excel에서 작업하고 있지만 32 비트로 컴파일하고 작업 할 솔루션이 필요하므로 동일한 소스 코드를 컴파일 할 수 있어야합니다. 스프레드 시트에는 많은 행이 있으므로 각 조회마다 임시 파일을 만드는 함수를 사용하고 싶지 않습니다. (나는 시스템 호출이 가능할 때 불필요한 임시 파일에 대해 강박 관이다.)

"getaddrinfoex"함수는 쿼리되는 이름 서버를 지정할 수있는 기능을 제공하지만 getaddrinfoex 또는 getaddrinfo의 하위 버전을 사용하는 VBA 코드 단편을 찾을 수 없었습니다. DNS 서버). gethostbyname 호출에 대한 몇 가지 예제를 발견했지만 모두 32 비트 Excel 용입니다. 또한, 마이크로 소프트는 gethostbyname까지도이 (https://msdn.microsoft.com/en-us/library/windows/desktop/ms738524(v=vs.85).aspx)는 지원되지되었다고 발표했습니다, 그래서 내가 위에 링크에 보이는 질문 @ 데이비드에 의해 대답에 게시

How can I make a network connection with Visual Basic from Microsoft Access?

코드 조각 getaddrinfo를 교체 권장을 사용하려고했다 32 비트와 64 비트가 모두 호환되는 적절한 구문을 사용해야합니다. 그러나이 예제는 gethostbyname에 대한 호출을 포함하지 않았으며 함수 선언 만 제공했습니다.

VBA에서 getaddrinfoex를 사용할 수 있습니까? 32 비트와 64 비트 모두에서 작동하는 getaddrinfoex를 사용하는 예가 있습니까?

어떤 도움을 주셔서 감사합니다. 몇 년 동안 코드를 작성하지 않아서 기술이 매우 오래되었습니다. 따라서 나는 내가 필요한 것을 찾기 위해 많은 수색을하고있다.

다음은 다양한 검색을 온라인으로 결합하여 만든 코드입니다.

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 주소가 반환됩니다. 0이 아닌 값으로 설정되면 해당 값은 호스트에 대한 최대 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