Source code for birdname.vbs

```
Option Explicit
```
```
 
```
```
Dim blnVerbose
```
```
Dim intValid
```

Dim strLocLang, strBirdName, strMsg, strScientific, strSrcLang, strTgtLang, strTranslation

```
 
```
```
With WScript.Arguments
```
```
	If .Unnamed.Count <> 1 Then Syntax
```
```
	If .Named.Count    > 3 Then Syntax
```
```
	intValid = 0
```

	If .Named.Exists( "SL" ) Then ' Source Language

		strSrcLang = LCase( .Named.Item( "SL" ) )

		If Not WCheck( "http://" & strSrcLang & ".wikipedia.org/" ) Then Syntax

```
		intValid = intValid + 1
```
```
	End If
```

	If .Named.Exists( "TL" ) Then ' Target Language

		strTgtLang = LCase( .Named.Item( "TL" ) )

		If Not WCheck( "http://" & strTgtLang & ".wikipedia.org/" ) Then Syntax

```
		intValid = intValid + 1
```
```
	End If
```

	If .Named.Exists( "V" ) Then ' Verbose output

```
		blnVerbose = True
```
```
		intValid = intValid + 1
```
```
	Else
```
```
		blnVerbose = False
```
```
	End If
```

	If intValid <> .Named.Count Then Syntax

	If strSrcLang = "" Then ' No source language specified: name specified must be scientific name

```
		strScientific = Cap( .Unnamed(0) )
```

		If Not WCheck( "http://en.wikipedia.org/wiki/" & Und( strScientific ) ) Then Syntax

```
	Else
```
```
		strBirdName = .Unnamed(0)
```
```
	End If
```
```
End With
```
```
 
```

' Translate from source language to scientific name

```
If strScientific = "" Then
```

	strScientific = GetScName( strBirdName, strSrcLang )

```
End If
```

' Translate scientific name to target language

strTranslation = Cap( Translate( strScientific, strTgtLang ) )

```
 
```
```
If blnVerbose Then
```
```
	strMsg = ""
```

	If strSrcLang <> "" Then strMsg = UCase( strSrcLang ) & ": " & Cap( strBirdName ) & vbCrLf

	strMsg = strMsg & "Sc: " & strScientific & vbCrLf & UCase( strTgtLang ) & ": "

```
End If
```
```
strMsg = strMsg & strTranslation
```
```
WScript.Echo strMsg
```
```
 
```
```
 
```
```
' Capitalize
```
```
Function Cap( myString )
```
```
	Dim strString
```

	strString = Replace( myString, "  ", " " )

```
	strString = LCase( Trim( strString ) )
```

	Cap = UCase( Left( strString, 1 ) ) & Mid( strString, 2 )

```
End Function
```
```
 
```
```
 
```

' Read scientific name from WikiPedia page

Function GetScName( myBirdName, myLanguage )

```
	Dim objMatches, objRE
```

	Dim strBirdName, strHTML, strName, strURL

```
	strName = "-- Not Found --"
```
```
	strBirdName = Cap( myBirdName )
```

	strURL = "http://" & myLanguage & ".wikipedia.org/wiki/" & Und( strBirdName )

```
	strHTML = WGet( strURL )
```

	If Left( strHTML, 11 ) = "--Not found" Then

```
		GetScName = strHTML
```
```
		Exit Function
```
```
	End If
```
```
	Set objRE = New RegExp
```
```
	objRE.Global = False
```
```
	objRE.IgnoreCase = True
```

	objRE.Pattern = "<b>" & myBirdName & "</b> \(<i>(<b>)?([^<\n\r]+)(</b>)?</i>\)"

	Set objMatches = objRE.Execute( strHTML )

```
	If objMatches.Count > 0 Then
```

		If objMatches.Item(0).Submatches.Count > 2 Then

			strName = objMatches.Item(0).Submatches(1)

```
		End If
```
```
	End If
```
```
	Set objMatches = Nothing
```
```
	Set objRE = Nothing
```
```
	GetScName = strName
```
```
End Function
```
```
 
```
```
 
```

' Translate scientific name to specified language using WikiPedia

Function Translate( mySciName, myLanguage )

```
	Dim objMatches, objRE
```
```
	Dim strHTML, strName, strURL
```
```
	strName = "-- Not Found --"
```

	strURL = "http://" & myLanguage & ".wikipedia.org/wiki/" & Und( mySciName )

```
	strHTML = WGet( strURL )
```

	If Left( strHTML, 11 ) = "--Not found" Then

```
		Translate = strHTML
```
```
		Exit Function
```
```
	End If
```
```
	Set objRE = New RegExp
```
```
	objRE.Global = False
```
```
	objRE.IgnoreCase = True
```

	' First, let's assume the page title is the translated name

	objRE.Pattern = "<h1 id=""firstHeading"" class=""firstHeading"">([^<]+)</h1>"

	Set objMatches = objRE.Execute( strHTML )

```
	If objMatches.Count > 0 Then
```

		If objMatches.Item(0).Submatches.Count > 0 Then

			strName = objMatches.Item(0).Submatches(0)

