Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for whois.wsc

(view source code of whois.wsc as plain text)

  1. <?xml version="1.0"?>
  2. <component>
  3.  
  4. <?component error="false" debug="false"?>
  5.  
  6. <registration
  7. 	description="Whois"
  8. 	progid="robvanderwoude.Whois"
  9. 	version="2"
  10. 	classid="{5d7c21e6-3597-4ed4-8f54-96792f30a603}"
  11. >
  12. </registration>
  13.  
  14. <public>
  15. 	<property name="ConnectTimeOut">
  16. 		<get/>
  17. 		<put/>
  18. 	</property>
  19. 	<property name="CreationDate">
  20. 		<get/>
  21. 	</property>
  22. 	<property name="DateUpdated">
  23. 		<get/>
  24. 	</property>
  25. 	<property name="Debug">
  26. 		<get/>
  27. 		<put/>
  28. 	</property>
  29. 	<property name="DomainName">
  30. 		<get/>
  31. 		<put/>
  32. 	</property>
  33. 	<property name="ErrorDescription">
  34. 		<get/>
  35. 	</property>
  36. 	<property name="ErrorNumber">
  37. 		<get/>
  38. 	</property>
  39. 	<property name="ErrorSource">
  40. 		<get/>
  41. 	</property>
  42. 	<property name="ExpirationDate">
  43. 		<get/>
  44. 	</property>
  45. 	<property name="NameServers">
  46. 		<get/>
  47. 	</property>
  48. 	<property name="ReferralURL">
  49. 		<get/>
  50. 	</property>
  51. 	<property name="Registrar">
  52. 		<get/>
  53. 	</property>
  54. 	<property name="Status">
  55. 		<get/>
  56. 	</property>
  57. 	<property name="Version">
  58. 		<get/>
  59. 	</property>
  60. 	<property name="WhoisServer">
  61. 		<get/>
  62. 	</property>
  63. 	<method name="Query">
  64. 	</method>
  65. </public>
  66.  
  67. <implements type="Behavior" id="Behavior"/>
  68.  
  69. <script language="VBScript">
  1. <![CDATA[
  2. ' This component uses Network Solutions, Inc.'s WhoIs page to retrieve
  3. ' information for .com, .org, and .net domains.
  4. ' Note that this component will break as soon as Network Solution
  5. ' alters the layout of the WhoIs results page.
  6. '
  7. ' DomainName       R/W [string]  domain name to be queried, e.g. "google.com"
  8. ' ConnectTimeOut   R/W [integer] time-out in seconds, default 15
  9. ' CreationDate     R   [date]    creation date of the whois record
  10. ' DateUpdated      R   [date]    date of the whois record's last update
  11. ' Debug            R/W [boolean] if TRUE, Internet Explorer window will become
  12. '                                and remain visible, and will not be terminated
  13. ' ErrorDescription R   [string]  a short description of the error that occurred
  14. ' ErrorNumber      R   [integer] 0: ok, 462: connection error or time-out,
  15. '                                10001: query error, 10002: can't handle return
  16. '                                format (as in .edu domains)
  17. ' ErrorSource      R   [string]  a short description of the source of the error
  18. ' ExpirationDate   R   [date]    expiration date of the whois record
  19. ' NameServers      R   [string]  comma separated list of DNS servers
  20. ' ReferralURL  **  R   [string]  URL of registrar's website
  21. ' Registrar        R   [string]  company name of registrar
  22. ' Status           R   [string]  comma separated list of domain registry flags
  23. ' Version          R   [string]  version number of this class
  24. ' WhoisServer  **  R   [string]  hostname of the registrar's whois server
  25. ' **                             property empty for .org domains
  26. '
  27. ' Method:
  28. ' Query( )         start the query for the domain specified by DomainName
  29. '
  30. ' Change Log:
  31. ' May 5, 2007      Added Debug, ErrorNumber, ErrorDescription, ErrorSource
  32. '                  and Version properties, fixed errors in .org domain handling
  33. ' April 29, 2007   First public release
  34. '
  35. ' Written by Rob van der Woude
  36. ' http://www.robvanderwoude.com
  37.  
  38. Option Explicit
  39.  
  40. Dim blnTimedOut, ConnectTimeOut, CreationDate, DateUpdated, Debug, DomainName
  41. Dim ErrorDescription, ErrorNumber, ErrorSource, ExpirationDate
  42. Dim NameServers, ReferralURL, Registrar, Status, Version, WhoisServer
  43.  
  44. blnTimedOut    = False
  45. ConnectTimeOut = 15
  46. Debug          = False
  47. Version        = "2.00"
  48.  
  49.  
  50. Function get_ConnectTimeOut( )
  51. 	get_ConnectTimeOut = ConnectTimeOut
  52. End Function
  53.  
  54. Function put_ConnectTimeOut( newValue )
  55. 	If IsNumeric( newValue ) Then
  56. 		ConnectTimeOut = Abs( CInt( newValue ) )
  57. 	Else
  58. 		ConnectTimeOut = 0
  59. 		Err.Raise 5
  60. 	End If
  61. End Function
  62.  
  63. Function get_CreationDate( )
  64. 	get_CreationDate = CreationDate
  65. End Function
  66.  
  67. Function get_DateUpdated( )
  68. 	get_DateUpdated = DateUpdated
  69. End Function
  70.  
  71. Function get_Debug( )
  72. 	get_Debug = Debug
  73. End Function
  74.  
  75. Function put_Debug( newValue )
  76. 	Debug = CBool( newValue )
  77. End Function
  78.  
  79. Function get_DomainName( )
  80. 	get_DomainName = DomainName
  81. End Function
  82.  
  83. Function put_DomainName( newValue )
  84. 	Dim colMatches, objRE
  85. 	newValue = Trim( LCase( newValue ) )
  86. 	' Check the format of the domain name
  87. 	Set objRE = New RegExp
  88. 	objRE.Global     = False
  89. 	objRE.IgnoreCase = True
  90. 	objRE.Pattern    = "^[a-z][a-z_0-9-]+\.[a-z]{2,8}$"
  91. 	Set colMatches = objRE.Execute( newValue )
  92. 	If colMatches.Count = 1 Then
  93. 		DomainName = newValue
  94. 	Else
  95. 		DomainName = ""
  96. 		Err.Raise 5
  97. 	End If
  98. 	Set colMatches = Nothing
  99. 	Set objRE      = Nothing
  100. End Function
  101.  
  102. Function get_ErrorDescription( )
  103. 	get_ErrorDescription = ErrorDescription
  104. End Function
  105.  
  106. Function get_ErrorNumber( )
  107. 	get_ErrorNumber = ErrorNumber
  108. End Function
  109.  
  110. Function get_ErrorSource( )
  111. 	get_ErrorSource = ErrorSource
  112. End Function
  113.  
  114. Function get_ExpirationDate( )
  115. 	get_ExpirationDate = ExpirationDate
  116. End Function
  117.  
  118. Function get_NameServers( )
  119. 	get_NameServers = NameServers
  120. End Function
  121.  
  122. Function get_ReferralURL( )
  123. 	get_ReferralURL = ReferralURL
  124. End Function
  125.  
  126. Function get_Registrar( )
  127. 	get_Registrar = Registrar
  128. End Function
  129.  
  130. Function get_Status( )
  131. 	get_Status = Status
  132. End Function
  133.  
  134. Function get_Version( )
  135. 	get_Version = Version
  136. End Function
  137.  
  138. Function get_WhoisServer( )
  139. 	get_WhoisServer = WhoisServer
  140. End Function
  141.  
  142. Sub Delay( seconds )
  143. 	Dim wshShell
  144. 	Set wshShell = CreateObject( "WScript.Shell" )
  145. 	wshShell.Run "ping -n " & ( seconds + 1 ) & " 127.0.0.1", 0, True
  146. 	Set wshShell = Nothing
  147. End Sub
  148.  
  149. Sub Delay( seconds )
  150.     Dim wshShell
  151.     Set wshShell = CreateObject( "WScript.Shell" )
  152.     wshShell.Run "ping -n " & ( seconds + 1 ) & " 127.0.0.1", 0, True
  153.     Set wshShell = Nothing
  154. End Sub
  155.  
  156. Function Query( )
  157. 	Dim arrLine, arrStatus, arrString, arrText, colMatches, i, objIE, objRE, strStatus, strString, x
  158. 	' Open the appropriate NetSol WhoIs URL in
  159. 	' an "invisible" Internet Explorer window
  160. 	Set objIE = CreateObject( "InternetExplorer.Application" )
  161. 	objIE.Visible = Debug
  162. 	objIE.Navigate2 "https://www.networksolutions.com/whois/" _
  163. 	              & "registry-data.jsp?domain=" & DomainName
  164. 	' Wait till IE is ready
  165. 	Do While objIE.Busy
  166. 		' Wait 1 second
  167. 		Delay 1
  168. 		i = i + 1
  169. 		' Time out after the number of seconds
  170. 		' specified by the ConnectTimeOut property
  171. 		If i > ConnectTimeOut * 5 Then
  172. 			blnTimedOut = True
  173. 			Exit Do
  174. 		End If
  175. 	Loop
  176. 	' Retrieve the URL's text and save it in an array
  177. 	If Not blnTimedOut Then
  178. 		arrText = Split( objIE.Document.Body.InnerText, vbCrLf )
  179. 	End If
  180. 	' Close the Internet Explorer session, unless Debug is true
  181. 	If Not Debug Then
  182. 		objIE.Quit
  183. 		Set objIE = Nothing
  184. 	End If
  185. 	' Check if a time-out occurred, and return the result
  186. 	If blnTimedOut = False Then
  187. 		For i = 0 To UBound( arrText )
  188. 			' Filter out the lines starting with 3 spaces
  189. 			Set objRE = New RegExp
  190. 			objRE.Global     = False
  191. 			objRE.IgnoreCase = True
  192. 			If LCase( Right( DomainName, 4 ) ) = ".org" Then
  193. 				objRE.Pattern = "^[a-z ]+:.{5,}"
  194. 			Else
  195. 				objRE.Pattern = "^ +[a-z ]+: .{5,}"
  196. 			End If
  197. 			Set colMatches = objRE.Execute( arrText(i) )
  198. 			If colMatches.Count = 1 Then
  199. 				arrLine = Split( arrText(i), ":" )
  200. 				Select Case Trim( LCase( arrLine(0) ) )
  201. 					Case "registrar"
  202. 						arrString = Split( LCase( Trim( arrLine(1) ) ) )
  203. 						For x = 0 To UBound( arrString )
  204. 							strString = strString & " " _
  205. 							          & UCase( Left( arrString(x), 1 ) ) _
  206. 							          & Mid( arrString(x), 2 )
  207. 						Next
  208. 						Registrar = Trim( strString )
  209. 					Case "sponsoring registrar"
  210. 						Registrar = Trim( Split( arrLine(1), "(" )(0) )
  211. 					Case "whois server"
  212. 						WhoisServer = Trim( arrLine(1) )
  213. 					Case "referral url"
  214. 						ReferralURL = Trim( arrLine(1) ) & ":" _
  215. 						              & Trim( arrLine(2) )
  216. 					Case "name server"
  217. 						If NameServers = "" Then
  218. 							NameServers = LCase( Trim( arrLine(1) ) )
  219. 						Else
  220. 							NameServers = NameServers & "," _
  221. 							              & LCase( Trim( arrLine(1) ) )
  222. 						End If
  223. 					Case "status"
  224. 						strStatus = Trim( arrLine(1) )
  225. 						If InStr( strStatus, " " ) Then
  226. 							arrStatus = Split( LCase( strStatus ), " " )
  227. 							strStatus = arrStatus(0) _
  228. 							          & UCase( Left( arrStatus(1), 1 ) ) _
  229. 							          & Mid( arrStatus(1), 2 ) _
  230. 							          & UCase( Left( arrStatus(2), 1 ) ) _
  231. 							          & Mid( arrStatus(2), 2 )
  232. 						End If
  233. 						If Status = "" Then
  234. 							Status = Trim( strStatus )
  235. 						Else
  236. 							Status = Status & "," _
  237. 							         & Trim( strStatus )
  238. 						End If
  239. 					Case "updated date"
  240. 						DateUpdated = CDate( Trim( arrLine(1) ) )
  241. 					Case "last updated on"
  242. 						DateUpdated = CDate( Trim( Split( arrLine(1), " " )(0) ) )
  243. 					Case "creation date"
  244. 						CreationDate = CDate( Trim( arrLine(1) ) )
  245. 					Case "created on"
  246. 						CreationDate = CDate( Trim( Split( arrLine(1), " " )(0) ) )
  247. 					Case "expiration date"
  248. 						If LCase( Right( DomainName, 4 ) ) = ".org" Then
  249. 							ExpirationDate = CDate( Trim( Split( arrLine(1), " " )(0) ) )
  250. 						Else
  251. 							ExpirationDate = CDate( Trim( arrLine(1) ) )
  252. 						End If
  253. 				End Select
  254. 			End If
  255. 			Set colMatches = Nothing
  256. 			Set objRE      = Nothing
  257. 		Next
  258. 		If Registrar = "" Then
  259. 			ErrorNumber      = 10001
  260. 			ErrorDescription = "Unable to retrieve domain registry info."
  261. 			ErrorSource      = "Whois WSC " & Version
  262. 		End If
  263. 	Else
  264. 		ErrorNumber      = 462
  265. 		ErrorDescription = "The connection timed out. " _
  266. 		                   & "The remote server machine does " _
  267. 		                   & "not exist or is unavailable."
  268. 		If ConnectTimeOut < 45 Then
  269. 			ErrorDescription = ErrorDescription _
  270. 			                   & " Try a longer time-out interval."
  271. 		End If
  272. 		ErrorSource      = "Internet Explorer connection time-out"
  273. 	End If
  274. End Function
  275.  
  276. ]]>
  1. </script>
  2.  
  3. </component>

page last uploaded: 2015-12-04, 16:51