Source code for birdname.hta

```
Option Explicit
```
```
 
```
```
On Error Goto 0
```
```
 
```
```
Const ForAppending = 8
```
```
Const ForReading   = 1
```
```
Const ForWriting   = 2
```
```
 
```
```
Const TristateFalse      =  0
```
```
Const TristateMixed      = -2
```
```
Const TristateTrue       = -1
```
```
Const TristateUseDefault = -2
```
```
 
```
```
Dim arrLang( )
```
```
Dim blnUseLocalLanguageNames
```

Dim objCaptions, objFSO, objIE, objSettings, wshShell

```
Dim strAlternativeScientificName
```
```
 
```

Set objCaptions = CreateObject( "Scripting.Dictionary" )

Set objSettings = CreateObject( "Scripting.Dictionary" )

Set objIE       = CreateObject( "InternetExplorer.Application" )

Set wshShell    = CreateObject( "WScript.Shell" )

Set objFSO      = CreateObject( "Scripting.FileSystemObject" )

```
 
```
```
 
```
```
Function Backup( myFile )
```

	' Backup this HTA; the COPY command is used because it handles open files much better than the FileSystemObject does

```
	Dim strBackup, strNow, wshShell
```

	strNow = Year( Now ) & Right( "0" & Month( Now ), 2 ) & Right( "0" & Day( Now ), 2 ) & "." & Right( "0" & Hour( Now ), 2 ) & Right( "0" & Minute( Now ), 2 ) & Right( "0" & Second( Now ), 2 )

	strBackup = myFile & "." & BirdName.Version & ".backup." & strNow

	Set wshShell = CreateObject( "WScript.Shell" )

	wshShell.Run "CMD.EXE /C COPY /Y """ & myFile & """ """ & strBackup & """", 7, True

```
	Set wshShell = Nothing
```
```
	Backup = strBackup
```
```
End Function
```
```
 
```
```
 
```
```
' Capitalize
```
```
Function Cap( myString )
```
```
	Dim strString
```

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

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

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

```
End Function
```
```
 
```
```
 
```
```
Sub CheckUpdate( )
```

	Dim intAnswer, intButtons, lenLatestVer

	Dim strCurDir, strCurrentVer, strLatestver, strPrompt, strTitle, strZIPFile

```
 
```
```
	'On Error Resume Next
```
```
 
```

	' Change mouse pointer to hourglass while checking for update

```
	Document.Body.Style.Cursor = "wait"
```
```
 
```
```
	strCurrentVer = BirdName.Version
```

	' Read the latest version info from the web

	strLatestVer  = WGet( "http://www.robvanderwoude.com/updates/birdname.txt" )

```
 
```

	' Retry once, after clearing the IE cache, if the versions don't match

```
	If strCurrentVer <> strLatestver Then
```
```
		' Clear the IE cache
```

		wshShell.Run "RUNDll32.EXE InetCpl.cpl,ClearMyTracksByProcess 8", 7, True

		' Try again, read the latest version info from the web

		strLatestver = WGet( "http://www.robvanderwoude.com/updates/birdname.txt" )

```
	End If
```
```
 
```
```
	lenLatestVer  = Len( strLatestVer )
```
```
	If lenLatestVer = 4 Then
```

		If objSettings.Item( "AutoUpdate" ) = 1 Then

```
			Update
```
```
		Else
```

			intButtons = vbYesNoCancel + vbApplicationModal + vbInformation

```
			If strLatestVer < strCurrentVer Then
```
```
				strTitle  = "Unofficial version"
```

				strPrompt = "You seem to be using a pre-release version (" & strCurrentVer & ") of BirdName.hta." _

```
				          & vbCrLf & vbCrLf _
```

				          & "The latest official release is " & strLatestver _

```
				          & vbCrLf & vbCrLf _
```

				          & "Do you want to download the latest official version?"

				intAnswer = MsgBox( strPrompt, intButtons + vbDefaultButton2, strTitle )

```
			End If
```
```
			If strLatestVer > strCurrentVer Then
```
```
				strTitle  = "Old version"
```

				strPrompt = "You are using version " & strCurrentVer & " of BirdName.hta." _

```
				          & vbCrLf & vbCrLf _
```

				          & "The latest official release is " & strLatestver _

```
				          & vbCrLf & vbCrLf _
```

				          & "Do you want to download the latest official version?"

				intAnswer = MsgBox( strPrompt, intButtons, strTitle )

```
			End If
```
```
			If intAnswer = vbYes Then
```

				strCurDir  = objFSO.GetParentFolderName( Self.location.pathname )

				strZIPFile = objFSO.BuildPath( strCurDir, "birdname_hta.zip" )

```
				' Delete existing ZIP file
```

				If objFSO.FileExists( strZIPFile ) Then objFSO.DeleteFile strZIPFile, True

```
				' Backup current HTA
```
```
				strTitle  = "Backup saved"
```

				strPrompt = "The current HTA has been copied to" & vbCrLf _

				          & """" & Backup( Self.location.pathname ) & """" & vbCrLf & vbCrLf _

```
				          & "Click OK to continue"
```

				intAnswer = MsgBox( strPrompt, vbOKCancel + vbApplicationModal + vbInformation, strTitle )

```
				If intAnswer = vbOK Then
```

					If Download( "http://www.robvanderwoude.com/files/birdname_hta.zip", strZIPFile ) > 12000 Then

						' Overwrite current HTA with extracted new version and restart HTA

```
						Extract strZIPFile, strCurDir
```

						setTimeout "Self.location.reload", 3000, "VBScript"

```
					Else
```
```
						' Delete corrupted ZIP file
```

						If objFSO.FileExists( strZIPFile ) Then objFSO.DeleteFile strZIPFile, True

						intButtons = vbOKOnly + vbExclamation + vbApplicationModal

						strPrompt  = "An error occurred while trying to download ""birdname_hta.zip""." _

```
						           & vbCrLf & vbCrLf _
```

						           & "Try again later, or contact the author if the problem persists."

```
						strTitle   = "Download Error"
```

						MsgBox strPrompt, intButtons, strTitle

```
					End If
```
```
				Else
```

					wshShell.Run "http://www.robvanderwoude.com/birdname.php", 3, False

```
				End If
```
```
			End If
```
```
		End If
```
```
	End If
```
```
 
```
```
	' Change mouse pointer back to default
```
```
	Document.Body.Style.Cursor = "default"
```
```
 
```
```
	On Error Goto 0
```
```
End Sub
```
```
 
```
```
 
```
```
Sub ClearTranslations( )
```
```
	Translation1.value = ""
```
```
	Translation2.value = ""
```
```
	Translation3.value = ""
```
```
	Translation4.value = ""
```

	Button_SearchTranslation1.disabled   = True

	Button_SearchTranslation2.disabled   = True

	Button_SearchTranslation3.disabled   = True

	Button_SearchTranslation4.disabled   = True

```
End Sub
```
```
 
```
```
 
```
```
Function Download( myURL, myFile )
```

	Dim i, intLen, objFile, objFSO, objHTTP

```
	intLen = 0
```

	Set objFSO  = CreateObject( "Scripting.FileSystemObject" )

	Set objFile = objFSO.OpenTextFile( myFile, ForWriting, True )

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

```
	objHTTP.Open "GET", myURL, False
```
```
	objHTTP.Send
```

	' Write the downloaded byte stream to the target file

```
	intLen = LenB( objHTTP.ResponseBody )
```
```
	For i = 1 To intLen
```

		objFile.Write Chr( AscB( MidB( objHTTP.ResponseBody, i, 1 ) ) )

```
	Next
```
```
	objFile.Close( )
```
```
	Set objHTTP = Nothing
```
```
	Set objFile = Nothing
```
```
	Set objFSO  = Nothing
```
```
	Download = intLen
```
```
End Function
```
```
 
```
```
 
```
```
Sub Extract( myZIPFile, myTargetDir )
```

	Dim intOptions, objShell, objSource, objTarget

	Set objShell  = CreateObject( "Shell.Application" )

	Set objSource = objShell.NameSpace( myZIPFile ).Items( )

	Set objTarget = objShell.NameSpace( myTargetDir )

	' These are the available CopyHere options, according to MSDN

	' (http://msdn2.microsoft.com/en-us/library/ms723207.aspx).

	' On my test systems, however, the options were completely ignored.

	'      4: Do not display a progress dialog box.

	'      8: Give the file a new name in a move, copy, or rename operation if a file with the target name already exists.

	'     16: Click "Yes to All" in any dialog box that is displayed.

	'     64: Preserve undo information, if possible.

	'    128: Perform the operation on files only if a wildcard file name (*.*) is specified.

	'    256: Display a progress dialog box but do not show the file names.

	'    512: Do not confirm the creation of a new directory if the operation requires one to be created.

	'   1024: Do not display a user interface if an error occurs.

	'   4096: Only operate in the local directory. Don't operate recursively into subdirectories.

	'   8192: Do not copy connected files as a group. Only copy the specified files.

```
	intOptions = 16 + 256
```

	objTarget.CopyHere objSource, intOptions

```
	Set objSource = Nothing
```
```
	Set objTarget = Nothing
```
```
	Set objShell  = Nothing
```
```
End Sub
```
```
 
```
```
 
```
```
Function GetLanguageList( )
```
```
	Dim i
```

	Dim objHTTP, objMatch, objMatches, objNewOption, objRE

```
	Dim strHTML, strMsg, strResp, strURL
```
```
 
```
```
	GetLanguageList = False
```
```
 
```

	' Read and save the entire URL including HTML tags in a variable named strHTML

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

	strURL = "http://meta.wikimedia.org/wiki/List_of_Wikipedias"

```
	objHTTP.Open "GET", strURL
```
```
	objHTTP.Send
```
```
	If objHTTP.Status = 200 Then
```
```
		strHTML = objHTTP.ResponseText
```
```
		GetLanguageList = True
```
```
	Else
```

		MsgBox "Unable to contact Wikipedia for a list of available languages." _

```
		     & vbCrLf & vbCrLf _
```

		     & "Error code: " & objHTTP.Status _

```
		     & vbCrLf & vbCrLf _
```

		     & "Correct the problem and try again.", vbOKOnly, "Connection Error"

```
	End If
```
```
	Set objHTTP = Nothing
```
```
 
```

	' Parse the languages tables and save the results in a 2-dimensional array named arrLang;

```
	' arrLang(0) is the language code
```

	' arrLang(1) is the local language name

	' arrLang(2) is the English language name

```
	Set objRE = New RegExp
```
```
	objRE.Global = True
```
```
	objRE.IgnoreCase = True
```

	objRE.Pattern = "<tr>[^<]*<td>[0-9,]+</td>[^<]*<td><a [^>]+>([^<]+)</a></td>[^<]*<td[^>]*><a [^>]+>([^<]+)</a></td>[^<]*<td><a [^>]+>([^<]+)</a></td>"

	Set objMatches = objRE.Execute( strHTML )

```
	For Each objMatch In objMatches
```
```
		If objMatch.Submatches.Count > 2 Then
```
```
			ReDim Preserve arrLang( 2, i )
```

			arrLang( 0, i ) = objMatch.Submatches.Item(2)

			arrLang( 1, i ) = objMatch.Submatches.Item(1)

			arrLang( 2, i ) = objMatch.Submatches.Item(0)

```
			i = i + 1
```
```
		End If
```
```
	Next
```
```
	Set objRE = Nothing
```
```
End Function
```
```
 
```
```
 
```

' Read scientific name from WikiPedia page

```
Sub GetScientificName( )
```
```
	Dim objMatches, objOption, objRE
```

	Dim strSpeciesName, strHTML, strLangCode, strURL

```
	Dim strDEBUG
```
```
 
```
```
	ScientificName.value = ""
```
```
	strAlternativeScientificName = ""
```

	strSpeciesName = Cap( SpeciesInput.value )

```
	SpeciesInput.value = strSpeciesName
```

	For Each objOption In SelectSourceLanguage.Options

```
		If objOption.Selected Then
```
```
			strLangCode = objOption.value
```
```
		End If
```
```
	Next
```

	strURL = "http://" & strLangCode & ".wikipedia.org/wiki/" & Und( strSpeciesName )

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

	If Left( LCase( strHTML ), 2 ) = "--" Then

```
		ScientificName.value = strHTML
```
```
		ScientificName.style.color = "red"
```
```
		Exit Sub
```
```
	Else
```
```
		ScientificName.style.color = "black"
```
```
	End If
```
```
	Set objRE = New RegExp
```
```
	objRE.Global = True
```
```
	objRE.IgnoreCase = True
```

	' First, test if the URL is for the selected animal class

	objRE.Pattern = Replace( SelectClass.value, "ph", "(ph|f)" )

	If objRE.Test( strHTML ) Or SelectClass.value = "All" Then

		' Next, find the bird name, followed by 1 or 2 scientific names in parenthesis

		objRE.Pattern = "<b>" & strSpeciesName & "</b> (<[bi]>)*\((<[bi]>)*([^<\n\r]+)(</[bi]>)*(<sup[^>]*>.*?</sup>)?([^<\)]*(<[bi]>)*([^<\)]+)(</[bi]>)*(<sup[^>]*>.*?</sup>)?)?\)(</[bi]>)*"

		Set objMatches = objRE.Execute( strHTML )

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

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

				' The displayed scientific name is the first match

				ScientificName.value = Cap( objMatches.Item(0).Submatches(2) )

				ScientificName.style.color = "black"

				' The optional second match is kept as a "spare" in case a translation will not be found

				strAlternativeScientificName = Cap( objMatches.Item(0).Submatches(9) )

```
			End If
```
```
		End If
```
```
	Else
```

		ScientificName.value = "--" & objcaptions.Item( "Not" & SelectClass.value ) & " " & objcaptions.Item( "OrAmbiguous" ) & "?--"

```
		ScientificName.style.color = "red"
```

		Button_SearchScientificName.disabled = False

```
		strAlternativeScientificName = ""
```
```
		ClearTranslations
```
```
	End If
```

	strDEBUG = strAlternativeScientificName

```
	Set objMatches = Nothing
```
```
	Set objRE = Nothing
```
```
End Sub
```
```
 
```
```
 
```
```
Sub HelpMsg( )
```
```
	Dim strHTML
```

	strHTML = "<h1>BirdName,  Version " & BirdName.Version & "</h1>\n\n" _

	        & "<p>This HTA uses <a href=""http://www.wikipedia.org/"">Wikipedia</a> to translate animal (chordata) species names from and to (m)any language(s).</p>\n\n" _

	        & "<p>You can use this program to translate a species name from one of the supported ""local"" languages to any of the other supported languages.<br>\n" _

	        & "Start by selecting a class in the dropdown list """ & objCaptions.Item( "Class" ) & ": <select size=""1"" style=""width: 10em;"">\n\t<option>" & objCaptions.Item( "All" ) & "</option>\n\t<option>" & objCaptions.Item( "ClassActinopterygii" ) & "</option>\n\t<option>" & objCaptions.Item( "ClassAmphibia" ) & "</option>\n\t<option selected=""selected"">" & objCaptions.Item( "ClassAves" ) & "</option>\n\t<option>" & objCaptions.Item( "ClassChondrichthyes" ) & "</option>\n\t<option>" & objCaptions.Item( "ClassMammalia" ) & "</option>\n\t<option>" & objCaptions.Item( "ClassReptilia" ) & "</option>\n</select>"".<br>\n" _

	        & "Next, type the species name in the <em>empty</em> field just below the class selection.<br>\n" _

	        & "The program will first search the scientific name on Wikipedia and then translate that scientific name to the language of choice.<br>\n" _

	        & "Alternatively, you can enter the scientific name yourself, and the program will translate it to the language(s) of choice.<br>\n" _

	        & "With the <input type=""button"" style=""width: 10em; height: 2em; vertical-align: middle"" value=""" & objCaptions.Item( "Search" ) & """> buttons you can search Wikipedia interactively for the requested translations.</p>\n\n" _

```
	        & "<h2>Settings</h2>\n\n" _
```

	        & "<p>If <input type=""checkbox""> <code>" & objCaptions.Item( "UseLocalLanguageNames" ) & "</code> is checked, the list of available languages shows the local language names (e.g. ""Fran&ccedil;ais"", ""Cymraeg""), if not checked the English language names are listed instead (e.g. ""French"", ""Welsh"").</p>\n\n" _

	        & "<p><select size=""1"" style=""width: 3em;"">\n\t<option>1</option>\n\t<option selected>2</option>\n\t<option>3</option>\n\t<option>4</option>\n</select> <code>" & objCaptions.Item( "SimultaneousTranslations" ) & "</code> controls the number of translations shown; it ranges from 1 to 4.</p>\n\n" _

	        & "<p>To change settings permanently, click the <input type=""button"" class=""Button"" value=""" & objCaptions.Item( "Configure" ) & """ style=""width: 10em; height: 2em; vertical-align: middle""> button, next to the """ & objCaptions.Item( "Settings" ) & """ header, to open the configuration files in Notepad (see the chapter ""Customization"" for more details).</p>\n\n" _

	        & "<p>Click <input type=""button"" style=""width: 10em; height: 2em; vertical-align: middle"" value=""" & objCaptions.Item( "HideSettings" ) & """> to move the """ & objCaptions.Item( "Settings" ) & """ block out of sight (it will reappear next time the program is started).</p>\n\n" _

	        & "<h2>Program Updates</h2>\n\n" _

	        & "<p>This program automatically checks for updates.<br>\n" _

	        & "If an update is available, a notification will pop up, asking you if you want to download the latest official release.<br>\n" _

	        & "If you click ""Yes"" the BirdName download page will be opened in your default browser.<br>\n" _

	        & "Unless you update the program, the notification will reappear next time the program is started.</p>\n\n" _

	        & "<p>If AutoUpdate is enabled, the program is updated ""on-the-fly"" without notification (see the chapter <a href=""#Customization"">Customization</a> for more details).</p>\n\n" _

	        & "<h2>Restrictions</h2>\n\n" _

	        & "<p>This program uses Wikipedia to find the requested translations.<br>\n" _

	        & "Thus it depends on:<br>\n\n" _

	        & "<ol>\n\t<li>the full name being entered, exactly as used on Wikipedia (e.g. ""Great Bittern"" instead of ""Bittern"")</li>\n\t<li>a page dedicated to the bird of choice in each language of choice</li>\n\t<li>redirection of the scientific name to the local name</li>\n\t<li>Wikipedia's page layout remaining more or less unchanged</li>\n</ol>\n\n" _

	        & "<p>It may be clear that these conditions may not always be met.<br>\n" _

	        & "If no translation was found because there is no dedicated page, use the <input type=""button"" style=""width: 10em; height: 2em; vertical-align: middle"" value=""" & objCaptions.Item( "Search" ) & """> button next to the """ & objCaptions.Item( "Translation" ) & """ field to search for the name yourself.</p>\n\n" _

	        & "<p>Ambiguity, multiple ""local"" names, or the use of an incomplete name or group name instead of the species' full name, may prevent the program to find the scientific name.<br>\n" _

	        & "That is where the <input type=""button"" style=""width: 10em; height: 2em; vertical-align: middle"" value=""" & objCaptions.Item( "Search" ) & """> button next to the """ & objCaptions.Item( "ScientificName" ) & """ field comes to the rescue.<br>\n" _

	        & "Click it to find the scientific name yourself, or look it up in a printed bird guide.<br>\n" _

	        & "Once found, clear the """ & objCaptions.Item( "BirdName" ) & """ field and use the """ & objCaptions.Item( "ScientificName" ) & """ field to find the requested translations.<br>\n" _

	        & "If you still can't find the translation that way, this program cannot assist you any further.</p>\n\n" _

	        & "<h2 id=""Customization"">Customization</h2>\n\n" _

	        & "<p>You may use a configuration file named BirdName.cfg, to customize the window size, default input and output languages and number of simultaneous translations.<br>\n" _

	        & "BirdName.cfg is an ANSI encoded (or ""ASCII"") plain text file, located in BirdName.hta's parent folder.<br>\n" _

	        & "Examine the default settings shown below to find out what you can customize and how:</p>\n\n" _

	        & "<pre>Version=" & BirdName.Version & "\n" _

```
	        & "AutoUpdate=0\n" _
```
```
	        & "ConfigLanguage=en\n" _
```
```
	        & "DefaultLanguage=en\n" _
```
```
	        & "LocalLanguageNames=1\n" _
```
```
	        & "NumTrans=4\n" _
```
```
	        & "TransLang1=nl\n" _
```
```
	        & "TransLang2=de\n" _
```
```
	        & "TransLang3=es\n" _
```
```
	        & "TransLang4=da\n" _
```
```
	        & "WindowHeight=768\n" _
```

	        & "WindowWidth=1024</pre>\n\n" _

	        & "<table>\n<tr>\n\t<th style=""vertical-align: top;"">Note 1:</th>\n\t<td style=""vertical-align: top;"">Each of these settings can also be specified on the command line, e.g.<br>\n" _

	        & "\t\t<code>BirdName.hta /ConfigLanguage=en /DefaultLanguage=fr</code></td>\n</tr>\n" _

	        & "<tr>\n\t<th style=""vertical-align: top;"">Note 2:</th>\n\t<td style=""vertical-align: top;""><code>AutoUpdate=1</code> will update the HTA to the latest version without any user interaction.</td>\n</tr>\n</table>\n\n" _

	        & "<p>Besides the program settings, you can also customize (translate) the captions and button labels.<br>\n" _

	        & "This requires an ANSI encoded (or ""ASCII"") plain text file named BirdName.<em>lang</em>, located in BirdName.hta's parent folder, where <em>lang</em> is the language code specified by <code>ConfigLanguage</code> in BirdName.cfg (e.g. <code>en</code>).<br>\n" _

	        & "Unicode or extended ASCII characters in all text except button labels must be escaped (e.g. <code>&amp;Uuml;</code> for <code>&Uuml;</code>).<br>\n" _

	        & "You may have to experiment with code page settings when using extended ASCII characters in translated <em>button</em> labels.<br>\n" _

	        & "Examine BirdName.en, shown below, to figure out what you can customize and how:</p>\n\n" _

	        & "<pre>Version=" & BirdName.Version & "\n" _

```
	        & "All=All\n" _
```
```
	        & "Class=Class\n" _
```
```
	        & "ClassAll=All\n" _
```

	        & "ClassActinopterygii=Ray-finned fishes\n" _

	        & "ClassAmphibia=Amphibians\n" _

```
	        & "ClassAves=Birds\n" _
```

	        & "ClassChondrichthyes=Cartilaginous fishes\n" _

```
	        & "ClassMammalia=Mammmals\n" _
```
```
	        & "ClassReptilia=Reptiles\n" _
```
```
	        & "Configure=Configure\n" _
```
```
	        & "Help=Help\n" _
```

	        & "HideSettings=Hide Settings\n" _

	        & "NotActinopterygii=Not a ray-finned fish\n" _

	        & "NotAmphibia=Not an amphibian\n" _

```
	        & "NotAves=Not a bird\n" _
```

	        & "NotChondrichthyes=Not a cartilaginous fish\n" _

	        & "NotMammalia=Not a mammmal\n" _

	        & "NotReptilia=Not a reptile\n" _

	        & "OrAmbiguous=or ambiguous name\n" _

	        & "ScientificName=Scientific Name\n" _

	        & "Search=Search Wikipedia\n" _

```
	        & "Settings=Settings\n" _
```

	        & "SimultaneousTranslations=simultaneous translations\n" _

```
	        & "Translate=Translate\n" _
```

	        & "Translation=Translation\n" _

	        & "UseLocalLanguageNames=Use local language names</pre>\n\n" _

	        & "<p>Open the configuration files by clicking the <input type=""button"" class=""Button"" value=""" & objCaptions.Item( "Configure" ) & """ style=""width: 10em; height: 2em; vertical-align: middle""> button, next to the """ & objCaptions.Item( "Settings" ) & """ header.</p>\n\n" _

	        & "Change one setting at a time and examine the effect.<br>\n" _

	        & "If the result is a complete mess, just delete BirdName.cfg (and optionally BirdName.<em>lang</em>) to restore the default settings.</p>\n\n" _

	        & "&copy; 2014 Rob van der Woude<br>\n" _

	        & "<a href=""http://www.robvanderwoude.com/birdname.php"">http://www.robvanderwoude.com/birdname.php</a></p>\n"

	strHTML = Replace( strHTML, "\n", vbCrLf )

	strHTML = Replace( strHTML, "\t", vbTab  )

```
 
```
```
	On Error Resume Next
```
```
	objIE.Navigate "about:blank"
```
```
	If Err Then
```

		Set objIE = CreateObject( "InternetExplorer.Application" )

```
		objIE.Navigate "about:blank"
```
```
	End If
```
```
	On Error Goto 0
```

	objIE.Width  = objSettings.Item( "WindowWidth" )

	objIE.Height = objSettings.Item( "WindowHeight" )

	objIE.Left   = Int( ( window.screen.width  - objIE.Width  ) / 2 ) + 30

	objIE.Top    = Int( ( window.screen.height - objIE.Height ) / 2 ) + 30

```
	objIE.StatusBar  = False
```
```
	objIE.AddressBar = False
```
```
	objIE.MenuBar    = False
```
```
	objIE.ToolBar    = False
```

	objIE.Document.title = "Help for BirdName " & BirdName.Version & ", � Rob van der Woude 2014"

	objIE.Document.body.style.fontFamily = "arial,sans-serif"

	objIE.Document.body.style.fontSize = "80%"

	objIE.Document.body.InnerHTML = strHTML

```
	objIE.Visible = 1
```
```
End Sub
```
```
 
```
```
 
```
```
Sub InitialConfig( )
```
```
	objCaptions.RemoveAll
```
```
	objCaptions.Add "Version", "0.00"
```
```
	objCaptions.Add "All", "All"
```
```
	objCaptions.Add "Class", "Class"
```
```
	objCaptions.Add "ClassAll", "All"
```

	objCaptions.Add "ClassActinopterygii", "Ray-finned fishes"

	objCaptions.Add "ClassAmphibia", "Amphibians"

```
	objCaptions.Add "ClassAves", "Birds"
```

	objCaptions.Add "ClassChondrichthyes", "Cartilaginous fishes"

	objCaptions.Add "ClassMammalia", "Mammmals"

	objCaptions.Add "ClassReptilia", "Reptiles"

	objCaptions.Add "Configure", "Configure"

```
	objCaptions.Add "Help", "Help"
```

	objCaptions.Add "HideSettings", "Hide Settings"

	objCaptions.Add "NotActinopterygii", "Not a ray-finned fish"

	objCaptions.Add "NotAmphibia", "Not an amphibian"

	objCaptions.Add "NotAves", "Not a bird"

	objCaptions.Add "NotChondrichthyes", "Not a cartilaginous fish"

	objCaptions.Add "NotMammalia", "Not a mammmal"

	objCaptions.Add "NotReptilia", "Not a reptile"

	objCaptions.Add "OrAmbiguous", "or ambiguous name"

	objCaptions.Add "ScientificName", "Scientific Name"

	objCaptions.Add "Search", "Search Wikipedia"

```
	objCaptions.Add "Settings", "Settings"
```

	objCaptions.Add "SimultaneousTranslations", "simultaneous translations"

	objCaptions.Add "Translate", "Translate"

	objCaptions.Add "Translation", "Translation"

	objCaptions.Add "UseLocalLanguageNames", "Use local language names"

```
 
```
```
	objSettings.RemoveAll
```
```
	objSettings.Add "Version", "0.00"
```
```
	objSettings.Add "AutoUpdate", 0
```
```
	objSettings.Add "ConfigLanguage", ""
```

	objSettings.Add "DefaultLanguage", "en"

	objSettings.Add "LocalLanguageNames", True

```
	objSettings.Add "NumTrans", 2
```
```
	objSettings.Add "TransLang1", "nl"
```
```
	objSettings.Add "TransLang2", "de"
```
```
	objSettings.Add "TransLang3", "fr"
```
```
	objSettings.Add "TransLang4", "it"
```
```
	objSettings.Add "WindowHeight", 768
```
```
	objSettings.Add "WindowWidth", 1024
```
```
End Sub
```
```
 
```
```
 
```
```
Sub LoadConfig( )
```
```
	Dim blnError
```
```
	Dim i, intButtons
```

	Dim objCaptionsFile, objFSO, objMatches, objNewOption, objRE, objSettingsFile

	Dim strBaseName, strCaptionsFile, strCommandLine, strKey, strLine, strPrompt, strSettingsFile, strTitle, strValue

```
 
```
```
	blnError       = False
```
```
	strCommandLine = BirdName.CommandLine
```
```
 
```

	' Regular expression object to check command line arguments

```
	Set objRE = New RegExp
```
```
	objRE.Global = True
```
```
	objRE.IgnoreCase = True
```
```
 
```
```
	' Find the full path of this HTA
```

	strBaseName = Left( Self.location.pathname, Len( Self.location.pathname ) - 4 )

```
 
```

	' Check if it is accompanied by a config file

```
	strSettingsFile = strBaseName & ".cfg"
```

	Set objFSO = CreateObject( "Scripting.FileSystemObject" )

```
	With objFSO
```

		If .FileExists( strSettingsFile ) Then

			Set objSettingsFile = .OpenTextFile( strSettingsFile, ForReading, TristateFalse )

			While Not objSettingsFile.AtEndOfStream

				strLine = objSettingsFile.ReadLine( )

				strKey   = Trim( Left( strLine, InStr( strLine, "=" ) - 1 ) )

				strValue = Trim( Mid( strLine, InStr( strLine, "=" ) + 1 ) )

```
				Select Case strKey
```

					Case "AutoUpdate", "LocalLanguageNames"

						objSettings.Item( strKey ) = CBool( strValue )

						If InStr( UCase( strCommandLine ), "/" & UCase( strKey ) ) Then

							objRE.Pattern = " /" & strKey & "[\=\:](0|1)([^\d]|$)"

							Set objMatches = objRE.Execute( strCommandLine )

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

								objSettings.Item( strKey ) = CBool( objMatches.Item(0).Submatches(0) )

```
							End If
```
```
							Set objMatches = Nothing
```
```
						End if
```

					Case "ConfigLanguage", "DefaultClass", "DefaultLanguage", "TransLang1", "TransLang2", "TransLang3", "TransLang4", "Version"

						objSettings.Item( strKey ) = CStr( strValue )

						If InStr( UCase( strCommandLine ), "/" & UCase( strKey ) ) Then

							objRE.Pattern = " /" & strKey & "[\=\:]([a-z]+)"

							Set objMatches = objRE.Execute( strCommandLine )

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

								objSettings.Item( strKey ) = Trim( objMatches.Item(0).Submatches(0) )

```
							End If
```
```
							Set objMatches = Nothing
```
```
						End If
```

					Case "NumTrans", "WindowHeight", "WindowWidth"

						objSettings.Item( strKey ) = CInt( strValue )

						If InStr( UCase( strCommandLine ), "/" & UCase( strKey ) ) Then

							objRE.Pattern = " /" & strKey & "[\=\:](\d+)"

							Set objMatches = objRE.Execute( strCommandLine )

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

								objSettings.Item( strKey ) = CInt( objMatches.Item(0).Submatches(0) )

```
							End If
```
```
							Set objMatches = Nothing
```
```
						End if
```
```
					Case Else
```

						If Left( strKey, 1 ) <> ";" Then blnError = True

```
				End Select
```
```
			Wend
```
```
			objSettingsFile.Close
```
```
			Set objSettingsFile = Nothing
```
```
 
```

			If objSettings.Item( "Version" ) <> BirdName.Version And objSettings.Item( "Version" ) <> "0.00" Then

				intButtons = vbOKOnly + vbApplicationModal + vbExclamation

				strTitle   = "Old configuration file"

				strPrompt  = "The configuration file BirdName.cfg is not compatible with this version of BirdName.hta." _

```
				           & vbCrLf & vbCrLf _
```

				           & "The default configuration values will be used instead."

				MsgBox strPrompt, intButtons, strTitle

```
				InitialConfig
```
```
			End If
```
```
 
```
```
			If Not blnError Then
```

				If objSettings.Item( "ConfigLanguage" ) <> "" Then

					strCaptionsFile = strBaseName & "." & objSettings.Item( "ConfigLanguage" )

					If .FileExists( strCaptionsFile ) Then

						Set objCaptionsFile = .OpenTextFile( strCaptionsFile, ForReading, TristateFalse )

						While Not objCaptionsFile.AtEndOfStream

							strLine = objCaptionsFile.ReadLine( )

							strKey = Trim( Left( strLine, InStr( strLine, "=" ) - 1 ) )

							strValue = Trim( Mid( strLine, InStr( strLine, "=" ) + 1 ) )

```
							Select Case strKey
```

								Case "Configure", "Help", "HideSettings", "Invertebrate", "Name", "ScientificName", "Search", "Settings", "SimultaneousTranslations", "Translate", "Translation", "UseLocalLanguageNames", "Version"

									objCaptions.Item( strKey ) = strValue

								Case "Class", "ClassAll", "ClassActinopterygii", "ClassAmphibia", "ClassAves", "ClassChondrichthyes", "ClassMammalia", "ClassReptilia"

									objCaptions.Item( strKey ) = strValue

								Case "All", "Actinopterygii", "Amphibia", "Aves", "Chondrichthyes", "Mammalia", "Reptilia"

									objCaptions.Item( strKey ) = strValue

								Case "Amphibian", "Bird", "CartilaginousFish", "Mammal", "RayFinnedFish", "Reptile"

									objCaptions.Item( strKey ) = strValue

								Case "NotActinopterygii", "NotAmphibia", "NotAves", "NotChondrichthyes", "NotMammalia", "NotReptilia", "OrAmbiguous"

									objCaptions.Item( strKey ) = strValue

```
								Case Else
```

									If Left( strKey, 1 ) <> ";" Then blnError = True

```
							End Select
```
```
						Wend
```
```
						objCaptionsFile.Close
```
```
						Set objCaptionsFile = Nothing
```
```
					End If
```
```
				End If
```
```
			End If
```
```
 
```

			If objCaptions.Item( "Version" ) <> BirdName.Version And objCaptions.Item( "Version" ) <> "0.00" Then

				intButtons = vbOKOnly + vbApplicationModal + vbExclamation

				strTitle   = "Old configuration file"

				strPrompt  = "The language file BirdName." & objSettings.Item( "ConfigLanguage" ) & " is not compatible with this version of BirdName.hta." _

```
				           & vbCrLf & vbCrLf _
```

				           & "The default language, English, will be used instead."

				MsgBox strPrompt, intButtons, strTitle

```
				InitialConfig
```
```
			End If
```
```
 
```
```
			SelectNumTrans.innerHTML  = ""
```
```
			For i = 1 To 4
```

				Set objNewOption  = document.createElement( "OPTION" )

```
				objNewOption.text = i
```
```
				objNewOption.value = i
```

				If Int( objSettings.Item( "NumTrans" ) ) = i Then

```
					objNewOption.selected = True
```
```
				End If
```

				SelectNumTrans.options.Add( objNewOption )

```
			Next
```
```
 
```
```
			SelectClass.innerHTML  = ""
```

			Set objNewOption  = document.createElement( "OPTION" )

			objNewOption.text = objCaptions.Item( "All" )

```
			objNewOption.value = "All"
```

			If objSettings.Item( "DefaultClass" ) = objNewOption.value Then objNewOption.selected = True

			SelectClass.options.Add( objNewOption )

			Set objNewOption  = document.createElement( "OPTION" )

			objNewOption.text = objCaptions.Item( "ClassActinopterygii" )

			objNewOption.value = "Actinopterygii"

			If objSettings.Item( "DefaultClass" ) = objNewOption.value Then objNewOption.selected = True

			SelectClass.options.Add( objNewOption )

			Set objNewOption  = document.createElement( "OPTION" )

			objNewOption.text = objCaptions.Item( "ClassAmphibia" )

```
			objNewOption.value = "Amphibia"
```

			If objSettings.Item( "DefaultClass" ) = objNewOption.value Then objNewOption.selected = True

			SelectClass.options.Add( objNewOption )

			Set objNewOption  = document.createElement( "OPTION" )

			objNewOption.text = objCaptions.Item( "ClassAves" )

```
			objNewOption.value = "Aves"
```

			If objSettings.Item( "DefaultClass" ) = objNewOption.value Then objNewOption.selected = True

			SelectClass.options.Add( objNewOption )

			Set objNewOption  = document.createElement( "OPTION" )

			objNewOption.text = objCaptions.Item( "ClassChondrichthyes" )

			objNewOption.value = "Chondrichthyes"

			If objSettings.Item( "DefaultClass" ) = objNewOption.value Then objNewOption.selected = True

			SelectClass.options.Add( objNewOption )

			Set objNewOption  = document.createElement( "OPTION" )

			objNewOption.text = objCaptions.Item( "ClassMammalia" )

```
			objNewOption.value = "Mammalia"
```

			If objSettings.Item( "DefaultClass" ) = objNewOption.value Then objNewOption.selected = True

			SelectClass.options.Add( objNewOption )

			Set objNewOption  = document.createElement( "OPTION" )

			objNewOption.text = objCaptions.Item( "ClassReptilia" )

```
			objNewOption.value = "Reptilia"
```

			SelectClass.options.Add( objNewOption )

```
 
```

			Label_Class.innerHTML                    = objCaptions.Item( "Class" )

			Button_Configure.value                   = objCaptions.Item( "Configure" )

			Button_Help.value                        = objCaptions.Item( "Help" )

			Button_HideSettings.value                = objCaptions.Item( "HideSettings" )

			Label_ScientificName.innerHTML           = objCaptions.Item( "ScientificName" )

			Button_SearchScientificName.value        = objCaptions.Item( "Search" )

			Button_SearchTranslation1.value          = objCaptions.Item( "Search" )

			Button_SearchTranslation2.value          = objCaptions.Item( "Search" )

			Button_SearchTranslation3.value          = objCaptions.Item( "Search" )

			Button_SearchTranslation4.value          = objCaptions.Item( "Search" )

			Label_Settings.innerHTML                 = objCaptions.Item( "Settings" )

			Label_SimultaneousTranslations.innerHTML = objCaptions.Item( "SimultaneousTranslations" )

			Button_Translate.value                   = objCaptions.Item( "Translate" )

			Label_Translation1.innerHTML             = objCaptions.Item( "Translation" )

			Label_Translation2.innerHTML             = objCaptions.Item( "Translation" )

			Label_Translation3.innerHTML             = objCaptions.Item( "Translation" )

			Label_Translation4.innerHTML             = objCaptions.Item( "Translation" )

			Label_UseLocalLanguageNames.innerHTML    = objCaptions.Item( "UseLocalLanguageNames" )

			UseLocalLanguageNames.Checked            = objSettings.Item( "LocalLanguageNames" )

```
		Else
```
```
			InitialConfig
```
```
		End If
```
```
	End With
```
```
	Set objFSO = Nothing
```
```
	Set objRE  = Nothing
```
```
 
```
```
	' Resize and position window
```

	objSettings.Item( "WindowWidth" )  = Min( objSettings.Item( "WindowWidth" ), window.screen.width )

	objSettings.Item( "WindowHeight" ) = Min( objSettings.Item( "WindowHeight" ), window.screen.height )

	Self.resizeTo objSettings.Item( "WindowWidth" ), objSettings.Item( "WindowHeight" )

	Self.moveTo Int( ( window.screen.width  - objSettings.Item( "WindowWidth" ) ) / 2 ), Int( ( window.screen.height - objSettings.Item( "WindowHeight" ) ) / 2 )

```
End Sub
```
```
 
```
```
 
```
```
Function Max( num1, num2 )
```
```
	If CDbl( num1 ) > CDbl( num2 ) Then
```
```
		Max = CDbl( num1 )
```
```
	Else
```
```
		Max = CDbl( num2 )
```
```
	End If
```
```
End Function
```
```
 
```
```
 
```
```
Function Min( num1, num2 )
```
```
	If CDbl( num1 ) < CDbl( num2 ) Then
```
```
		Min = CDbl( num1 )
```
```
	Else
```
```
		Min = CDbl( num2 )
```
```
	End If
```
```
End Function
```
```
 
```
```
 
```
```
Function OSVersion( )
```
```
	Dim arrOSVer
```
```
	OSVersion = 0
```
```
	On Error Resume Next
```

	Set objWMIService = GetObject( "winmgmts://./root/cimv2" )

	Set colInstances  = objWMIService.ExecQuery( "SELECT * FROM Win32_OperatingSystem" )

```
	For Each objInstance In colInstances
```

		arrOSVer = Split( objInstance.Version, "." )

		If UBound( arrOSVer ) > 0 Then OSVersion = 100 * arrOSVer(0) + arrOSVer(1)

```
	Next
```
```
	Set colInstances  = Nothing
```
```
	Set objWMIService = Nothing
```
```
	On Error Goto 0
```
```
End Function
```
```
 
```
```
 
```
```
Sub Sleep( seconds )
```
```
	Dim strCmd
```
```
	On Error Resume Next
```

	strCmd = "%COMSPEC% /C (PING -n " & seconds & " 127.0.0.1 >NUL 2>&1 || PING -n " & seconds & " ::1 >NUL 2>&1)"

```
	wshShell.Run strCmd, 0, 1
```
```
	On Error Goto 0
```
```
End Sub
```
```
 
```
```
 
```
```
Sub Sort2Dim1( ByRef myArray, myIndex )
```

' Sort a 2-dimensional array by its specified index in the 1st dimension

```
    Dim i, j, arrHolder( 2 )
```

    For i = ( UBound( myArray, 2 ) - 1 ) to 0 Step -1

```
        For j= 0 to i
```

            If UCase( myArray( myIndex, j ) ) > UCase( myArray( myIndex, j + 1 ) ) Then

                arrHolder( 0 )      = myArray( 0, j + 1 )

                arrHolder( 1 )      = myArray( 1, j + 1 )

                arrHolder( 2 )      = myArray( 2, j + 1 )

                myArray( 0, j + 1 ) = myArray( 0, j )

                myArray( 1, j + 1 ) = myArray( 1, j )

                myArray( 2, j + 1 ) = myArray( 2, j )

                myArray( 0, j )     = arrHolder( 0 )

                myArray( 1, j )     = arrHolder( 1 )

                myArray( 2, j )     = arrHolder( 2 )

```
            End If
```
```
        Next
```
```
    Next 
```
```
End Sub
```
```
 
```
```
 
```

' Translate scientific name to specified language using WikiPedia

```
Function Translate( myLanguageCode )
```
```
	Dim objMatches, objRE
```
```
	Dim strHTML, strName, strURL
```
```
 
```

	If Trim( ScientificName.value ) = "" Then

```
		Translate = ""
```
```
		Exit Function
```
```
	End If
```
```
 
```

	' First, try the URL generated with the first scientific name

	strURL = "http://" & myLanguageCode & ".wikipedia.org/wiki/" & Und( ScientificName.value )

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

	' If the page or translation wasn't found, try the second scientific name, if available

```
	If Left( strHTML, 2 ) = "--" Then
```

		If strAlternativeScientificName = "" Then

```
			Translate = strHTML
```
```
			Exit Function
```
```
		Else
```

			strURL = "http://" & myLanguageCode & ".wikipedia.org/wiki/" & Und( strAlternativeScientificName )

```
			strHTML = WGet( strURL )
```
```
			If Left( strHTML, 2 ) = "--" Then
```
```
				Translate = strHTML
```
```
				Exit Function
```
```
			End If
```
```
		End If
```
```
	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|class)=""firstHeading"" (?:class|id)=""firstHeading""(?:[^>]*?)?>(?:[\n\r\s]*)(?:<span[^>]*>)?(.*?)(?:</span>)(?:[\n\r\s]*)?</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)

```
			If InStr( strName, "<i>" ) Then
```

				strName = Replace( strName, "<i>", "" )

				strName = Replace( strName, "</i>", "" )

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

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

	If LCase( ScientificName.value ) = LCase( strName ) Then

		objre.Pattern = "<b>([^<]+)</b> \(<i>(<b>)?" & ScientificName.value & "(</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
```

	' For english translations only: in case the page title still equals the scientific name, try an alternative search pattern

	If myLanguageCode = "en" And LCase( ScientificName.value ) = LCase( strName ) Then

		objre.Pattern = "<a href=""/wiki/Common_name"" title=""Common name"">common name</a> is (?:the )?<b>([^<]{3,45})</b>"

		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 still equals the scientific name, try yet another alternative search pattern

		If LCase( ScientificName.value ) = LCase( strName ) Then

			objre.Pattern = "is known as (?:the )?<b>([^<]{3,45})</b>"

			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
```
```
	End If
```
```
 
```
```
	Set objMatches = Nothing
```
```
	Set objRE = Nothing
```
```
	Translate = strName
```
```
End Function
```
```
 
```
```
 
```
```
Function TextFromHTML( myURL )
```
```
    Dim objHTTP
```
```
    TextFromHTML = ""
```

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

```
    objHTTP.Open "GET", myURL
```
```
    objHTTP.Send
```

    ' Check if the result was valid, and if so return the result

```
    If objHTTP.Status = 200 Then
```

    	TextFromHTML = objHTTP.ResponseText

```
    End If
```
```
    Set objHTTP = Nothing
```
```
End Function
```
```
 
```
```
 
```

' Replace spaces by underscores to create URL

```
Function Und( myString )
```
```
	Und = Replace( myString, " ", "_" )
```
```
End Function
```
```
 
```
```
 
```
```
Sub Update( )
```
```
	Dim blnAccess, blnCreate, blnOverwrite
```
```
	Dim objFSO, objHTAFile, objShell
```
```
	Dim strHTAFile
```
```
 
```
```
	blnCreate = True
```
```
	blnOverwrite = True
```
```
	strHTAFile = Self.location.pathname
```

	Set objFSO   = CreateObject( "Scripting.FileSystemObject" )

```
	'On Error Resume Next
```
```
	With objFSO
```

		Set objHTAFile = .GetFile( strHTAFile )

		objHTAFile.Copy Left( strHTAFile, Len( strHTAFile ) - 4 ) & ".bak." & CStr( 10000 * Hour( Now ) + 100 * Minute( Now ) + Second( Now ) ), blnOverwrite

```
		If Err Then
```
```
			blnAccess = False
```
```
		Else
```
```
			blnAccess = True
```
```
		End If
```
```
		Set objHTAFile = Nothing
```
```
		WGetSource
```
```
		Self.location.reload( True )
```
```
	End With
```
```
	On Error Goto 0
```
```
	Set objFSO   = Nothing
```

	' If we could not access the HTA to update it, we will retry with elevated privileges

```
	If Not blnAccess Then
```

		If InStr( BirdName.CommandLine, " /Update" ) Then

			MsgBox "The automatic update failed: no access.", vbOKOnly + vbApplicationModal + vbExclamation, "Automatic update failed"

```
		Else
```
```
			If OSVersion > 599 Then
```

				Set objShell = CreateObject( "Shell.Application" )

				objShell.ShellExecute BirdName.CommandLine & " /Update", "", "runas", 1

```
				Set objShell = Nothing
```
```
			Else
```
```
				MsgBox "Update failed, no access."
```
```
			End If
```
```
		End If
```
```
	End If
```
```
End Sub
```
```
 
```
```
 
```
```
' 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
```
```
 
```
```
 
```

' Read the HTA source code from the web page and overwrite this HTA itself

```
Sub WGetSource(  )
```
```
	Dim intAnswer, intButtons
```
```
	Dim objADODB, objHTTP, objRE
```

	Dim strHTA, strPrompt, strText, strTitle, strURL

```
 
```
```
	Const adTypeBinary          = 1
```
```
	Const adTypeText            = 2
```
```
	Const adSaveCreateNotExist  = 1
```
```
	Const adSaveCreateOverWrite = 2
```
```
 
```

	strURL  = "http://www.robvanderwoude.com/files/birdname_hta.txt"

```
	strHTA  = Self.location.pathname
```
```
	strText = ""
```
```
 
```

	Set objADODB = CreateObject( "ADODB.Stream" )

```
	Set objRE    = New RegExp
```
```
 
```

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

```
	objHTTP.Open "GET", strURL
```
```
	objHTTP.Send
```
```
	If objHTTP.Status = 200 Then
```
```
		strText = objHTTP.ResponseText
```
```
	End If
```
```
	Set objHTTP = Nothing
```
```
 
```

	If InStr( strText, "APPLICATIONNAME=""BirdName""" ) Then

		' Use ADODB stream to convert to and save as ASCII

