Проверить домен с помощью селена - PullRequest
Новая
       15

Проверить домен с помощью селена

2 голосов
/ 01 мая 2019

Я пытаюсь проверить для некоторых доменов, используя селен в VBA Вот моя попытка 

Option Explicit
Sub Check_Domain()
    Dim bot As New WebDriver
    Dim sDomain As String

    sDomain = "facebookopop.com"
    bot.Start "chrome", "https://ae.godaddy.com/domainsearch/find?checkAvail=1&tmskey=&domainToCheck=" & sDomain
    bot.Get "/"

    Dim eleTaken As Object, eleAvailable As Object

    bot.Wait 3000

    On Error Resume Next
    Set eleTaken = bot.FindElementByXPath("//text()[contains(.,'Domain Taken')]/ancestor::span[1]")
    Set eleAvailable = bot.FindElementByXPath("//text()[contains(.,'Domain Available')]/ancestor::span[1]")
    On Error GoTo 0

    If Not eleTaken Is Nothing Then
        Debug.Print "Not Avaialable"
    ElseIf Not eleAvailable Is Nothing Then
        Debug.Print "Avaialable"
    Else
        Debug.Print "Unknown"
    End If
    Stop
End Sub

Код работает медленно и в то же время не дает правильных результатов постоянно. Как я могу легко проверить наличие элемента и избежать ошибок?

Я не знаю, почему следующий код не работает 

Sub Check_Domain_Advanced()
Dim bot As New WebDriver
Dim sDomain As String
Dim c As Range
Dim ele As Object
Dim t
Const MAX_WAIT_SEC As Long = 10

bot.Start "chrome"

For Each c In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If Not IsEmpty(c.Value) Then
        sDomain = c.Value
        bot.ExecuteScript "window.open(arguments[0])", "https://ae.godaddy.com/domainsearch/find?checkAvail=1&tmskey=&domainToCheck=" & sDomain
        bot.SwitchToNextWindow

        t = Timer
        Do
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While bot.FindElementsByCss("span[class='domain-name-text h2']").Count = 0

        Set ele = bot.FindElementByCss("span[class='domain-name-text h2']")

        If ele.IsPresent Then
            If InStr(ele.Text, "available") Then
                c.Offset(, 1).Value = "Avaialable"
            ElseIf InStr(ele.Text, "taken") Then
                c.Offset(, 1).Value = "Not Avaialable"
            Else
                c.Offset(, 1).Value = "Unknown"
            End If
        End If
    End If
Next c

Stop
End Sub

Мне нужно открыть каждую ссылку в новой вкладке и проверить домен (доступен или занят), но я получил ошибки относительно элемента (из-за загрузки страницы) Любые предложения, как улучшить код, чтобы он работал быстрее и чтобы избежать ошибок?

1 Ответ

2 голосов
/ 01 мая 2019

Используйте API, у которого есть поле для этого. Существует API для точного соответствия, а также перекрестная продажа.

Точное совпадение 

Option Explicit
Public Sub CheckDomainAvailability()
    Dim json As Object, domains(), i As Long, url As String
    domains = Array("google.com", "bszadfdws.com")
    url = "https://find.godaddy.com/domainsapi/v1/search/exact?q=####&key=dpp_search&pc=&ptl=&itc=dpp_absol1"
    With CreateObject("MSXML2.XMLHTTP")
        For i = LBound(domains) To UBound(domains)
            .Open "GET", Replace$(url, "####", domains(i)), False
            .send
            Debug.Print JsonConverter.ParseJson(.responseText)("ExactMatchDomain")("IsAvailable")
        Next
    End With
End Sub

Перекрестная продажа для просмотра связанных доменов: 

https://find.godaddy.com/domainsapi/v1/crosssell/all?sld=domainNameGoesHere&key=dpp_search&pc=&ptl=&itc=dpp_absol1

Затем вам нужно будет посмотреть значение ключа CrossSellDomains вместо ExactMatchDomain

Требования:

  1. Загрузите и добавьте в свой проект jsonconverter.bas с здесь
  2. VBE> Инструменты> Ссылки> Добавить ссылку на Microsoft Scripting Runtime

Версия Selenium:

Использовал синхронизированный цикл и проверял содержимое заголовка на available. 

Option Explicit
Public Sub CheckDomainAvailability()
    Dim d As WebDriver, domains(), i As Long, t As Date, ele As Object
    Const MAX_WAIT_SEC As Long = 10
    domains = Array("google.com", "bszadfdws.com")
    Set d = New ChromeDriver

    With d
        .Start "Chrome"
        For i = LBound(domains) To UBound(domains)
            .get "https://ae.godaddy.com/domainsearch/find?checkAvail=1&tmskey=&domainToCheck=" & domains(i)

            t = Timer
            Do
                On Error Resume Next
                Set ele = .FindElementByCss(".exact-header-tag")
                On Error GoTo 0
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop While ele Is Nothing
            If Not ele Is Nothing Then
                Debug.Print domains(i) & " available = " & (InStr(LCase$(ele.text), "available") > 0)
                Set ele  = Nothing
            End If
        Next
        .Quit
    End With
End Sub
...