По имени сервера (например, mail.ru) получить его IP-адрес Как-то раз, для одной из задач мне потребовалось узнать IP-адрес хоста.
Поиск решения привел меня на сайт DEVHUNT.NET статья VBA – Get Host IP Address (Далее идёт вольный перевод статьи.)
Основной секрет здесь в том, чтобы знать, что существует древняя команда DOS (в своё время прошел её от версии 2,11 до 6,22 - Joss), которая позволяет легко получить такую информацию, команда nslookup.
Итак, стоит вопрос - Как я могу запустить nslookup в VBA?
Отсюда остается лишь вопрос создания оболочки для выполнения команды и анализа возвращенного ответа. Еще одним важным элементом здесь является то, что некоторые хосты могут возвращать несколько адресов, поэтому вам нужно иметь возможность перебирать возвращаемую информацию, поскольку она не всегда одинакова.
С учетом всего сказанного, не потребовалось много времени, чтобы придумать следующую небольшую функцию:
'--------------------------------------------------------------------------------------- ' Procedure : GetHostNameIP ' Author : Daniel Pineault, CARDA Consultants Inc. ' Website : http://www.cardaconsultants.com ' Purpose : Retrieve the IP Address of a given host name ' Copyright : The following is release as Attribution-ShareAlike 4.0 International ' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/ ' Req'd Refs: Late Binding -> none required ' ' Input Variables: ' ~~~~~~~~~~~~~~~~ ' sHostName : Host name to lookup the IP address of ' ' Usage: ' ~~~~~~ ' GetHostNameIP("utteraccess.com") ' Returns -> 52.40.49.196 ' GetHostNameIP("google.com") ' Returns -> 2607:f8b0:4006:813::200e,172.217.10.238 ' ' Revision History: ' Rev Date(yyyy-mm-dd) Description ' ************************************************************************************** ' 1 2020-07-20 Initial Release, Forum Help ' 2 2020-07-20 Update to handle the case of multiple addresses ' 3 2020-07-21 Handle blank/empty sHostName calls '--------------------------------------------------------------------------------------- Function GetHostNameIP(ByVal sHostName As String) As String Dim sResult As String Dim aResult As Variant Dim i As Long On Error GoTo Error_Handler If Len(Trim(sHostName)) = 0 Then GoTo Error_Handler_Exit sResult = CreateObject("Wscript.Shell").Exec("nslookup " & sHostName).StdOut.ReadAll aResult = Split(sResult, vbCrLf) If UBound(aResult) > 2 Then For i = 4 To UBound(aResult) If Len(Trim(aResult(i) & vbNullString)) > 0 Then GetHostNameIP = GetHostNameIP & Trim(Replace(Replace(Replace(aResult(i), "Address:", ""), _ "Addresses:", ""), vbTab, "")) & "," End If Next i If Right(GetHostNameIP, 1) = "," Then GetHostNameIP = Left(GetHostNameIP, Len(GetHostNameIP) - 1) End If Error_Handler_Exit: On Error Resume Next Exit Function Error_Handler: MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: GetHostNameIP" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occurred!" Resume Error_Handler_Exit End Function Теперь все вышеперечисленное работало абсолютно нормально, но это действие вызвало кратковременную мигание экрана, Это мерцание меня раздражало, поэтому я продолжал работать над этим. Проблема в том, что .Exec всегда вызывает мигание (открытие/закрытие окна cmd), и нет способа обойти это (кто-нибудь, пожалуйста, поправьте меня, если я ошибаюсь, и есть простое решение, о котором я не знаю), и поэтому единственный способ обойти мигание экрана - вместо этого использовать .Run. Однако .Run не возвращает значение, как .Exec, поэтому мы должны сначала поместить результаты команды .Run в текстовый файл и прочитать текстовый файл в память для работы. И вот ниже представлена версия, при которой экран не мигает.
'--------------------------------------------------------------------------------------- ' Procedure : GetHostNameIP ' Author : Daniel Pineault, CARDA Consultants Inc. ' Website : http://www.cardaconsultants.com ' Purpose : Retrieve the IP Address of a given host name ' Copyright : The following is release as Attribution-ShareAlike 4.0 International ' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/ ' Req'd Refs: Late Binding -> none required ' ' Input Variables: ' ~~~~~~~~~~~~~~~~ ' sHostName : Host name to lookup the IP address of ' ' Usage: ' ~~~~~~ ' GetHostNameIP("utteraccess.com") ' Returns -> 52.40.49.196 ' GetHostNameIP("google.com") ' Returns -> 2607:f8b0:4006:813::200e,172.217.10.238 ' ' Revision History: ' Rev Date(yyyy-mm-dd) Description ' ************************************************************************************** ' 1 2020-07-20 Initial Release ' Different approach to avoid screen flashing ' 2 2020-07-21 Handle blank/empty sHostName calls '--------------------------------------------------------------------------------------- Function GetHostNameIP(ByVal sHostName As String) As String Dim sFile As String Dim sResult As String Dim aResult As Variant Dim i As Long On Error GoTo Error_Handler If Len(Trim(sHostName)) = 0 Then GoTo Error_Handler_Exit sFile = Environ("temp") & "\GetHostNameIP.txt" 'Run the nslookup command and save its results to a text file CreateObject("Wscript.Shell").Run "cmd /c nslookup " & sHostName & " > " & sFile, 0, True With CreateObject("Scripting.FileSystemObject") 'Read the contents of the text file into memory sResult = .OpenTextFile(sFile).ReadAll() 'Delete the text file .DeleteFile sFile End With aResult = Split(sResult, vbCrLf) If UBound(aResult) > 2 Then For i = 4 To UBound(aResult) If Len(Trim(aResult(i) & vbNullString)) & 0 Then GetHostNameIP = GetHostNameIP & Trim(Replace(Replace(Replace(aResult(i), "Address:", ""), _ "Addresses:", ""), vbTab, "")) & "," End If Next i If Right(GetHostNameIP, 1) = "," Then GetHostNameIP = Left(GetHostNameIP, Len(GetHostNameIP) - 1) End If Error_Handler_Exit: On Error Resume Next Exit Function Error_Handler: MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: GetHostNameIP" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occurred!" Resume Error_Handler_Exit End Function Обе функции работают одинаково хорошо, первая немного быстрее (на основе очень маленькой тестовой выборки она работала примерно на 1% быстрее), но мерцает, а вторая немного медленнее, но не мерцает. Вы выбираете, какой из них лучше всего подходит для ваших нужд. Просмотров: 2878
 Ваш коментарий будет первым | | |