```
		With objADODB
```
```
			.Open
```
```
			.Type = adTypeText
```
```
			.CharSet = "us-ascii"
```
```
			.WriteText strText
```

			.SaveToFile strHTA, adSaveCreateOverWrite

```
			.Close
```
```
		End With
```
```
	Else
```

		intButtons = vbYesNoCancel + vbApplicationModal + vbInformation

		strTitle   = "Automatic update failed"

		strPrompt  = "The automatic update of BirdName.hta failed." & vbCrLf & vbCrLf & "Do you want to download the latest official release now?"

		intAnswer  = MsgBox( strPrompt, intButtons, strTitle )

```
		If intAnswer = vbYes Then
```

			wshShell.Run "http://www.robvanderwoude.com/birdname.php", 3, False

```
		End If
```
```
	End If
```
```
 
```
```
	Set objADODB = Nothing
```
```
	Set objHTTP  = Nothing
```
```
	Set objRE    = Nothing
```
```
End Sub
```
```
 
```
```
 
```
```
' Event triggered subroutines
```
```
 
```
```
 
```
```
Sub Window_OnLoad( )
```

	window.document.title = "BirdName " & BirdName.Version & ", � Rob van der Woude 2014"

```
	LoadConfig
```
```
	If GetLanguageList( ) Then
```
```
		OnClick_UseLocalLanguageNames
```
```
		OnChange_SelectNumTrans
```

		setTimeout "CheckUpdate", 500, "VBScript"

		If InStr( BirdName.CommandLine, "/?" ) Then HelpMsg

