Source code for whois.wsc

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