Функция VBA для подключения к серверу WHOIS и возврата доступности домена .com.au

Я создаю шаблон для клиента, который хочет быстро проверить доступность десятков доменов за раз. Шаблон должен оставаться в виде файла Excel.

Я установил и использовал SEOToolsForExcel, который позволил мне запросить сервер и проверить, доступны ли определенные домены с помощью функции isdomainregistered (). Однако, к сожалению, функция всегда будет возвращать значение «истина» (т.е. домен занят) для всех австралийских («.com.au») доменов, которые ей присваиваются. Я попытался изменить поиск TLD в файле конфигурации xml, как это предлагается на этой странице: http://seotoolsforexcel.com/how-to-setup-tlds-in-seotools-config-xml/

Я пробовал со следующим:

<Tld Name="au" WhoIsServer="whois.aunic.net" WhoIsNotFoundRegex="(no match)|(no data found)|(not found)|(no entries found)|(error for)|(invalid pattern)|(illegal question)" WhoIsCreatedRegex="" WhoIsUpdatedRegex="(?:Last Modified:\s*(\d{2}-[A-z]{3}-)\d{4})" WhoIsExpiresRegex="" WhoIsDelayMs="1000" />

и этот:

<Tld Name="au" WhoIsServer="whois-check.ausregistry.net.au" WhoIsNotFoundRegex="is free" WhoIsCreatedRegex="" WhoIsUpdatedRegex="" WhoIsExpiresRegex="" WhoIsDelayMs="1000" />

Но ни то, ни другое, похоже, не помогло. Я проверил другие службы, которые четко показывают, что домены доступны, но SEOTool продолжает возвращать ложные результаты (только для доменов .com.au, домены .com работают нормально).

Таким образом, моя следующая попытка - написать в Excel пользовательскую функцию, чтобы взять домен и отправить его в инструмент доступности домена сервера Ausregistry.com.au.

Ausregistry объясняет, как это можно сделать, на своей странице здесь: http://www.ausregistry.com.au/tools/domain-availability

Они объясняют:

Затем служба ответит строкой «Доступен» или «Недоступен» в зависимости от доступности доменного имени.

Например

Чтобы проверить доступность ausregistry.net.au, выполните следующие действия:

  • Подключитесь к: Адрес: whois-check.ausregistry.net.au, Порт: 43

  • Отправьте на сервер строку `ausregistry.net.au \ r \ n '

  • Сервер ответит «Недоступно», а затем закроет соединение.

Вышеупомянутая процедура совместима со стандартным протоколом WHOIS; следовательно, любой интерфейс торгового посредника, созданный для использования WHOIS, также сможет использовать эту систему. В качестве альтернативы можно использовать стандартную команду whois * nix следующим образом: whois -h

Раньше я много писал на VBA, но я не знаю, как реализовать это соединение с сервером и как передать ему строку домена, а затем прочитать результат. Буду признателен за любую информацию о том, как добиться этого с помощью VBA.


dns excel vba whois
person caracter2    schedule 14.08.2015    source источник
comment
Я был бы удивлен, если это возможно. Вы должны иметь возможность написать сценарий PERL или Python или просто использовать существующую утилиту, которая выполняет поиск Whois.   -  person Lumigraphics    schedule 14.08.2015

Ответы (1)


arrow_upward
0
arrow_downward

Обновлять. Я решил эту проблему несколько месяцев назад и решил, что опубликую свое решение на случай, если кто-нибудь наткнется на это. @Lumigraphics, к счастью, мне не пришлось изучать PERL. Я использовал компонент OstroSoft Winsock (его можно получить здесь).

И следующий UDF:

Function AusRegDomainAvailable(DomainUrl As String) As Boolean
Dim sPage As String
Dim sServer As String
Dim nPort As Long
Dim AusRegistryServer As String
Dim ReturningData As String
Dim wsTCP As OSWINSCK.Winsock
Dim FixedDomain As String
Dim Timelimit As Date

QueryTimeOut = False


FixedDomain = Replace(DomainUrl, "www.", "")
FixedDomain = Replace(FixedDomain, "http://", "")
FixedDomain = Replace(FixedDomain, "https://", "")
AusRegistryServer = "whois-check.ausregistry.net.au"
nPort = 43
sServer = Trim(AusRegistryServer)
If InStr(sServer, "://") > 0 Then sServer = Mid(sServer, InStr(sServer, "://") + 3)
If InStr(sServer, "/") > 0 Then
    sPage = Mid(sServer, InStr(sServer, "/") + 1)
    sServer = Left(sServer, InStr(sServer, "/") - 1)
End If
If InStr(sServer, ":") > 0 Then
    nPort = Mid(sServer, InStr(sServer, ":") + 1)
    sServer = Left(sServer, InStr(sServer, ":") - 1)
End If
If sServer = "" Then Err.Raise 12001, , "Invalid URL"

Set wsTCP = CreateObject("OSWINSCK.Winsock")
wsTCP.Connect sServer, nPort

Do Until wsTCP.State = 7
    DoEvents
    If wsTCP.State = sckError Then
        Exit Function
    End If
Loop

wsTCP.SendData FixedDomain & vbCrLf
Timelimit = (Now + TimeValue("0:00:02"))

Do Until wsTCP.Status = "Data Arrival" Or Now > Timelimit
    DoEvents
    If wsTCP.State = sckClosed Then
        QueryTimeOut = True
        Exit Function
    End If
Loop

wsTCP.GetData ReturningData

ReturningData = Replace(ReturningData, vbLf, "")
ReturningData = Replace(ReturningData, vbCr, "")
ReturningData = Trim(ReturningData)

If ReturningData = "Available" Then
    AusRegDomainAvailable = True
ElseIf ReturningData = "Not Available" Then
    AusRegDomainAvailable = False
Else
    QueryTimeOut = True
    AusRegDomainAvailable = Null
End If

DoEvents

Debug.Print FixedDomain & " " & ReturningData
wsTCP.CloseWinsock
Exit Function

ErrHandler:
    AusRegDomainAvailable = "Error " & Err.Number & ": " & Err.Description
End Function
person caracter2    schedule 25.10.2015
comment
Если это решит вашу проблему, примите ответ, чтобы закрыть вопрос. - person Patrick Mevzek; 02.01.2018