```
	Else
```
```
		Self.close
```
```
	End If
```
```
End Sub
```
```
 
```
```
 
```
```
Sub Window_OnUnload( )
```
```
	On Error Resume Next
```
```
	objIE.Quit
```
```
	Set objIE       = Nothing
```
```
	Set objFSO      = Nothing
```
```
	Set objCaptions = Nothing
```
```
	Set objSettings = Nothing
```
```
	Set wshShell    = Nothing
```
```
	On Error Goto 0
```
```
End Sub
```
```
 
```
```
 
```
```
Sub OnChange_ScientificName( )
```
```
	ClearTranslations
```

	If Not Button_SearchScientificName.disabled Then

		If Trim( ScientificName.value ) <> "" And Left( LCase( Trim( ScientificName.value ) ), 11 ) <> "--not found" Then

```
			SpeciesInput.value = ""
```

			Button_SearchScientificName.disabled = False

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

	If Trim( SpeciesInput.value & ScientificName.value ) = "" Then

```
		Button_Clear.disabled     = True
```
```
		Button_Translate.disabled = True
```
```
	Else
```
```
		Button_Clear.disabled     = False
```
```
		Button_Translate.disabled = False
```
```
	End If
```

	If Trim( ScientificName.value ) = "" Then

		Button_SearchScientificName.disabled = True

