Rob van der Woude's Scripting Pages

VBScript Scripting Techniques > Network > WhoIs

Query WhoIs Database

  1. InternetExplorer.Application (Function)
  2. InternetExplorer.Application (Class)
  3. InternetExplorer.Application (WSC)

 

InternetExplorer.Application (Class)
VBScript Code:
Option Explicit

Dim objDomain

Set objDomain = New WhoIs

objDomain.Debug          = False
objDomain.DomainName     = "youtube.com"
objDomain.ConnectTimeOut = 25
objDomain.Query

WScript.Echo "Whois Version     : " & objDomain.Version
WScript.Echo "Domain Name       : " & objDomain.DomainName
If objDomain.ErrorNumber = 0 Then
    WScript.Echo "Registrar         : " & objDomain.Registrar
    WScript.Echo "Whois Server      : " & objDomain.WhoisServer
    WScript.Echo "Referral URL      : " & objDomain.ReferralURL
    WScript.Echo "Name Servers      : " & objDomain.NameServers
    WScript.Echo "Status            : " & objDomain.Status
    WScript.Echo "Creation Date     : " & objDomain.CreationDate
    WScript.Echo "Last Updated      : " & objDomain.DateUpdated
    WScript.Echo "Expiration Date   : " & objDomain.ExpirationDate
Else
    WScript.Echo "Error Number      : " & objDomain.ErrorNumber
    WScript.Echo "Error Description : " & objDomain.ErrorDescription
    WScript.Echo "Error Source      : " & objDomain.ErrorSource
End If

Set objDomain = Nothing


