2017-01-18 2 views
1

Моя основная проблема заключается в том, что у меня есть таблица с тысячами полных доменных имен FQDN (полное доменное имя), которые мне нужно проверить, является ли полное доменное имя действительной DNS-записью на общественный интернет. Я выполняю поиск DNS каждого FQDN и хотел бы указать общий DNS-сервер. Если вызов DNS возвращает IP-адрес, я предполагаю, что полное доменное имя будет действительным. Я работаю в 64-разрядном формате excel, но мне нужно решение, которое также будет компилироваться и работать в 32-разрядном режиме, поэтому я хочу, чтобы один и тот же исходный код мог быть скомпилирован в обоих. Поскольку в электронной таблице так много строк, я не хочу использовать функцию, которая создает временный файл для каждого поиска. (Я использую OCD о ненужных временных файлах при наличии системного вызова).Невозможно найти IP-адрес в 64-разрядной версии VBA

Я считаю, что функция «getaddrinfoex» предоставляет возможность указать, какой сервер имен запрашивается, но я не смог найти какие-либо фрагменты VBA, которые используют getaddrinfoex или меньшую версию getaddrinfo (что не позволяет указать 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 
+0

Если бы я тебя, я бы проверить это сообщение: http://jayteknews.blogspot.no/2011/08/excel-user-defined-function-nslookup.html – tlemaster

+0

Спасибо за предложение , Я уже смотрел этот пост. Он использует временный файл для каждого поиска DNS. Поскольку я буду заполнять эту таблицу ежедневно с 10 000 + FQDN и будет делать это в течение нескольких недель, я действительно не хочу, чтобы creaete/delete, что многие временные файлы. Это также скорость исполнения. VBA - это не самая быстрая вещь в мире, когда вы выполняете многократно выполняемую функцию, добавляя накладные расходы на создание/удаление файла, сделало бы обновление таблицы слишком медленным. – SkiBum

ответ

0

У меня есть работа сейчас, пока она не перемещается в надстройку (.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 
Смежные вопросы