```
	Else
```

		Button_SearchScientificName.disabled = False

		' Start translating when Enter key is pressed

		If window.event.Keycode = 13 Then OnClick_ButtonTranslate

```
	End If
```
```
End Sub
```
```
 
```
```
 
```
```
Sub OnChange_SelectSourceLanguage( )
```

	objSettings.Item( "DefaultLanguage" ) = SelectSourceLanguage.value

```
End Sub
```
```
 
```
```
 
```
```
Sub OnChange_SelectTargetLanguage1( )
```
```
	Translation1.value = ""
```

	objSettings.Item( "TransLang1" ) = SelectTargetLanguage1.value

```
End Sub
```
```
 
```
```
 
```
```
Sub OnChange_SelectTargetLanguage2( )
```
```
	Translation2.value = ""
```

	objSettings.Item( "TransLang2" ) = SelectTargetLanguage2.value

```
End Sub
```
```
 
```
```
 
```
```
Sub OnChange_SelectTargetLanguage3( )
```
```
	Translation3.value = ""
```

	objSettings.Item( "TransLang3" ) = SelectTargetLanguage3.value

```
End Sub
```
```
 
```
```
 
```
```
Sub OnChange_SelectTargetLanguage4( )
```
```
	Translation4.value = ""
```

	objSettings.Item( "TransLang4" ) = SelectTargetLanguage4.value

