Source code for whoiscls.vbs

```
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
```
```
 
```