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 (WSC)
VBScript Code:
Option Explicit

Dim objFSO, objWhois, strWSC

On Error Resume Next
 ' First let's see if the component is registered
Set objWhois = CreateObject( "robvanderwoude.Whois.2" )
If Err Then
    ' If not, check if it exists in the current directory
    ' and use an alternative method to reference the component
    Set objFSO = CreateObject( "Scripting.FileSystemObject" )
    With objFSO
        strWSC = .BuildPath( .GetParentFolderName( WScript.ScriptFullName ), "Whois.wsc" )
        If .FileExists( strWSC ) Then
            strWSC = "script:" & strWSC
            Set objWhois = GetObject( strWSC )
        Else
            WScript.Echo "Whois.wsc not registered, " _
                       & "nor found in current directory"
        End If
    End With
    Set objFSO = Nothing
End If
On Error Goto 0

' Abort if we couldn't instantiate the object
If Not IsObject( objWhois ) Then WScript.Quit
' Set the required properties and query the Whois database
objWhois.DomainName = "youtube.com"
objWhois.ConnectTimeOut = 20
objWhois.Debug = False
objWhois.Query

' Display the results
WScript.Echo "Debug Status      : " & objWhois.Debug
WScript.Echo "Domain Name       : " & objWhois.DomainName
If objWhois.ErrorNumber Then
    WScript.Echo "Error Number      : " & objWhois.ErrorNumber
    WScript.Echo "Error Source      : " & objWhois.ErrorSource
    WScript.Echo "Error Description : " & objWhois.ErrorDescription
Else
    WScript.Echo "Registrar         : " & objWhois.Registrar
    WScript.Echo "Whois Server      : " & objWhois.WhoisServer
    WScript.Echo "Referral URL      : " & objWhois.ReferralURL
    WScript.Echo "Name Servers      : " & objWhois.NameServers
    WScript.Echo "Status            : " & objWhois.Status
    WScript.Echo "Creation Date     : " & objWhois.CreationDate
    WScript.Echo "Last Updated      : " & objWhois.DateUpdated
    WScript.Echo "Expiration Date   : " & objWhois.ExpirationDate
End If

' Release the object
Set objWhois = Nothing
Windows Script Component Source Code:
<?xml version="1.0"?>
<component>

<?component error="false" debug="false"?>

<registration
    description="Whois"
    progid="robvanderwoude.Whois"
    version="2"
    classid="{5d7c21e6-3597-4ed4-8f54-96792f30a603}"
>
</registration>

<public>
    <property name="ConnectTimeOut">
        <get/>
        <put/>
    </property>
    <property name="CreationDate">
        <get/>
    </property>
    <property name="DateUpdated">
        <get/>
    </property>
    <property name="Debug">
        <get/>
        <put/>
    </property>
    <property name="DomainName">
        <get/>
        <put/>
    </property>
    <property name="ErrorDescription">
        <get/>
    </property>
    <property name="ErrorNumber">
        <get/>
    </property>
    <property name="ErrorSource">
        <get/>
    </property>
    <property name="ExpirationDate">
        <get/>
    </property>
    <property name="NameServers">
        <get/>
    </property>
    <property name="ReferralURL">
        <get/>
    </property>
    <property name="Registrar">
        <get/>
    </property>
    <property name="Status">
        <get/>
    </property>
    <property name="Version">
        <get/>
    </property>
    <property name="WhoisServer">
        <get/>
    </property>
    <method name="Query">
    </method>
</public>

<implements type="Behavior" id="Behavior"/>