```
End Sub
```
```
 
```
```
 
```
```
Sub OnChange_SelectClass( )
```
```
	ScientificName.value = ""
```

	Button_SearchScientificName.disabled = True

```
	ClearTranslations
```
```
	SpeciesInput.Focus
```
```
End Sub
```
```
 
```
```
 
```
```
Sub OnChange_SelectNumTrans( )
```
```
	Dim i, intNumTrans, objNewOption
```
```
	If SelectNumTrans.value = "" Then
```
```
		SelectNumTrans.innerHTML  = ""
```
```
		For i = 1 To 4
```

			Set objNewOption  = document.createElement( "OPTION" )

```
			objNewOption.text = i
```
```
			objNewOption.value = i
```

			If Int( objSettings.Item( "NumTrans" ) ) = i Then

```
				objNewOption.selected = True
```
```
			End If
```

			SelectNumTrans.options.Add( objNewOption )

```
		Next
```
```
	End If
```
```
	intNumTrans = SelectNumTrans.value
```

	TranslationBlock2.style.display = "none"

	TranslationBlock3.style.display = "none"

	TranslationBlock4.style.display = "none"

```
	If intNumTrans = 1 Then
```
```
		Label_Trans1.style.display = "none"
```
```
	Else
```
```
		Label_Trans1.style.display = "inline"
```
```
	End If
```

	If intNumTrans > 1 Then TranslationBlock2.style.display = "block"

	If intNumTrans > 2 Then TranslationBlock3.style.display = "block"

	If intNumTrans > 3 Then TranslationBlock4.style.display = "block"

