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