Kā izveidot WHOIS uzmeklēšanas rīku, izmantojot Excel VBA

Izmantojot programmu Excel, varat viegli izveidot savu WHOIS meklēšanas rīku. Šis rīks palīdzēs tīmekļa vietņu izstrādātājiem vai mitināšanas uzņēmumiem pārvērst domēnus par potenciālajiem klientiem. Šis rīks parāda to personu vai organizāciju nosaukumus, kurām pieder dažādi domēni.

Lejupielādēt tagad

Ja vēlaties sākt lietot programmatūru pēc iespējas ātrāk, varat:

Lejupielādējiet programmatūru tūlīt

Pretējā gadījumā, ja vēlaties DIY, varat izlasīt tālāk sniegto saturu.

Sagatavosim GUI

Šī rīka GUI ir ļoti vienkārša. Kā parādīts attēlā, pietiek tikai ar vienu lapu ar nepieciešamajām galvenēm un kolonnām. Šajā piemērā konkrētam domēnam rīks nokasīs reģistrētāja vārdu un reģistrētāja organizāciju. Lai ļautu lietotājiem palaist makro, tajā pašā lapā izveidojiet pogu.

Padarīsim to funkcionālu

Ielīmējiet skriptu jaunā modulī un pievienojiet apakšrakstu “whoismacor” pogai, kuru izveidojām 1. lapā.

Pārbaudīsim

Pievienojiet domēnus A kolonnā un palaidiet makro. Vērtības tiks parādītas attiecīgajās kolonnās.

Mainiet to

Pašlaik rīks parāda 2 galvenes, ti, reģistrētāja vārdu un reģistrētāja organizāciju. Jūs varat pielāgot rīku, lai ielādētu jebkuru no šīm galvenēm.

Atgūt xlsm failu

Ja jums rodas problēmas ar šī rīka atvēršanu vai saglabāšanu, jums ir lielas izmaiņas korumpēts Excel fails un pirms lietošanas tas ir jānovērš.

Scenārijs

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

Autora ievads:

Niks Viponds ir datu atkopšanas eksperts DataNumen, Inc., kas ir pasaules līderis datu atkopšanas tehnoloģiju, tostarp labot docx problēmu un perspektīvas atkopšanas programmatūras produktus. Lai iegūtu vairāk informācijas, apmeklējiet vietni www.datanumen. Ar