```
End Sub
```
```
 
```
```
 
```
```
Sub OnChange_SpeciesInput( )
```
```
	ClearTranslations
```

	If Trim( SpeciesInput.value ) <> "" Then

```
		ScientificName.value = ""
```
```
	End If
```

	If Trim( SpeciesInput.value & ScientificName.value ) = "" Then

```
		Button_Clear.disabled     = True
```
```
		Button_Translate.disabled = True
```
```
	Else
```
```
		Button_Clear.disabled     = False
```
```
		Button_Translate.disabled = False
```
```
	End If
```

	If Trim( SpeciesInput.value ) = "" Then

```
		Button_Translate.disabled = True
```
```
	Else
```
```
		Button_Translate.disabled = False
```

		' Start translating when Enter key is pressed

		If window.event.Keycode = 13 Then OnClick_ButtonTranslate

```
	End If
```

	If Trim( ScientificName.value ) = "" Then

		Button_SearchScientificName.disabled = True

```
	Else
```

		Button_SearchScientificName.disabled = False

```
	End If
```
```
End Sub
```
```
 
```
```
 
```
```
Sub OnClick_ButtonClear( )
```
```
	ScientificName.value = ""
```
```
	SpeciesInput.value  = ""
```
```
	OnChange_SpeciesInput
```
```
	SpeciesInput.Focus
```
```
End Sub
```
```
 
```
```
 
```
```
Sub OnClick_ButtonConfigure( )
```
```
	Dim strBaseName
```

	strBaseName = Left( Self.location.pathname, Len( Self.location.pathname ) - 4 )

	wshShell.Run "notepad.exe " & strBaseName & ".cfg", 5, True

