Определение IP адреса и страны по доменному имени

Макрос определения страны и IP адреса по доменному имени

Макрос предназначен для вывода IP адресов и названий стран, на основании столбца с доменными именами.

В прикреплённом файле - 2 способа реализации:

1) по доменному имени определяется IP адрес (посредством команды PING - выполнения ICMP запроса),
а затем определяется страна (по IP адресу), с использованием сервиса smart-ip.net

2) используется только сервис smart-ip.net
Отправляется запрос на указанный сервис, и из полученных данных вычленяются IP адрес и название страны.

 

Код макросов (для 1 и 2 варианта):

Sub GetCountriesFromIP()
    On Error Resume Next
    Set objhttp = CreateObject("MSXML2.ServerXMLHTTP.4.0")
    Dim ra As Range, cell As Range, oPingResult As Variant
    Set ra = Range([A3], Range("A" & Rows.Count).End(xlUp))
    ra.Offset(, 1).Resize(, 2).ClearContents
 
    For Each cell In ra.Cells
        domain$ = Trim(cell): IP = ""
        If domain$ Like "*?.?*" Then
 
            ' определяем IP адрес по доменному имени
            For Each oPingResult In GetObject("winmgmts://./root/cimv2").ExecQuery _
                ("SELECT * FROM Win32_PingStatus WHERE Address = '" & domain$ & "'")
                If IsObject(oPingResult) Then IP = oPingResult.ProtocolAddress
            Next
            cell.Next = IP: DoEvents
 
            ' если IP-адрес определён, получаем географическое положение IP адреса
            If cell.Next Like "*#.*#.*#.*#" Then
                URL$ = "http://ru.smart-ip.net/geoip-xml/" & cell.Next
                objhttp.Open "GET", URL$, False: objhttp.send
                cell.Next.Next = Split(Split(objhttp.responseText, "<countryName>")(1), "</countryName>")(0)
            End If
        End If
    Next cell
    Set objhttp = Nothing
End Sub

Sub GetCountriesFromDomain()
    On Error Resume Next
    Set objhttp = CreateObject("MSXML2.ServerXMLHTTP.4.0")
    Dim ra As Range, cell As Range, oPingResult As Variant
    Set ra = Range([A3], Range("A" & Rows.Count).End(xlUp))
    ra.Offset(, 1).Resize(, 2).ClearContents
 
    For Each cell In ra.Cells
        domain$ = Trim(cell): IP = ""
        If domain$ Like "*?[A-z].[A-z]*" Then
            URL$ = "http://ru.smart-ip.net/geoip-xml/" & domain$
            objhttp.Open "GET", URL$, False: objhttp.send: DoEvents
            cell.Next = Split(Split(objhttp.responseText, "<host>")(1), "</host>")(0)
            cell.Next.Next = Split(Split(objhttp.responseText, "<countryName>")(1), "</countryName>")(0)
        End If
    Next cell
    Set objhttp = Nothing
End Sub

Вложения:
ID_Domain.xls46 КБ

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Приветствую вас, Игорь! Подскажите, как можно пропустить непустые ячейки, чтобы макрос при старте не обнулял ячейки со статическими данными (например, когда нет ответа от определённого доменного имени, макрос обнуляет ячейку, даже если в неё был вбит адрес вручную), либо, идеальный вариант - это получение IP-адреса от ресурсов на которых ICMP-ответ отключен (на примере ресурса zhit-vmeste.ru), т.е. при отправке команды "ping zhit-vmeste.ru", в заголовке "Обмен пакетами с zhit-vmeste.ru [95.173.156.157] с 32 байтами данных: Превышен интервал ожидания" IP-адрес определяется. Вот этот адрес можно средствами VBA запарсить?

Удалите в своём файле самую верхнюю строку кода — Option Explicit
Она заставляет вас объявлять все переменные в коде (что необязательно, в общем-то)

Привет!
При копировании в свою книгу код не работает,
выдает ошибку что переменные: domain$, IP, objhttp не заданы.

С чем это может быть связано? В примере они тоже нигде не объявлены, но работает.

Спасибо

Минимальная стоимость заказа у нас, - 1500 рублей.
Тут несложно, - могу и за 1000 сделать.

Спасибо, попытаюсь сам, если не выйдет, то буду обращаться. Сколько будет стоить, может нет смысла и самому делать?

Не сложно, - можете сами сделать.
Загружаете страницу этой функцией
http://excelvba.ru/code/GetHTTPResponse
и оттуда (текстовыми функциями VBA типа Split) извлекаете значение между < title> и < /title>

Если сами не справитесь, - можем сделать под заказ.

Супер макрос! Если бы еще по домену выводилось Title (заголовок сайта) было бы просто великолепно, если не сложно сделать и будет не дорого.

2 способ у меня работает, если задать MSXML2.ServerXMLHTTP.6.0, а не 4.0.

В макросе GetCountriesFromIP данные пинга выводятся нормально а вот вторая часть макроса не чего не выводит но и ошибку не выдает.
Но все тоже самое в Microsoft Office 2010 работает без проблем.

А какую ошибку выдаёт?
На какой строке макрос вылетает?
Или в чем проявляется ошибка? Может, у вашего Excel просто не доступа в интернет (из-за файрвола)?

Под Microsoft Office 2013 не хочет работать URL$ = "http://ru.smart-ip.net/geoip-xml/" & cell.Next почему то?

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _     _   ____                       _____ 
| | (_) | ___| __ __ __ _ |___ |
| | | | |___ \ \ \ /\ / / / _` | / /
| | | | ___) | \ V V / | (_| | / /
|_| _/ | |____/ \_/\_/ \__, | /_/
|__/ |_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.