Cara Membuat Alat Pencarian WHOIS melalui Excel VBA

Dengan menggunakan Excel, anda boleh membina alat carian whois anda sendiri dengan mudah. ​​Alat ini akan membantu pembangun laman web atau syarikat pengehosan untuk menukar domain kepada bakal pelanggan. Alat ini memaparkan nama orang atau organisasi yang memiliki domain yang berbeza.

Muat Turun Sekarang

Jika anda ingin mula menggunakan perisian ini secepat mungkin, anda boleh:

Muat turun Perisian Sekarang

Jika tidak, jika anda mahu DIY, anda boleh membaca kandungannya di bawah.

Mari sediakan GUI

GUI alat ini sangat mudah. Seperti yang ditunjukkan dalam gambar, cukup satu helaian dengan tajuk dan lajur yang diperlukan. Dalam contoh ini, untuk Domain tertentu, alat ini akan mengikis Nama Pendaftar dan Organisasi Pendaftar. Untuk membolehkan pengguna menjalankan makro, buat butang pada helaian yang sama.

Mari jadikan ia berfungsi

Tampal skrip ke dalam modul baru dan pasangkan sub "whoismacor" ke butang yang kami buat di Sheet1.

Mari mengujinya

Tambahkan domain di Lajur A dan jalankan makro. Nilai akan dipaparkan pada lajur masing-masing.

Ubah suai

Setakat ini alat ini menunjukkan 2 tajuk iaitu, Nama Pendaftar dan Organisasi Pendaftar. Anda boleh menyesuaikan alat untuk mengambil tajuk berikut.

Pulihkan fail xlsm

Sekiranya anda menghadapi masalah dalam membuka atau menyimpan alat ini, ada perubahan tinggi yang Anda miliki fail Excel rosak dan anda mesti memperbaikinya sebelum menggunakannya.

skrip

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

Pengenalan Pengarang:

Nick Vipond adalah pakar pemulihan data di DataNumen, Inc., yang merupakan pemimpin dunia dalam teknologi pemulihan data, termasuk baiki masalah docx dan produk perisian pemulihan prospek. Untuk maklumat lebih lanjut, lawati www.datanumen.com