```
	LoadConfig
```

	wshShell.Run "notepad.exe " & strBaseName & "." & objSettings.Item( "ConfigLanguage" ), 5, True

```
	Self.location.reload True
```
```
End Sub
```
```
 
```
```
 
```
```
Sub OnClick_ButtonDownload( )
```

	wshShell.Run "http://www.robvanderwoude.com/birdname.php"

```
End Sub
```
```
 
```
```
 
```
```
Sub OnClick_ButtonHideSettings( )
```
```
	SettingsBlock.style.display = "none"
```
```
End Sub
```
```
 
```
```
 
```

Sub OnClick_ButtonSearchScientificName( )

	wshshell.Run "http://" & SelectSourceLanguage.value & ".wikipedia.org/wiki/" & Cap( Und( SpeciesInput.value ) )

```
End Sub
```
```
 
```
```
 
```
```
Sub OnClick_ButtonSearchTranslation1( )
```

	If Translation1.value = "" Or Left( LCase( Trim( Translation1.value ) ), 2 ) = "--" Then

		wshshell.Run "http://" & SelectTargetLanguage1.value & ".wikipedia.org/wiki/" & Und( ScientificName.value )

```
	Else
```

		wshshell.Run "http://" & SelectTargetLanguage1.value & ".wikipedia.org/wiki/" & Und( Translation1.value )

```
	End If
```
```
End Sub
```
```
 
```
```
 
```
```
Sub OnClick_ButtonSearchTranslation2( )
```

	If Translation2.value = "" Or Left( LCase( Trim( Translation2.value ) ), 2 ) = "--" Then

		wshshell.Run "http://" & SelectTargetLanguage2.value & ".wikipedia.org/wiki/" & Und( ScientificName.value )

```
	Else
```

		wshshell.Run "http://" & SelectTargetLanguage2.value & ".wikipedia.org/wiki/" & Und( Translation2.value )

