Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for birdname.vbs

(view source code of birdname.vbs as plain text)

  1. Option Explicit
  2.  
  3. Dim blnVerbose
  4. Dim intValid
  5. Dim strLocLang, strBirdName, strMsg, strScientific, strSrcLang, strTgtLang, strTranslation
  6.  
  7. With WScript.Arguments
  8. 	If .Unnamed.Count <> 1 Then Syntax
  9. 	If .Named.Count    > 3 Then Syntax
  10. 	intValid = 0
  11. 	If .Named.Exists( "SL" ) Then ' Source Language
  12. 		strSrcLang = LCase( .Named.Item( "SL" ) )
  13. 		If Not WCheck( "http://" & strSrcLang & ".wikipedia.org/" ) Then Syntax
  14. 		intValid = intValid + 1
  15. 	End If
  16. 	If .Named.Exists( "TL" ) Then ' Target Language
  17. 		strTgtLang = LCase( .Named.Item( "TL" ) )
  18. 		If Not WCheck( "http://" & strTgtLang & ".wikipedia.org/" ) Then Syntax
  19. 		intValid = intValid + 1
  20. 	End If
  21. 	If .Named.Exists( "V" ) Then ' Verbose output
  22. 		blnVerbose = True
  23. 		intValid = intValid + 1
  24. 	Else
  25. 		blnVerbose = False
  26. 	End If
  27. 	If intValid <> .Named.Count Then Syntax
  28. 	If strSrcLang = "" Then ' No source language specified: name specified must be scientific name
  29. 		strScientific = Cap( .Unnamed(0) )
  30. 		If Not WCheck( "http://en.wikipedia.org/wiki/" & Und( strScientific ) ) Then Syntax
  31. 	Else
  32. 		strBirdName = .Unnamed(0)
  33. 	End If
  34. End With
  35.  
  36. ' Translate from source language to scientific name
  37. If strScientific = "" Then
  38. 	strScientific = GetScName( strBirdName, strSrcLang )
  39. End If
  40. ' Translate scientific name to target language
  41. strTranslation = Cap( Translate( strScientific, strTgtLang ) )
  42.  
  43. If blnVerbose Then
  44. 	strMsg = ""
  45. 	If strSrcLang <> "" Then strMsg = UCase( strSrcLang ) & ": " & Cap( strBirdName ) & vbCrLf
  46. 	strMsg = strMsg & "Sc: " & strScientific & vbCrLf & UCase( strTgtLang ) & ": "
  47. End If
  48. strMsg = strMsg & strTranslation
  49. WScript.Echo strMsg
  50.  
  51.  
  52. ' Capitalize
  53. Function Cap( myString )
  54. 	Dim strString
  55. 	strString = Replace( myString, "  ", " " )
  56. 	strString = LCase( Trim( strString ) )
  57. 	Cap = UCase( Left( strString, 1 ) ) & Mid( strString, 2 )
  58. End Function
  59.  
  60.  
  61. ' Read scientific name from WikiPedia page
  62. Function GetScName( myBirdName, myLanguage )
  63. 	Dim objMatches, objRE
  64. 	Dim strBirdName, strHTML, strName, strURL
  65. 	strName = "-- Not Found --"
  66. 	strBirdName = Cap( myBirdName )
  67. 	strURL = "http://" & myLanguage & ".wikipedia.org/wiki/" & Und( strBirdName )
  68. 	strHTML = WGet( strURL )
  69. 	If Left( strHTML, 11 ) = "--Not found" Then
  70. 		GetScName = strHTML
  71. 		Exit Function
  72. 	End If
  73. 	Set objRE = New RegExp
  74. 	objRE.Global = False
  75. 	objRE.IgnoreCase = True
  76. 	objRE.Pattern = "<b>" & myBirdName & "</b> \(<i>(<b>)?([^<\n\r]+)(</b>)?</i>\)"
  77. 	Set objMatches = objRE.Execute( strHTML )
  78. 	If objMatches.Count > 0 Then
  79. 		If objMatches.Item(0).Submatches.Count > 2 Then
  80. 			strName = objMatches.Item(0).Submatches(1)
  81. 		End If
  82. 	End If
  83. 	Set objMatches = Nothing
  84. 	Set objRE = Nothing
  85. 	GetScName = strName
  86. End Function
  87.  
  88.  
  89. ' Translate scientific name to specified language using WikiPedia
  90. Function Translate( mySciName, myLanguage )
  91. 	Dim objMatches, objRE
  92. 	Dim strHTML, strName, strURL
  93. 	strName = "-- Not Found --"
  94. 	strURL = "http://" & myLanguage & ".wikipedia.org/wiki/" & Und( mySciName )
  95. 	strHTML = WGet( strURL )
  96. 	If Left( strHTML, 11 ) = "--Not found" Then
  97. 		Translate = strHTML
  98. 		Exit Function
  99. 	End If
  100. 	Set objRE = New RegExp
  101. 	objRE.Global = False
  102. 	objRE.IgnoreCase = True
  103. 	' First, let's assume the page title is the translated name
  104. 	objRE.Pattern = "<h1 id=""firstHeading"" class=""firstHeading"">([^<]+)</h1>"
  105. 	Set objMatches = objRE.Execute( strHTML )
  106. 	If objMatches.Count > 0 Then
  107. 		If objMatches.Item(0).Submatches.Count > 0 Then
  108. 			strName = objMatches.Item(0).Submatches(0)
  109. 		End If
  110. 	End If
  111. 	' In case the page title is the scientific name, try an alternative search pattern
  112. 	If LCase( mySciName ) = LCase( strName ) Then
  113. 		objre.Pattern = "<b>([^<]+)</b> \(<i>(<b>)?" & mySciName & "(</b>)?</i>(,|\)) [^\n\r]{20,}[\n\r]"
  114. 		Set objMatches = objRE.Execute( strHTML )
  115. 		If objMatches.Count > 0 Then
  116. 			If objMatches.Item(0).Submatches.Count > 0 Then
  117. 				strName = objMatches.Item(0).Submatches(0)
  118. 			End If
  119. 		End If
  120. 	End If
  121. 	Set objMatches = Nothing
  122. 	Set objRE = Nothing
  123. 	Translate = strName
  124. End Function
  125.  
  126.  
  127. ' Replace spaces by underscores to create URL
  128. Function Und( myString )
  129. 	Und = Replace( myString, " ", "_" )
  130. End Function
  131.  
  132.  
  133. ' Check if the specified subdomain exists
  134. Function WCheck( myURL )
  135. 	Dim objHTTP, objRE
  136. 	Dim strResponse
  137. 	WCheck = False
  138. 	Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  139. 	objHTTP.Open "GET", myURL
  140. 	objHTTP.Send
  141. 	If objHTTP.Status = 200 Then
  142. 		Set objRE = New RegExp
  143. 		objRE.Global = False
  144. 		objRE.IgnoreCase = True
  145. 		objRE.Pattern = "\.wiki[pm]edia\.org"
  146. 		If objRE.Test( objHTTP.GetAllResponseHeaders( ) ) Then WCheck = True
  147. 		Set objRE = Nothing
  148. 	End If
  149. 	Set objHTTP = Nothing
  150. End Function
  151.  
  152.  
  153. ' Read the entire web page
  154. Function WGet( myURL )
  155. 	Dim objHTTP
  156. 	WGet = "--Not Found: " & myURL & "--"
  157. 	Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  158. 	objHTTP.Open "GET", myURL
  159. 	objHTTP.Send
  160. 	If objHTTP.Status = 200 Then
  161. 		WGet = objHTTP.ResponseText
  162. 	Else
  163. 		WGet = "--Not found (" & objHTTP.Status & ") " & myURL & "--"
  164. 	End If
  165. 	Set objHTTP = Nothing
  166. End Function
  167.  
  168.  
  169. ' Display help
  170. Sub Syntax
  171. 	Dim strMsg
  172. 	strMsg = "BirdName.vbs,  Version 1.01" & vbCrLf _
  173. 	       & "Use Wikipedia to translate a bird name from one language to another" _
  174. 	       & vbCrLf & vbCrLf _
  175. 	       & "Usage:" & vbTab & "BIRDNAME  /SL:lang  ""bird name""  /TL:lang  [ /V ]" _
  176. 	       & vbCrLf _
  177. 	       & "   or:" & vbTab & "BIRDNAME  ""scientific name""      /TL:lang  [ /V ]" _
  178. 	       & vbCrLf & vbCrLf _
  179. 	       & "Where:" & vbTab & """bird name""      " & vbTab & "full bird name to be translated" _
  180. 	       & vbCrLf _
  181. 	       & "      " & vbTab & """scientific name""" & vbTab & "scientific name to be translated" _
  182. 	       & vbCrLf _
  183. 	       & "      " & vbTab & "/SL              " & vbTab & "specifies ""Source Language"" (to translate from)" _
  184. 	       & vbCrLf _
  185. 	       & "      " & vbTab & "/TL              " & vbTab & "specifies ""Target Language"" (to translate to)" _
  186. 	       & vbCrLf _
  187. 	       & "      " & vbTab & "/V               " & vbTab & "display specified and scientific names too" _
  188. 	       & vbCrLf _
  189. 	       & "      " & vbTab & "lang             " & vbTab & "language code, as used by Wikipedia (e.g. EN)" _
  190. 	       & vbCrLf & vbCrLf _
  191. 	       & "Examples:" & vbTab & "BIRDNAME  /SL:EN  ""Great bittern""  /TL:FR  /V" _
  192. 	       & vbCrLf _
  193. 	       & "         " & vbTab & "BIRDNAME  ""Fulica atra""  /TL:RU" _
  194. 	       & vbCrLf & vbCrLf _
  195. 	       & "Notes:" & vbTab & "Specified bird names must be full names, as used in Wikipedia." _
  196. 	       & vbCrLf _
  197. 	       & "      " & vbTab & "See http://meta.wikimedia.org/wiki/List_of_Wikipedias for a list" _
  198. 	       & vbCrLf _
  199. 	       & "      " & vbTab & "of available languages (or use my ListWikipediaLanguages.vbs)." _
  200. 	       & vbCrLf _
  201. 	       & "      " & vbTab & "Availability of a language doesn't guarantee correct translations." _
  202. 	       & vbCrLf _
  203. 	       & "      " & vbTab & "This script will fail if Wikipedia changes its page layout." _
  204. 	       & vbCrLf _
  205. 	       & "      " & vbTab & "No guarantees, use this script at your own risk." _
  206. 	       & vbCrLf & vbCrLf _
  207. 	       & "Written by Rob van der Woude" _
  208. 	       & vbCrLf _
  209. 	       & "http://www.robvanderwoude.com"
  210. 	If Right( UCase( WScript.FullName ), 12 ) = "\CSCRIPT.EXE" Then
  211. 		WScript.StdErr.Write strMsg
  212. 	Else
  213. 		WScript.Echo strMsg
  214. 	End If
  215. 	WScript.Quit 1
  216. End Sub
  217.  

page last uploaded: 2017-08-21, 14:26