<script language="VBScript">
<![CDATA[
' This component uses Network Solutions, Inc.'s WhoIs page to retrieve
' information for .com, .org, and .net domains.
' Note that this component will break as soon as Network Solution
' alters the layout of the WhoIs results page.
'
' 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 29, 2007   First public release
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com

Option Explicit

Dim blnTimedOut, ConnectTimeOut, CreationDate, DateUpdated, Debug, DomainName
Dim ErrorDescription, ErrorNumber, ErrorSource, ExpirationDate
Dim NameServers, ReferralURL, Registrar, Status, Version, WhoisServer

blnTimedOut    = False
ConnectTimeOut = 15
Debug          = False
Version        = "2.00"


Function get_ConnectTimeOut( )
    get_ConnectTimeOut = ConnectTimeOut
End Function

Function put_ConnectTimeOut( newValue )
    If IsNumeric( newValue ) Then
        ConnectTimeOut = Abs( CInt( newValue ) )
    Else
        ConnectTimeOut = 0
        Err.Raise 5
    End If
End Function

Function get_CreationDate( )
    get_CreationDate = CreationDate
End Function

Function get_DateUpdated( )
    get_DateUpdated = DateUpdated
End Function

Function get_Debug( )
    get_Debug = Debug
End Function

Function put_Debug( newValue )
    Debug = CBool( newValue )
End Function

Function get_DomainName( )
    get_DomainName = DomainName
End Function

Function put_DomainName( newValue )
    Dim colMatches, objRE
    newValue = Trim( LCase( newValue ) )
    ' 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( newValue )
    If colMatches.Count = 1 Then
        DomainName = newValue
    Else
        DomainName = ""
        Err.Raise 5
    End If
    Set colMatches = Nothing
    Set objRE      = Nothing
End Function

Function get_ErrorDescription( )
    get_ErrorDescription = ErrorDescription
End Function

Function get_ErrorNumber( )
    get_ErrorNumber = ErrorNumber
End Function

Function get_ErrorSource( )
    get_ErrorSource = ErrorSource
End Function

Function get_ExpirationDate( )
    get_ExpirationDate = ExpirationDate
End Function

Function get_NameServers( )
    get_NameServers = NameServers
End Function

Function get_ReferralURL( )
    get_ReferralURL = ReferralURL
End Function

Function get_Registrar( )
    get_Registrar = Registrar
End Function

Function get_Status( )
    get_Status = Status
End Function

Function get_Version( )
    get_Version = Version
End Function

Function get_WhoisServer( )
    get_WhoisServer = WhoisServer
End Function

Sub Delay( seconds )
    Dim wshShell
    Set wshShell = CreateObject( "WScript.Shell" )
    wshShell.Run "ping -n " & ( seconds + 1 ) & " 127.0.0.1", 0, True
    Set wshShell = Nothing
End Sub

Sub Delay( seconds )
    Dim wshShell
    Set wshShell = CreateObject( "WScript.Shell" )
    wshShell.Run "ping -n " & ( seconds + 1 ) & " 127.0.0.1", 0, True
    Set wshShell = Nothing
End Sub

Function Query( )
    Dim arrLine, arrStatus, arrString, arrText, colMatches, i, objIE, objRE, strStatus, strString, x
    ' Open the appropriate NetSol WhoIs URL in
    ' an "invisible" Internet Explorer window
    Set objIE = CreateObject( "InternetExplorer.Application" )
    objIE.Visible = Debug
    objIE.Navigate2 "https://www.networksolutions.com/whois/" _
                  & "registry-data.jsp?domain=" & DomainName
    ' Wait till IE is ready
    Do While objIE.Busy
        ' Wait 1 second
        Delay 1
        i = i + 1
        ' Time out after the number of seconds
        ' specified by the ConnectTimeOut property
        If i > 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
    ' Close the Internet Explorer session, unless Debug is true
    If Not Debug Then
        objIE.Quit
        Set objIE = Nothing
    End If
    ' 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( 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
                        Registrar = Trim( strString )
                    Case "sponsoring registrar"
                        Registrar = Trim( Split( arrLine(1), "(" )(0) )
                    Case "whois server"
                        WhoisServer = Trim( arrLine(1) )
                    Case "referral url"
                        ReferralURL = Trim( arrLine(1) ) & ":" _
                                      & Trim( arrLine(2) )
                    Case "name server"
                        If NameServers = "" Then
                            NameServers = LCase( Trim( arrLine(1) ) )
                        Else
                            NameServers = 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 Status = "" Then
                            Status = Trim( strStatus )
                        Else
                            Status = Status & "," _
                                     & Trim( strStatus )
                        End If
                    Case "updated date"
                        DateUpdated = CDate( Trim( arrLine(1) ) )
                    Case "last updated on"
                        DateUpdated = CDate( Trim( Split( arrLine(1), " " )(0) ) )
                    Case "creation date"
                        CreationDate = CDate( Trim( arrLine(1) ) )
                    Case "created on"
                        CreationDate = CDate( Trim( Split( arrLine(1), " " )(0) ) )
                    Case "expiration date"
                        If LCase( Right( DomainName, 4 ) ) = ".org" Then
                            ExpirationDate = CDate( Trim( Split( arrLine(1), " " )(0) ) )
                        Else
                            ExpirationDate = CDate( Trim( arrLine(1) ) )
                        End If
                End Select
            End If
            Set colMatches = Nothing
            Set objRE      = Nothing
        Next
        If Registrar = "" Then
            ErrorNumber      = 10001
            ErrorDescription = "Unable to retrieve domain registry info."
            ErrorSource      = "Whois WSC " & Version
        End If
    Else
        ErrorNumber      = 462
        ErrorDescription = "The connection timed out. " _
                           & "The remote server machine does " _
                           & "not exist or is unavailable."
        If ConnectTimeOut < 45 Then
            ErrorDescription = ErrorDescription _
                               & " Try a longer time-out interval."
        End If
        ErrorSource      = "Internet Explorer connection time-out"
    End If
End Function

]]>
</script>

</component>
Sample output:
Debug Status      : False
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
 
Requirements:
Windows version: any
Network: any (Internet connection)
Client software: Internet Explorer 4 or later
Script Engine: any
Summarized: Works in all Windows versions with Internet Explorer 4 or later, and an Internet connection.
To run the script requires that Whois.wsc is either registered or located in the same directory as the script itself.
Register a WSC file
 
[Back to the top of this page]

page last modified: 2016-09-19; loaded in 0.0077 seconds