```
	End If
```
```
End Sub
```
```
 
```
```
 
```
```
Sub OnClick_ButtonSearchTranslation3( )
```

	If Translation3.value = "" Or Left( LCase( Trim( Translation3.value ) ), 2 ) = "--" Then

		wshshell.Run "http://" & SelectTargetLanguage3.value & ".wikipedia.org/wiki/" & Und( ScientificName.value )

```
	Else
```

		wshshell.Run "http://" & SelectTargetLanguage3.value & ".wikipedia.org/wiki/" & Und( Translation3.value )

```
	End If
```
```
End Sub
```
```
 
```
```
 
```
```
Sub OnClick_ButtonSearchTranslation4( )
```

	If Translation4.value = "" Or Left( LCase( Trim( Translation4.value ) ), 2 ) = "--" Then

		wshshell.Run "http://" & SelectTargetLanguage4.value & ".wikipedia.org/wiki/" & Und( ScientificName.value )

```
	Else
```

		wshshell.Run "http://" & SelectTargetLanguage4.value & ".wikipedia.org/wiki/" & Und( Translation4.value )

```
	End If
```
```
End Sub
```
```
 
```
```
 
```
```
Sub OnClick_ButtonTranslate( )
```
```
	ClearTranslations
```

	Button_SearchScientificName.disabled = True

	If Trim( SpeciesInput.value ) = "" Then

		ScientificName.value = Cap( ScientificName.value )

		SpeciesInput.value = Translate( objSettings.Item( "DefaultLanguage" ) )

```
	Else
```
```
		ScientificName.value = ""
```
```
		GetScientificName
```
```
	End If
```

	Button_SearchScientificName.disabled = False

	If ScientificName.value <> "" And Left( LCase( Trim( ScientificName.value ) ), 2 ) <> "--" Then

		Translation1.value = Translate( objSettings.Item( "TransLang1" ) )

		Button_SearchTranslation1.disabled = False

		If Left( LCase( Trim( Translation1.value ) ), 2 ) = "--" Then

```
			Translation1.style.color = "red"
```
```
		Else
```
```
			Translation1.style.color = "black"
```
```
		End If
```
```
		If SelectNumTrans.value > 1 Then
```

			Translation2.value = Translate( objSettings.Item( "TransLang2" ) )

			Button_SearchTranslation2.disabled = False

			If Left( LCase( Trim( Translation2.value ) ), 2 ) = "--" Then

```
				Translation2.style.color = "red"
```
```
			Else
```
```
				Translation2.style.color = "black"
```
```
			End If
```
```
		End If
```
```
		If SelectNumTrans.value > 2 Then
```

			Translation3.value = Translate( objSettings.Item( "TransLang3" ) )

			Button_SearchTranslation3.disabled = False

			If Left( LCase( Trim( Translation3.value ) ), 2 ) = "--" Then

```
				Translation3.style.color = "red"
```
```
			Else
```
```
				Translation3.style.color = "black"
```
```
			End If
```
```
		End If
```
```
		If SelectNumTrans.value > 3 Then
```

			Translation4.value = Translate( objSettings.Item( "TransLang4" ) )

			Button_SearchTranslation4.disabled = False

			If Left( LCase( Trim( Translation4.value ) ), 2 ) = "--" Then

```
				Translation4.style.color = "red"
```
```
			Else
```
```
				Translation4.style.color = "black"
```
```
			End If
```
```
		End If
```
```
	End If
```

	If Left( LCase( Trim( SpeciesInput.value ) ), 2 ) = "--" Then

```
		SpeciesInput.style.color = "red"
```
```
	Else
```
```
		SpeciesInput.style.color = "black"
```
```
	End If
```

	If Left( LCase( Trim( ScientificName.value ) ), 2 ) = "--" Then

```
		ScientificName.style.color = "red"
```
```
	Else
```
```
		ScientificName.style.color = "black"
```
```
	End If
```
```
End Sub
```
```
 
```
```
 
```
```
Sub OnClick_ButtonUpdate( )
```
```
	Dim strMsg, strQuote, strTitle
```
```
 
```
```
	Const vbCancel = 2
```
```
	Const vbYes    = 6
```
```
	Const vbNo     = 7
```
```
 
```

	If Left( BirdName.Version, 1 ) = "0" Then strQuote = Chr(34)

	strMsg   = "You are about to update the running BirdName program to its latest " & strQuote & "stable" & strQuote & " release." & vbCrLf _

	         & "A copy of the program will be saved, allowing a roll-back if necessary." & vbCrLf & vbCrLf

	If Left( BirdName.Version, 4 ) < "0.30" Then

		strMsg = strMsg & "The update to version " & BirdName.Version & " will render previous configuration files useless." & vbCrLf & vbCrLf

```
	End If
```

	strMsg   = strMsg & "Do you want to update now?"

```
	strTitle = "Confirm Update"
```

	If MsgBox( strMsg, vbYesNoCancel, strTitle ) = vbYes Then Update

```
End Sub
```
```
 
```
```
 
```
```
Sub OnClick_UseLocalLanguageNames( )
```
```
	Dim i, intIndex, objNewOption
```

	blnUseLocalLanguageNames = UseLocalLanguageNames.Checked

```
	If blnUseLocalLanguageNames Then
```
```
		intIndex = 1
```
```
	Else
```
```
		intIndex = 2
```
```
	End If
```
```
	Sort2Dim1 arrLang, intIndex
```
```
 
```
```
	SelectSourceLanguage.innerHTML  = ""
```
```
	For i = 0 To UBound( arrLang, 2 )
```

		Set objNewOption  = document.createElement( "OPTION" )

		objNewOption.text = arrLang( intIndex, i )

```
		objNewOption.value = arrLang( 0, i )
```

		objNewOption.title = arrLang( 3 - intIndex, i )

		If UCase( objSettings.Item( "DefaultLanguage" ) ) = UCase( arrLang( 0, i ) ) Then

```
			objNewOption.selected = True
```
```
		End If
```

		SelectSourceLanguage.options.Add( objNewOption )

```
	Next
```
```
 
```
```
	SelectTargetLanguage1.innerHTML = ""
```
```
	For i = 0 To UBound( arrLang, 2 )
```

		Set objNewOption  = document.createElement( "OPTION" )

		objNewOption.text = arrLang( intIndex, i )

```
		objNewOption.value = arrLang( 0, i )
```

		objNewOption.title = arrLang( 3 - intIndex, i )

		If UCase( objSettings.Item( "TransLang1" ) ) = UCase( arrLang( 0, i ) ) Then

```
			objNewOption.selected = True
```
```
		End If
```

		SelectTargetLanguage1.options.Add( objNewOption )

```
	Next
```
```
 
```
```
	SelectTargetLanguage2.innerHTML = ""
```
```
	For i = 0 To UBound( arrLang, 2 )
```

		Set objNewOption  = document.createElement( "OPTION" )

		objNewOption.text = arrLang( intIndex, i )

```
		objNewOption.value = arrLang( 0, i )
```

		objNewOption.title = arrLang( 3 - intIndex, i )

		If UCase( objSettings.Item( "TransLang2" ) ) = UCase( arrLang( 0, i ) ) Then

```
			objNewOption.selected = True
```
```
		End If
```

		SelectTargetLanguage2.options.Add( objNewOption )

```
	Next
```
```
 
```
```
	SelectTargetLanguage3.innerHTML = ""
```
```
	For i = 0 To UBound( arrLang, 2 )
```

		Set objNewOption  = document.createElement( "OPTION" )

		objNewOption.text = arrLang( intIndex, i )

```
		objNewOption.value = arrLang( 0, i )
```

		objNewOption.title = arrLang( 3 - intIndex, i )

		If UCase( objSettings.Item( "TransLang3" ) ) = UCase( arrLang( 0, i ) ) Then

```
			objNewOption.selected = True
```
```
		End If
```

		SelectTargetLanguage3.options.Add( objNewOption )

```
	Next
```
```
 
```
```
	SelectTargetLanguage4.innerHTML = ""
```
```
	For i = 0 To UBound( arrLang, 2 )
```

		Set objNewOption  = document.createElement( "OPTION" )

		objNewOption.text = arrLang( intIndex, i )

```
		objNewOption.value = arrLang( 0, i )
```

		objNewOption.title = arrLang( 3 - intIndex, i )

		If UCase( objSettings.Item( "TransLang4" ) ) = UCase( arrLang( 0, i ) ) Then

```
			objNewOption.selected = True
```
```
		End If
```

		SelectTargetLanguage4.options.Add( objNewOption )

```
	Next
```
```
End Sub
```