Excel VBA vasitəsilə WHOIS Axtarış Alətini necə yaratmaq olar

Excel-dən istifadə edərək asanlıqla öz whois axtarış alətinizi yarada bilərsiniz. Bu alət veb sayt tərtibatçılarına və ya hostinq şirkətlərinə domenləri potensial müştərilərə çevirməyə kömək edəcək. Bu alət müxtəlif domenlərə sahib olan insanların və ya təşkilatların adlarını göstərir.

İndi Download

Proqramı mümkün qədər tez istifadə etməyə başlamaq istəyirsinizsə, aşağıdakıları edə bilərsiniz:

Proqramı İndi Yükləyin

Əks halda, DIY etmək istəyirsinizsə, aşağıdakı məzmunu oxuya bilərsiniz.

GUI hazırlayaq

Bu alətin qrafik interfeysi çox sadədir. Şəkildə göstərildiyi kimi, lazımi başlıqları və sütunları olan yalnız bir vərəq kifayətdir. Bu misalda, müəyyən bir Domen üçün alət Qeydiyyatçı Adı və Qeydiyyatdan Təşkilat siləcək. İstifadəçilərə makronu işlətməyə icazə vermək üçün eyni vərəqdə düymə yaradın.

Gəlin onu funksional edək

Skripti yeni modula yapışdırın və Sheet1-də yaratdığımız düyməyə alt “whoismacor” əlavə edin.

Test edək

A sütununa domenlər əlavə edin və makronu işə salın. Dəyərlər müvafiq sütunlarda göstəriləcək.

Dəyişdirin

Hal-hazırda alət 2 başlığı göstərir, yəni, Qeydiyyatçı Adı və Qeydiyyatdan Təşkilat. Aşağıdakı başlıqlardan hər hansı birini almaq üçün aləti fərdiləşdirə bilərsiniz.

Xlsm faylını bərpa edin

Bu aləti açmaqda və ya saxlamaqda çətinlik çəkirsinizsə, sizdə yüksək dəyişikliklər var zədələnmiş Excel faylı və istifadə etməzdən əvvəl onu düzəltmək lazımdır.

Ssenari

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

Müəllif Giriş:

Nik Vipond məlumatların bərpası üzrə mütəxəssisdir DataNumendaxil olmaqla məlumatların bərpası texnologiyaları üzrə dünya lideri olan , Inc docx problemini təmir edin və Outlook bərpa proqram məhsulları. Ətraflı məlumat üçün ziyarət edin www.datanumen.com