Class WhoIs
' This class uses Network Solutions, Inc.'s Whois page to
' retrieve information for .com, .org, and .net domains.
' Note that this class will break as soon as Network Solutions
' alters the layout of the Whois results pages.
'
' Properties:
' DomainName       R/W [string]  domain name to be queried, e.g. "google.com"
' ConnectTimeOut   R/W [integer] time-out in seconds, default 15
' CreationDate     R   [date]    creation date of the whois record
' DateUpdated      R   [date]    date of the whois record's last update
' Debug            R/W [boolean] if TRUE, Internet Explorer window will become
'                                and remain visible, and will not be terminated
' ErrorDescription R   [string]  a short description of the error that occurred
' ErrorNumber      R   [integer] 0: ok, 462: connection error or time-out,
'                                10001: query error, 10002: can't handle return
'                                format (as in .edu domains)
' ErrorSource      R   [string]  a short description of the source of the error
' ExpirationDate   R   [date]    expiration date of the whois record
' NameServers      R   [string]  comma separated list of DNS servers
' ReferralURL  **  R   [string]  URL of registrar's website
' Registrar        R   [string]  company name of registrar
' Status           R   [string]  comma separated list of domain registry flags
' Version          R   [string]  version number of this class
' WhoisServer  **  R   [string]  hostname of the registrar's whois server
' **                             property empty for .org domains
'
' Method:
' Query( )         start the query for the domain specified by DomainName
'
' Change Log:
' May 5, 2007      Added Debug, ErrorNumber, ErrorDescription, ErrorSource
'                  and Version properties, fixed errors in .org domain handling
' April 28, 2007   First public release
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com

    ' Declare all our private, or local, variables
    Private arrLine, arrStatus, arrString, arrText, blnTimedOut
    Private colMatches, i, objIE, objRE, strStatus, strString, x
    Private m_ConnectTimeOut, m_CreationDate, m_Debug, m_ErrorNumber
    Private m_ErrorDescription, m_ErrorSource, m_DateUpdated
    Private m_DomainName, m_ExpirationDate, m_NameServers
    Private m_ReferralURL, m_Registrar, m_Status, m_Version, m_WhoisServer


    ' Initialize the variables when the class is initialized
    Private Sub Class_Initialize
        blnTimedOut        = False
        i                  = 0
        m_ConnectTimeOut   = 10
        m_CreationDate     = vbNull
        m_DateUpdated      = vbNull
        m_Debug            = False
        m_DomainName       = ""
        m_ErrorNumber      = 0
        m_ErrorDescription = ""
        m_ErrorSource      = ""
        m_ExpirationDate   = vbNull
        m_NameServers      = ""
        m_ReferralURL      = ""
        m_Registrar        = ""
        m_Status           = ""
        m_Version          = "1.10"
        m_WhoisServer      = ""
        strString          = ""
    End Sub


    ' Get the ConnectTimeOut value
    Public Property Get ConnectTimeOut
        ConnectTimeOut = m_ConnectTimeOut
    End Property


    ' Set the ConnectTimeOut value
    Public Property Let ConnectTimeOut( myTimeOut )
        If IsNumeric( myTimeOut ) Then
            m_ConnectTimeOut = CInt( myTimeOut )
        Else
            m_ConnectTimeOut = 0
            Err.Raise 5
        End If
    End Property


    ' Get the CreationDate value (read-only)
    Public Property Get CreationDate
        CreationDate = m_CreationDate
    End Property


    ' Get the CreationDate value (read-only)
    Public Property Get DateUpdated
        DateUpdated = m_DateUpdated
    End Property


    ' Get the Debug value
    Public Property Get Debug
        Debug = m_Debug
    End Property


    ' Set the Debug value
    Public Property Let Debug( blnDebug )
        If blnDebug = True Then
            m_Debug = True
        Else
            m_Debug = False
        End If
    End Property


    ' Get the DomainName value
    Public Property Get DomainName
        DomainName = m_DomainName
    End Property


    ' Set the DomainName value
    Public Property Let DomainName( myDomain )
        myDomain = Trim( LCase( myDomain ) )
        ' Check the format of the domain name
        Set objRE = New RegExp
        objRE.Global     = False
        objRE.IgnoreCase = True
        objRE.Pattern    = "ˆ[a-z][a-z_0-9-]+\.[a-z]{2,8}$"
        Set colMatches = objRE.Execute( myDomain )
        If colMatches.Count = 1 Then
            m_DomainName = myDomain
        Else
            m_DomainName = ""
            Err.Raise 5
        End If
        Set colMatches = Nothing
        Set objRE      = Nothing
    End Property


    ' Get the Error Number (read-only)
    Public Property Get ErrorNumber
        ErrorNumber = m_ErrorNumber
    End Property


    ' Get the Error Description (read-only)
    Public Property Get ErrorDescription
        ErrorDescription = m_ErrorDescription
    End Property


    ' Get the Error Source (read-only)
    Public Property Get ErrorSource
        ErrorSource = m_ErrorSource
    End Property


    ' Get the ExpirationDate value (read-only)
    Public Property Get ExpirationDate
        ExpirationDate = m_ExpirationDate
    End Property


    ' Get the NameServers value (read-only)
    Public Property Get NameServers
        NameServers = m_NameServers
    End Property


    ' Get the ReferralURL value (read-only; empty for .org domains)
    Public Property Get ReferralURL
        ReferralURL = m_ReferralURL
    End Property


    ' Get the Registrar value (read-only)
    Public Property Get Registrar
        Registrar = m_Registrar
    End Property


    ' Get the Status value (read-only)
    Public Property Get Status
        Status = m_Status
    End Property


    ' Get this class' version number (read-only)
    Public Property Get Version
        Version = m_Version
    End Property


    ' Get the WhoisServer value (read-only; empty for .org domains)
    Public Property Get WhoisServer
        WhoisServer = m_WhoisServer
    End Property


    ' Retrieve the information from Network Solutions
    ' and set the class' read-only properties accordingly
    Public Function Query
        ' Open the appropriate NetSol WhoIs URL in
        ' an "invisible" Internet Explorer window
        Set objIE = CreateObject( "InternetExplorer.Application" )
        objIE.Visible = m_Debug
        objIE.Navigate2 "https://www.networksolutions.com/whois/" _
                      & "registry-data.jsp?domain=" & m_DomainName
        ' Wait till IE is ready
        Do While objIE.Busy
            ' Wait 0.2 second
            WScript.Sleep 200
            i = i + 1
            ' Time out after the number of seconds
            ' specified by the ConnectTimeOut property
            If i > m_ConnectTimeOut * 5 Then
                blnTimedOut = True
                Exit Do
            End If
        Loop
        ' Retrieve the URL's text and save it in an array
        If Not blnTimedOut Then
            arrText = Split( objIE.Document.Body.InnerText, vbCrLf )
        End If
        ' Unless Debug is True, close the Internet Explorer session
        If Not m_Debug Then objIE.Quit
        Set objIE = Nothing
        ' Check if a time-out occurred, and return the result
        If blnTimedOut = False Then
            For i = 0 To UBound( arrText )
                ' Filter out the lines starting with 3 spaces
                Set objRE = New RegExp
                objRE.Global     = False
                objRE.IgnoreCase = True
                If LCase( Right( m_DomainName, 4 ) ) = ".org" Then
                    objRE.Pattern = "ˆ[a-z ]+:.{5,}"
                Else
                    objRE.Pattern = "ˆ +[a-z ]+: .{5,}"
                End If
                Set colMatches = objRE.Execute( arrText(i) )
                If colMatches.Count = 1 Then
                    arrLine = Split( arrText(i), ":" )
                    Select Case Trim( LCase( arrLine(0) ) )
                        Case "registrar"
                            arrString = Split( LCase( Trim( arrLine(1) ) ) )
                            For x = 0 To UBound( arrString )
                                strString = strString & " " _
                                          & UCase( Left( arrString(x), 1 ) ) _
                                          & Mid( arrString(x), 2 )
                            Next
                            m_Registrar = Trim( strString )
                        Case "sponsoring registrar"
                            m_Registrar = Trim( Split( arrLine(1), "(" )(0) )
                        Case "whois server"
                            m_WhoisServer = Trim( arrLine(1) )
                        Case "referral url"
                            m_ReferralURL = Trim( arrLine(1) ) & ":" _
                                          & Trim( arrLine(2) )
                        Case "name server"
                            If m_NameServers = "" Then
                                m_NameServers = LCase( Trim( arrLine(1) ) )
                            Else
                                m_NameServers = m_NameServers & "," _
                                              & LCase( Trim( arrLine(1) ) )
                            End If
                        Case "status"
                            strStatus = Trim( arrLine(1) )
                            If InStr( strStatus, " " ) Then
                                arrStatus = Split( LCase( strStatus ), " " )
                                strStatus = arrStatus(0) _
                                          & UCase( Left( arrStatus(1), 1 ) ) _
                                          & Mid( arrStatus(1), 2 ) _
                                          & UCase( Left( arrStatus(2), 1 ) ) _
                                          & Mid( arrStatus(2), 2 )
                            End If
                            If m_Status = "" Then
                                m_Status = Trim( strStatus )
                            Else
                                m_Status = m_Status & "," _
                                         & Trim( strStatus )
                            End If
                        Case "updated date"
                            m_DateUpdated = CDate( Trim( arrLine(1) ) )
                        Case "last updated on"
                            m_DateUpdated = CDate( Trim( Split( arrLine(1), " " )(0) ) )
                        Case "creation date"
                            m_CreationDate = CDate( Trim( arrLine(1) ) )
                        Case "created on"
                            m_CreationDate = CDate( Trim( Split( arrLine(1), " " )(0) ) )
                        Case "expiration date"
                            If LCase( Right( m_DomainName, 4 ) ) = ".org" Then
                                m_ExpirationDate = CDate( Trim( Split( arrLine(1), " " )(0) ) )
                            Else
                                m_ExpirationDate = CDate( Trim( arrLine(1) ) )
                            End If
                    End Select
                End If
                Set colMatches = Nothing
                Set objRE      = Nothing
            Next
            If m_Registrar = "" Then
                If Trim( arrText(1) ) = m_DomainName Then
                    m_ErrorNumber      = 10001
                    m_ErrorDescription = "Unable to extract domain registry info."
                    m_ErrorSource      = "Whois Class " & m_Version
                Else
                    m_ErrorNumber      = 10002
                    m_ErrorDescription = Trim( arrText(1) )
                    m_ErrorSource      = Trim( arrText(0) )
                End If
            End If
        Else
            m_ErrorNumber      = 462
            m_ErrorDescription = "The connection timed out. " _
                               & "The remote server machine does " _
                               & "not exist or is unavailable."
            If m_ConnectTimeOut < 45 Then
                m_ErrorDescription = m_ErrorDescription _
                                   & " Try a longer time-out interval."
            End If
            m_ErrorSource      = "Internet Explorer connection time-out"
        End If
    End Function
End Class
Sample output:
Whois Version     : 1.01
Domain Name       : youtube.com
Registrar         : Network Solutions, Llc.
Whois Server      : whois.networksolutions.com
Referral URL      : http://www.networksolutions.com
Name Servers      : dns1.sjl.youtube.com,dns2.sjl.youtube.com
Status            : clientDeleteProhibited,clientTransferProhibited,clientUpdateProhibited
Creation Date     : 15-02-2005
Last Updated      : 01-11-2006
Expiration Date   : 15-02-2009
Class Members in VBSEdit's Object Browser:
Class members are shown in object browser
 
Requirements:
Windows version: any
Network: any (Internet connection)
Client software: Internet Explorer 4 or later
Script Engine: WSH
Summarized: Works in all Windows versions with Internet Explorer 4 or later, and an Internet connection.
Needs to be modified (replace WScript.Sleep) to work in HTAs.
 
[Back to the top of this page]

page last uploaded: 2016-09-19, 14:58