Excel VBA арқылы WHOIS іздеу құралын қалай құруға болады

Excel бағдарламасын пайдаланып, сіз өзіңіздің Whois іздеу құралыңызды оңай жасай аласыз. Бұл құрал веб-сайт әзірлеушілеріне немесе хостинг компанияларына домендерді лидтерге айналдыруға көмектеседі. Бұл құрал әртүрлі домендерге иелік ететін адамдардың немесе ұйымдардың аттарын көрсетеді.

Енді жүктеп

Егер сіз бағдарламалық жасақтаманы мүмкіндігінше тезірек пайдалана бастағыңыз келсе, онда сіз:

Бағдарламалық жасақтаманы қазір жүктеп алыңыз

Әйтпесе, егер сіз өзіңіздің қолыңызбен жасағыңыз келсе, төмендегі мазмұнды оқи аласыз.

GUI-ді дайындайық

Бұл құралдың интерфейсі өте қарапайым. Суретте көрсетілгендей, қажетті тақырыптар мен бағандардан тұратын бір парақ жеткілікті. Бұл мысалда берілген домен үшін құрал Тіркелушінің аты мен Тіркелушінің ұйымын сызып тастайды. Қолданушыларға макросты іске қосу үшін сол парақта батырма жасаңыз.

Оны функционалды етейік

Сценарийді жаңа модульге салыңыз және Sheet1-де біз жасаған батырмаға “whoismacor” қосымшасын қосыңыз.

Сынап көрейік

А бағанына домендерді қосып, макросты іске қосыңыз. Мәндер тиісті бағандарда көрсетіледі.

Оны өзгертіңіз

Қазіргі уақытта құрал 2 тақырыпты, яғни Тіркелушінің аты мен Тіркелушінің ұйымын көрсетеді. Сіз кез-келген келесі тақырыпты алу үшін құралды теңшей аласыз.

Xlsm файлын қалпына келтіріңіз

Егер сізде осы құралды ашуда немесе сақтауда қиындықтар болса, сізде үлкен өзгерістер бар бүлінген Excel файлы және оны қолданар алдында түзету керек.

сценарий

Sub whoismacro()
    Dim v_lrow As Long
    Application.DisplayStatusBar = True
    v_lrow = Sheets("whois").Range("A" & Rows.Count).End(xlUp).Row
    Dim r As Long
    Dim v_string As String
    For r = 4 To v_lrow
        Application.StatusBar = "Macro is running... Now fetching Registrant Name and Organization info for domain at Row : " & r & " /// Total Rows : " & v_lrow
        Sheets("whois").Range("B" & r).Value = WhoIsName(Sheets("whois").Range("A" & r).Value)
        Sheets("whois").Range("C" & r).Value = WhoIsorganization(Sheets("whois").Range("A" & r).Value)
    Next r
    Application.StatusBar = "Ready"
End Sub
 
Function WhoIsName(v_string As String) As String
    Application.DisplayStatusBar = True
    v_string = Replace(v_string, "http://www.", "")
    v_string = Replace(v_string, "https://www.", "")
    v_string = Replace(v_string, "http://", "")
    v_string = Replace(v_string, "https://", "")
    Dim I As Long
    Dim browobj As Object
    Dim obj1 As Object
    Dim obj2 As Object
    Dim obj3 As Object
    Dim v_website As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim tbl As Object
    Dim rw As Object
    Dim cl As Object
    Dim tabno As Long
    Dim nextrow As Long
    Dim URl As String
    Dim lastRow As Long
    Dim xmlobj As Object
    Dim htmobj As Object
    Dim divobj As Object
    Dim objH3 As Object
    Dim linkobj As Object
    Dim vv_startrow As Integer
    Dim vv_lastrow As Integer
    Application.DisplayAlerts = False
    Application.DisplayStatusBar = True
    URl = "https://www.whois.com/whois/" & v_string
    Set xmlobj = CreateObject("MSXML2.XMLHTTP")
    xmlobj.Open "GET", URl, False
    xmlobj.setRequestHeader "Content-Type", "text/xml"
    xmlobj.setRequestHeader "Cache-Control", "no-cache"
    xmlobj.send
    Set htmobj = CreateObject("htmlfile")
    htmobj.body.innerHTML = xmlobj.responseText
    x = InStr(htmobj.body.innertext, "Registrant Name:")
    y = InStr(x, htmobj.body.innertext, Chr(10))
    WhoIsName = Replace(Mid(htmobj.body.innertext, x, y - x), "Registrant Name:", "")
End Function
 
Function WhoIsorganization(v_string As String) As String
    Application.DisplayStatusBar = True
    v_string = Replace(v_string, "http://www.", "")
    v_string = Replace(v_string, "https://www.", "")
    v_string = Replace(v_string, "http://", "")
    v_string = Replace(v_string, "https://", "")
    Dim I As Long
    Dim browobj As Object
    Dim obj1 As Object
    Dim obj2 As Object
    Dim obj3 As Object
    Dim v_website As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim tbl As Object
    Dim rw As Object
    Dim cl As Object
    Dim tabno As Long
    Dim nextrow As Long
    Dim URl As String
    Dim lastRow As Long
    Dim xmlobj As Object
    Dim htmobj As Object
    Dim divobj As Object
    Dim objH3 As Object
    Dim linkobj As Object
    Dim vv_startrow As Integer
    Dim vv_lastrow As Integer
    Application.DisplayAlerts = False
    Application.DisplayStatusBar = True
    URl = "https://www.whois.com/whois/" & v_string
    Set xmlobj = CreateObject("MSXML2.XMLHTTP")
    xmlobj.Open "GET", URl, False
    xmlobj.setRequestHeader "Content-Type", "text/xml"
    xmlobj.setRequestHeader "Cache-Control", "no-cache"
    xmlobj.send
    Set htmobj = CreateObject("htmlfile")
    htmobj.body.innerHTML = xmlobj.responseText
    x = InStr(htmobj.body.innertext, "Registrant Organization:")
    Debug.Print x
    y = InStr(x, htmobj.body.innertext, Chr(10))
    Debug.Print y
    WhoIsorganization = Replace(Mid(htmobj.body.innertext, x, y - x), "Registrant Organization:", "")
End Function

Автордың кіріспесі:

Ник Випонд - деректерді қалпына келтіру бойынша сарапшы DataNumen, Соның ішінде деректерді қалпына келтіру технологиялары бойынша әлемдік көшбасшы болып табылатын Inc. docx мәселесін жөндеу және қалпына келтіру бағдарламалық жасақтамасының өнімдері. Қосымша ақпарат алу үшін кіріңіз WWW.datanumen.com