```
		End If
```
```
	End If
```

	' In case the page title is the scientific name, try an alternative search pattern

	If LCase( mySciName ) = LCase( strName ) Then

		objre.Pattern = "<b>([^<]+)</b> \(<i>(<b>)?" & mySciName & "(</b>)?</i>(,|\)) [^\n\r]{20,}[\n\r]"

		Set objMatches = objRE.Execute( strHTML )

```
		If objMatches.Count > 0 Then
```

			If objMatches.Item(0).Submatches.Count > 0 Then

				strName = objMatches.Item(0).Submatches(0)

```
			End If
```
```
		End If
```
```
	End If
```
```
	Set objMatches = Nothing
```
```
	Set objRE = Nothing
```
```
	Translate = strName
```
```
End Function
```
```
 
```
```
 
```

' Replace spaces by underscores to create URL

```
Function Und( myString )
```
```
	Und = Replace( myString, " ", "_" )
```
```
End Function
```
```
 
```
```
 
```

' Check if the specified subdomain exists

```
Function WCheck( myURL )
```
```
	Dim objHTTP, objRE
```
```
	Dim strResponse
```
```
	WCheck = False
```

	Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )

```
	objHTTP.Open "GET", myURL
```
```
	objHTTP.Send
```
```
	If objHTTP.Status = 200 Then
```
```
		Set objRE = New RegExp
```
```
		objRE.Global = False
```
```
		objRE.IgnoreCase = True
```
```
		objRE.Pattern = "\.wiki[pm]edia\.org"
```

		If objRE.Test( objHTTP.GetAllResponseHeaders( ) ) Then WCheck = True

```
		Set objRE = Nothing
```
```
	End If
```
```
	Set objHTTP = Nothing
```
```
End Function
```
```
 
```
```
 
```
```
' Read the entire web page
```
```
Function WGet( myURL )
```
```
	Dim objHTTP
```
```
	WGet = "--Not Found: " & myURL & "--"
```

	Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )

```
	objHTTP.Open "GET", myURL
```
```
	objHTTP.Send
```
```
	If objHTTP.Status = 200 Then
```
```
		WGet = objHTTP.ResponseText
```
```
	Else
```

		WGet = "--Not found (" & objHTTP.Status & ") " & myURL & "--"

```
	End If
```
```
	Set objHTTP = Nothing
```
```
End Function
```
```
 
```
```
 
```
```
' Display help
```
```
Sub Syntax
```
```
	Dim strMsg
```

	strMsg = "BirdName.vbs,  Version 1.01" & vbCrLf _

	       & "Use Wikipedia to translate a bird name from one language to another" _

```
	       & vbCrLf & vbCrLf _
```

	       & "Usage:" & vbTab & "BIRDNAME  /SL:lang  ""bird name""  /TL:lang  [ /V ]" _

```
	       & vbCrLf _
```

	       & "   or:" & vbTab & "BIRDNAME  ""scientific name""      /TL:lang  [ /V ]" _

```
	       & vbCrLf & vbCrLf _
```

	       & "Where:" & vbTab & """bird name""      " & vbTab & "full bird name to be translated" _

```
	       & vbCrLf _
```

	       & "      " & vbTab & """scientific name""" & vbTab & "scientific name to be translated" _

```
	       & vbCrLf _
```

	       & "      " & vbTab & "/SL              " & vbTab & "specifies ""Source Language"" (to translate from)" _

```
	       & vbCrLf _
```

	       & "      " & vbTab & "/TL              " & vbTab & "specifies ""Target Language"" (to translate to)" _

```
	       & vbCrLf _
```

	       & "      " & vbTab & "/V               " & vbTab & "display specified and scientific names too" _

```
	       & vbCrLf _
```

	       & "      " & vbTab & "lang             " & vbTab & "language code, as used by Wikipedia (e.g. EN)" _

```
	       & vbCrLf & vbCrLf _
```

	       & "Examples:" & vbTab & "BIRDNAME  /SL:EN  ""Great bittern""  /TL:FR  /V" _

```
	       & vbCrLf _
```

	       & "         " & vbTab & "BIRDNAME  ""Fulica atra""  /TL:RU" _

```
	       & vbCrLf & vbCrLf _
```

	       & "Notes:" & vbTab & "Specified bird names must be full names, as used in Wikipedia." _

```
	       & vbCrLf _
```

	       & "      " & vbTab & "See http://meta.wikimedia.org/wiki/List_of_Wikipedias for a list" _

```
	       & vbCrLf _
```

	       & "      " & vbTab & "of available languages (or use my ListWikipediaLanguages.vbs)." _

```
	       & vbCrLf _
```

	       & "      " & vbTab & "Availability of a language doesn't guarantee correct translations." _

```
	       & vbCrLf _
```

	       & "      " & vbTab & "This script will fail if Wikipedia changes its page layout." _

```
	       & vbCrLf _
```

	       & "      " & vbTab & "No guarantees, use this script at your own risk." _

```
	       & vbCrLf & vbCrLf _
```

	       & "Written by Rob van der Woude" _

```
	       & vbCrLf _
```

	       & "http://www.robvanderwoude.com"

	If Right( UCase( WScript.FullName ), 12 ) = "\CSCRIPT.EXE" Then

```
		WScript.StdErr.Write strMsg
```
```
	Else
```
```
		WScript.Echo strMsg
```
```
	End If
```
```
	WScript.Quit 1
```
```
End Sub
```
```
 
```