Die IP-Adresse in 64-Bit-VBA kann nicht gefunden werden

Question

Mein Grundproblem besteht darin, dass ich eine Tabelle mit zehntausenden vollqualifizierten Domänennamen habe, die ich prüfen muss, ob der FQDN ein gültiger DNS-Eintrag ist das öffentliche Internet. Ich mache eine DNS-Suche für jeden FQDN und möchte einen öffentlichen DNS-Server angeben. Wenn der Aufruf an den DNS eine IP-Adresse zurückgibt, nehme ich an, dass der FQDN gültig ist. Ich arbeite in Excel 64-Bit, aber brauche eine Lösung, die auch in 32-Bit kompilieren und arbeiten wird, also möchte ich den gleichen Quellcode in beide kompiliert werden können. Da in der Tabelle so viele Zeilen vorhanden sind, möchte ich keine Funktion verwenden, die für jede Suche eine temporäre Datei erstellt. (Ich bin OCD über nicht benötigte temporäre Dateien, wenn ein Systemanruf verfügbar ist).

Ich glaube, dass die Funktion "getaddrinfoex" die Möglichkeit bietet, anzugeben, welcher Nameserver abgefragt wird, aber ich konnte keine VBA - Snippets finden, die getaddrinfoex oder die niedrigere Version von getaddrinfo verwenden (was die Angabe von DNS Server). Ich habe mehrere Beispiele für Aufrufe von gethostbyname gefunden, aber alle sind für 32-Bit-Excel. Außerdem hat Microsoft veröffentlicht, dass gethostbyname veraltet ist (https://msdn.microsoft.com/en-us/library/windows/desktop/ms738524(v=vs.85).aspx), so dass ich versuchte, den empfohlenen Austausch Getaddrinfo

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

Das Snippet in der Antwort @ David in der Frage gestellt verwenden ich oben verlinkt sieht Die richtige Syntax muss sowohl 32-Bit als auch 64-Bit-kompatibel sein. Das Beispiel enthielt jedoch nicht den Aufruf von gethostbyname, sondern nur die Deklaration der Funktion.

Ist getaddrinfoex in VBA verfügbar? Hat jemand ein Beispiel für die Verwendung von getaddrinfoex, die in 32-Bit und 64-Bit funktioniert?

Ich würde jede Hilfe zu schätzen wissen. Ich habe nicht in vielen Jahren codiert, so dass meine Fähigkeiten sehr veraltet sind. Daher mache ich viele Suchen, um zu finden, was ich brauche.

Hier ist der Code, den ich aus der Kombination verschiedener Suchen online erstellt habe.

Answer 1

Ich habe es funktioniert jetzt, solange es nicht zu einem Add-In (.xlam) verschoben wird. Wenn ich es in ein Add-In verschiebe, stürzt genau dieser Code beim Aufruf von getaddrinfo ab. Daran werde ich weiter arbeiten.

Die Prozedur erfordert ein Argument (Hostname, der als Zeichenfolge übergeben wird). Das zweite Argument gibt die maximale Anzahl von IP-Adressen an, die zurückgegeben werden sollen (als Integer übergeben), ist jedoch optional. Wenn das zweite Argument leer ist, werden alle IP-Adressen zurückgegeben. Wenn dieser Wert auf einen anderen Wert als Null eingestellt ist, entspricht dieser Wert der maximalen Anzahl von IP-Adressen für den 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