Sådan oprettes et WHOIS-opslagsværktøj via Excel VBA

Ved hjælp af Excel kan du nemt opbygge dit eget whois-opslagsværktøj. Dette værktøj vil hjælpe webudviklere eller hostingfirmaer med at konvertere domæner til leads. Dette værktøj viser navnene på personer eller organisationer, der ejer forskellige domæner.

Hent nu

Hvis du vil begynde at bruge softwaren så hurtigt som muligt, kan du:

Download softwaren nu

Ellers kan du læse indholdet nedenfor, hvis du vil gøre det selv.

Lad os forberede GUI

GUI for dette værktøj er meget simpelt. Som vist på billedet er kun et ark med nødvendige overskrifter og kolonner tilstrækkeligt. I dette eksempel skraber værktøjet for et givet domæne Registrantnavn og Registrantorganisation. For at give brugerne mulighed for at køre makroen skal du oprette en knap på det samme ark.

Lad os gøre det funktionelt

Indsæt scriptet i et nyt modul, og vedhæft under “whoismacor” til den knap, vi oprettede på Sheet1.

Lad os teste det

Tilføj domæner i kolonne A, og kør makroen. Værdier vises i de respektive kolonner.

Rediger det

Fra nu viser værktøjet 2 overskrifter, dvs. registrantnavn og registrantorganisation. Du kan tilpasse værktøjet til at hente et af følgende overskrifter.

Gendan xlsm-fil

Hvis du har problemer med at åbne eller gemme dette værktøj, er der høje ændringer, som du har en korrupt Excel-fil og du skal rette det, før du bruger det.

Script

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

Forfatter Introduktion:

Nick Vipond er en datagendannelsesekspert i DataNumen, Inc., som er verdens førende inden for datagendannelsesteknologier, herunder reparation docx problem og Outlook Outlook-softwareprodukter. For mere information besøg www.datanumen.com