User:Qbugbot/source

' frmMain.vb, by Robert Webster (CC BY-SA 3.0 US)

'

' simple form, with 5 buttons:

' - cmdList: Read a list of taxa from a text file and make pages for them.

' - cmdRandom: Make a set of pages for random taxa.

' - cmdUpdate: Update a set of pages for random taxa (qbugbot 3).

' - cmdRedir: Fix recursive redircets (qbugbot 4).

' - cmdEtc: page for various utility functions.

' mysql connection.net: nuget console> Install-Package MySql.Data -Version 8.0.13

' database is MariaDB.

Imports System.Net

Imports System.Net.Http

Imports System.Text

Imports System.Text.RegularExpressions

Imports System.Collections.Generic

Imports System.Math

Imports System.IO

Imports System.Data

Imports MySql.Data.MySqlClient

Imports Newtonsoft.Json

Imports Newtonsoft.Json.Linq

Public Class frmMain

Dim pagesMade As New List(Of String)

Dim nPagesSent, maxPagesSent As Integer

Dim clock As New Stopwatch

Dim madePage As New StringBuilder ' pages most recently created, same format as tmp file.

Sub qlogout(url As String)

' logout of a wiki

Dim parms As Dictionary(Of String, String)

Dim r1 As HttpResponseMessage

Dim qcontent As FormUrlEncodedContent

Dim s As String

parms = New Dictionary(Of String, String)

parms.Add("action", "logout")

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(url, qcontent).Result

s = r1.Content.ReadAsStringAsync().Result

End Sub

Function qlogin(url As String) As String

Dim parms As Dictionary(Of String, String)

Dim r1 As HttpResponseMessage

Dim qcontent As FormUrlEncodedContent

Dim json As JObject

Dim token As String

Dim s As String

Dim s1 As String

parms = New Dictionary(Of String, String)

parms.Add("action", "query")

parms.Add("meta", "tokens")

parms.Add("type", "login")

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(url, qcontent).Result

s = r1.Content.ReadAsStringAsync().Result

json = JObject.Parse(s)

token = json.SelectToken("query").SelectToken("tokens").SelectToken("logintoken")

parms = New Dictionary(Of String, String)

parms.Add("action", "login")

If url = urlWikiPedia Then

parms.Add("lgname", My.Settings.qlgname)

parms.Add("lgpassword", My.Settings.qlgpassword)

End If

parms.Add("lgtoken", token)

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(url, qcontent).Result

s = r1.Content.ReadAsStringAsync().Result

json = JObject.Parse(s)

s1 = json("login").SelectToken("result").ToString

If s1 = "Success" Then

Return s1

Else

Return s

End If

End Function

Private Sub frmMain_Shown(sender As Object, e As EventArgs) Handles Me.Shown

' necessary to handle cookies

cookies = New CookieContainer

handler = New HttpClientHandler

handler.CookieContainer = cookies

qClient = New HttpClient(handler) ' need this for cookies

End Sub

Function gettoken(url) As String

' get a token, required for upload or edit

' uses httpClient

Dim parms As Dictionary(Of String, String)

Dim r1 As HttpResponseMessage

Dim qcontent As FormUrlEncodedContent

Dim json As JObject

Dim s As String

parms = New Dictionary(Of String, String)

parms.Add("action", "query")

parms.Add("meta", "tokens")

parms.Add("type", "csrf")

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(url, qcontent).Result

s = r1.Content.ReadAsStringAsync().Result

json = JObject.Parse(s)

sToken = json.SelectToken("query.tokens.csrftoken")

Return sToken

End Function

Function fixHodges(descr As String) As String

' change "common name - Hodges #2453" to "common name (Hodges 2453)

' returns original if no "Hodges"

Dim s1 As String

Dim rMatch As RegularExpressions.Match

If Not LCase(descr).Contains("hodges") Then Return descr

If LCase(descr).StartsWith("hodges") Then

Return ""

Else

rMatch = Regex.Match(descr, "(.+) - Hodges (#\d+)")

If rMatch.Groups.Count = 3 Then

s1 = rMatch.Groups(1).ToString & " (Hodges " & rMatch.Groups(2).ToString & ")"

Return s1

Else

Return descr

End If

End If

End Function

Function wikiCaption(tMatch As taxrec, shortForm As Boolean) As String

' get a caption for a photo

Dim descr As String

Dim tax As String

tax = tMatch.taxon

descr = ""

If tMatch.commonNames.Count > 0 Then descr = tMatch.commonNames(0)

descr = fixHodges(descr)

If eqstr(tMatch.rank, "genus") Or eqstr(tMatch.rank, "species") Or

eqstr(tMatch.rank, "subspecies") Then tax = "" & tax & ""

If descr <> "" Then

descr = descr & ", " & tax

descr = UCase(descr.Substring(0, 1)) & descr.Substring(1)

End If

Return descr

End Function

Function sendWikiPage(pageTitle As String, content As String, url As String, editSummary As String,

sendingMode As Integer) As String

' transmit a page to a wiki.

' sendingmode 2 = update, 1 = create, 0 = don't send

Dim k As Integer

Dim s As String

Dim s1 As String = ""

Dim pageID As Integer

Dim sandBox As Boolean

Dim valid As Boolean

Dim r1 As HttpResponseMessage

Dim qcontent As FormUrlEncodedContent

Dim parms As Dictionary(Of String, String)

Dim minInterval As Integer = 10000 ' 10 seconds between edits

Dim jq As New JObject

Dim jt As JToken = Nothing

sandBox = True

If sendingMode = 0 Then Return "0"

For i As Integer = 1 To 10

k = clock.ElapsedMilliseconds

If k > 0 And k < minInterval Then Threading.Thread.Sleep(minInterval - k)

clock.Restart()

pageID = getPageID(pageTitle, url)

If pageID > 0 And (sendingMode = 1 And Not sandBox) Then

outLog(pageTitle & " exists. Not sent.")

Return ""

End If

parms = New Dictionary(Of String, String)

parms.Add("action", "edit")

If sandBox Then

parms.Add("title", "User:Edibobb/sandbox")

Else

parms.Add("title", pageTitle)

End If

parms.Add("text", content)

parms.Add("bot", "true")

parms.Add("maxlag", "5")

parms.Add("format", "json")

parms.Add("summary", editSummary)

parms.Add("token", sToken)

Try

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(url, qcontent).Result

s = ""

s = r1.Content.ReadAsStringAsync().Result

jq = JObject.Parse(s)

valid = jq.TryGetValue("edit", jt)

If valid Then Exit For

Catch ex As Exception

s1 = ex.Message

outLog("send error 1, " & pageTitle & ", " & s1 & ".")

Exit For

End Try

If jq.TryGetValue("error", jt) Then

s1 = jt("code").ToString

If Not eqstr(s1, "maxlag") Then

outLog("send error 2, " & pageTitle & ", " & s1 & ".")

End If

End If

Next i

If valid Then

If Not eqstr(jt("result").ToString, "success") Then Stop

s1 = jt("result").ToString

If jt("nochange") IsNot Nothing Then

outLog("Identical Page Exists, " & pageTitle & ".")

Return ""

Else

Try

s1 = jt("result").ToString & ", " & jt("pageid").ToString & ", " &

jt("newtimestamp").ToString & ", " & jt("title").ToString

Catch ex As Exception

s1 = "Send error 3, " & ex.Message & " " & s1

End Try

outLog("sent " & pageTitle & ", " & s1 & ".")

End If

Else

outLog("send failed, " & pageTitle & ", " & s1 & ".")

Return ""

End If

s = jt("pageid").ToString

Return s

End Function

Function extinctRange(tmatch As taxrec) As String

Dim prec As paleorec

Dim s1 As String = ""

' get paleo record

prec = getPaleo(tmatch)

If prec.earlyinterval <> "" Then s1 = "| oldest_fossil = " & prec.earlyinterval

If prec.lateinterval <> "" Then s1 &= "| youngest_fossil = " & prec.lateinterval

Return s1

End Function

Sub getDescr(tMatch As taxrec, ancestor As List(Of taxrec),

ByRef descr As String, ByRef upperRank As String, ByRef upperTax As String, ByRef commonWikiLink As String)

' returns descr, something like "beetles", and upperRank and upperTax, something like "Order", "Coleoptera".

' ancestors must have addons

Dim k As Integer

descr = ""

commonWikiLink = ""

upperRank = ""

upperTax = ""

If itisRankID(tMatch.rank) <= 180 Then k = 0 Else k = 2

For i1 As Integer = k To ancestor.Count - 1 ' skip current and next rank except for genus and above

If ancestor(i1).commonNames.Count > 0 Then

If itisRankID(tMatch.rank) < 220 OrElse (Not ancestor(i1).commonNames(0).Contains(" and ")) Then

descr = ancestor(i1).commonNames(0) ' common name for higher rank

commonWikiLink = ancestor(i1).commonWikiLink

Exit For

End If

End If

Next i1

' special cases

'If descr = "insects" AndAlso isAncestor(ancestor, "lepidoptera", 0) AndAlso

If itisRankID(tMatch.rank) <= 130 AndAlso isAncestor(ancestor, "lepidoptera", 0) AndAlso

descr.Contains(" and ") AndAlso

Not isAncestor(ancestor, "Papilionoidea", 0) Then descr = "moth" ' no superfamily or family name for some moths.

If isAncestor(ancestor, "Blattodea", 0) Then

If isAncestor(ancestor, "Termitoidae", 0) Then descr = "termites" Else descr = "cockroach"

End If

' select family, order, or class

For i1 As Integer = 1 To ancestor.Count - 1

Select Case LCase(ancestor(i1).rank)

Case "family"

upperRank = "family"

upperTax = ancestor(i1).taxon

Exit For

Case "order"

upperRank = "order"

upperTax = ancestor(i1).taxon

Exit For

Case "class"

upperRank = "class"

upperTax = ancestor(i1).taxon

Exit For

End Select

Next i1

End Sub

Function formatAncestors(tMatch As taxrec, ancestor As List(Of taxrec), dbAllowed As Integer) As String

' returns name and rank of a popular common ancestor, or generic "species" name.

' for example:

' "Psammodiini is a tribe of aphodiine dung beetles in the family Scarabaeidae.

' There are about 12 genera and at least 50 described species in Psammodiini."

Dim ss As List(Of String)

Dim sq As List(Of String)

Dim s As String

Dim s1, s2 As String

Dim descr As String = ""

Dim upperTax As String = ""

Dim upperRank As String = ""

Dim commonWikiLink As String = ""

Dim children As New List(Of taxrec)

Dim species As New List(Of taxrec)

Dim rmatch As RegularExpressions.Match

Dim sTaxon As String

Dim qualifier As String

Dim childCount, speciesCount As Integer

Dim sChildCount, sSpeciesCount As String

Dim verb As String

Dim firstChild As String

Dim genCommon As String

Dim m As taxrec

getDescr(tMatch, ancestor, descr, upperRank, upperTax, commonWikiLink)

If upperRank <> "" Then ' OK to use good english

' gencommon is a general common name: Argia is a genus of dancers in the DAMSELFLY family Coenagrionidae

s2 = ""

genCommon = ""

m = Nothing

If tMatch.commonNames IsNot Nothing AndAlso tMatch.commonNames.Count > 0 Then s2 = LCase(tMatch.commonNames(0))

If isAncestor(ancestor, "Zygoptera", 0) AndAlso

Not s2.Contains("damselfl") AndAlso Not descr.Contains("damselfl") Then

genCommon = "damselfly"

m = getAncestor(ancestor, "Zygoptera", 0)

ElseIf isAncestor(ancestor, "Anisoptera", 0) AndAlso

Not s2.Contains("dragonfl") AndAlso Not descr.Contains("dragonfl") Then

genCommon = "dragonfly"

m = getAncestor(ancestor, "Anisoptera", 0)

ElseIf isAncestor(ancestor, "Coleoptera", 0) AndAlso

Not s2.Contains("beetle") AndAlso Not descr.Contains("beetle") Then

genCommon = "beetle"

m = getAncestor(ancestor, "Coleoptera", 0)

ElseIf isAncestor(ancestor, "Papilionoidea", 0) AndAlso

Not s2.Contains("butterfl") AndAlso Not descr.Contains("butterfl") Then

genCommon = "butterfly"

m = getAncestor(ancestor, "Papilionoidea", 0)

ElseIf isAncestor(ancestor, "Lepidoptera", 0) AndAlso Not isAncestor(ancestor, "Papilionoidea", 0) AndAlso

Not s2.Contains("moth") AndAlso Not descr.Contains("moth") Then

genCommon = "moth"

m = getAncestor(ancestor, "Lepidoptera", 0)

ElseIf isAncestor(ancestor, "Araneae", 0) AndAlso

Not s2.Contains("spider") AndAlso Not descr.Contains("spider") Then

genCommon = "spider"

m = getAncestor(ancestor, "Araneae", 0)

End If

If m IsNot Nothing Then

If m.rank <> upperRank Then genCommon = "" & genCommon & ""

genCommon &= " "

End If

' If s1 <> "" Then genCommon = " of " & s1 & " known as"

' bold common names

ss = New List(Of String)

If tMatch.commonNames IsNot Nothing Then ss.AddRange(tMatch.commonNames)

For i As Integer = ss.Count - 1 To 0 Step -1

ss(i) = "" & ss(i) & ""

Next i

If "aeiou".Contains(LCase(tMatch.rank).Substring(0, 1)) Then verb = " is an " Else verb = " is a "

If tMatch.extinct Then verb = " is an extinct "

If eqstr(tMatch.rank, "species") Or eqstr(tMatch.rank, "subspecies") Then

' make description list singular, if necessary

' 2/3/18 - only change a list of two or a single item to be singular

If Not descr.Contains(",") Then

descr = descr.Replace(" and ", ",")

sq = descr.Split(",").ToList

For i1 As Integer = 0 To sq.Count - 1

sq(i1) = singular(sq(i1).Trim)

Next i1

descr = formatList(sq, "or")

descr = descr.Replace(" or the ", " or ")

End If

If commonWikiLink <> "" Then

If descr = commonWikiLink Then

descr = "" & descr & ""

Else

descr = "" & descr & ""

End If

End If

If ss.Count = 0 Then

If descr <> "" Then

s = verb & LCase(tMatch.rank) & " of " & descr & " in the " & genCommon & upperRank & " " & upperTax & "."

Else

s = verb & LCase(tMatch.rank) & " in the " & genCommon & upperRank & " " & upperTax & "."

End If

ElseIf ss.Count = 1 Then

rmatch = Regex.Match(ss(0), "[a-z]\'s")

If rmatch.Value = "" Then rmatch = Regex.Match(ss(0), "^[A-Za-z -]+?s\' ")

If rmatch.Value <> "" OrElse ss(0).StartsWith("'''the") Then

s1 = ", or "

Else

s1 = ", the " ' use "or" for possessive names, or if there's a "the" in descr

End If

s = s1 & ss(0) & "," & verb & LCase(tMatch.rank) & " of " & descr & " in the " & genCommon & upperRank & " " & upperTax & "."

ElseIf ss.Count = 2 Then

s1 = formatList(ss, "or")

If Not s1.StartsWith("'''the") Then s1 = "the " & s1

s = ", known generally as " & s1 & "," & verb & LCase(tMatch.rank) & " of " & descr & " in the " & genCommon & upperRank & " " & upperTax & "."

Else

s = ", known generally as " & ss(0) & "," & verb & LCase(tMatch.rank) & " of " & descr & " in the " & genCommon & upperRank & " " & upperTax & "."

ss.RemoveAt(0)

s1 = formatList(ss, "and")

If Not s1.StartsWith("'''the") Then s1 = "the " & s1

s &= " Other common names include " & s1 & "."

End If

Return s ' species and subspecies

Else ' genus or higher

descr = descr.Replace(" and the ", " and ")

If Not descr.Contains(",") And Not descr.Contains(" and ") And Not descr.Contains(" or ") Then

' check for wikilink

If commonWikiLink <> "" Then

If descr.StartsWith(commonWikiLink) AndAlso descr.Length - commonWikiLink.Length <= 3 Then

descr = "" & commonWikiLink & "" & descr.Substring(commonWikiLink.Length)

Else

descr = "" & descr & ""

End If

End If

End If

s = verb & LCase(tMatch.rank) & " of " & descr & " in the " & genCommon & upperRank & " " & upperTax & "."

' count and round descendants, 2 significant digits

sTaxon = tMatch.taxon

If itisRankID(tMatch.rank) < itisRankID("genus") Then

' rank is higher than genus

s1 = getLowerRank(tMatch.rank)

children = allDescendants(tMatch, s1, dbAllowed)

childCount = children.Count

If children.Count > 0 Then

s2 = getDisambig(children(0))

If s2 = "" Then

s2 = children(0).taxon

If (eqstr(children(0).rank, "species") Or eqstr(children(0).rank, "subspecies")) And children.Count = 1 Then s2 = abbreviate(s2)

Else

s2 = s2 & "|" & children(0).taxon ' should not happen for species or subspecies, so abbreviation won't matter

End If

firstChild = "" & s2 & ""

If itisRankID(s1) >= 180 Then firstChild = "" & firstChild & ""

Else

firstChild = ""

End If

species = allDescendants(tMatch, "species", dbAllowed)

speciesCount = species.Count

If speciesCount < 10 And childCount < 10 Then

sChildCount = numeral(childCount)

sSpeciesCount = numeral(speciesCount)

Else

sChildCount = Format(roundoff(childCount), "#,#")

sSpeciesCount = Format(roundoff(speciesCount), "#,#")

End If

qualifier = ""

If childCount >= 1 Then

If childCount = 1 Then

If speciesCount < 10 Or childCount = 1 Then

s &= " There is at least one " & s1 & ", " & firstChild & ","

Else

s &= " There is at least 1 " & s1 & ", " & firstChild & ","

End If

ElseIf childCount >= 20 Or childCount <= 4 Then

If roundoff(childCount) < childCount Then

s &= " There are more than " & sChildCount & " " & pluralRank(s1)

qualifier = "more than"

Else

s &= " There are at least " & sChildCount & " " & pluralRank(s1)

qualifier = "at least"

End If

Else

s &= " There are about " & sChildCount & " " & pluralRank(s1)

qualifier = "about"

End If

If speciesCount = 0 Or childCount = 1 Then

s &= " in " & sTaxon & "."

Else

If speciesCount = 1 Then

s2 = species(0).taxon

If s2 <> "" Then

s2 = s2.Replace(" ", " ")

s &= " and at least one described species, " & s2 & ", in " & sTaxon & "." ' monotypic genus does not link to species?

End If

ElseIf speciesCount >= 20 Or speciesCount <= 4 Then

If roundoff(speciesCount) < speciesCount Then

If qualifier = "more than" Then s &= " and " Else s &= " and more than "

Else

If qualifier = "at least" Then s &= " and " Else s &= " and at least "

End If

s &= sSpeciesCount & " described species in " & sTaxon & "."

Else

If qualifier = "about" Then s &= " and " Else s &= " and about "

s &= sSpeciesCount & " described species in " & sTaxon & "."

End If

End If

End If

Else ' rank is genus or lower

If eqstr(tMatch.rank, "genus") Then sTaxon = "" & sTaxon & ""

s1 = getLowerRank(tMatch.rank)

children = allDescendants(tMatch, s1, dbAllowed)

childCount = children.Count

If childCount < 10 Then

sChildCount = numeral(childCount)

Else

sChildCount = Format(roundoff(childCount), "#,#")

End If

If childCount >= 1 Then

If childCount = 1 Then

s2 = children(0).taxon

If s2 <> "" Then s &= " There is one described species in " & sTaxon & ", " & abbreviate(s2) & "" & "." ' monotypic genus doesn't link to species (used to be "at least one")

ElseIf childCount >= 20 Or childCount <= 4 Then

If roundoff(childCount) < childCount Then

s &= " There are more than " & sChildCount & " described species in " & sTaxon & "."

Else

s &= " There are at least " & sChildCount & " described species in " & sTaxon & "."

End If

Else

s &= " There are about " & sChildCount & " described species in " & sTaxon & "."

End If

End If

End If

Return s

End If

Else

Return "Oops!"

End If

End Function

Function roundoff(ByVal k2 As Integer) As Integer

' round to leave two significant digits on the left, used for "number of species is at least..."

Dim k1 As Integer

If k2 < 100 And k2 >= 20 Then

k2 = (k2 \ 10) * 10

Else

k1 = 10 ^ Floor(Log10(k2) - 1)

If k1 > 0 Then k2 = (k2 \ k1) * k1

End If

Return k2

End Function

Function WikiPedialist(tMatch As taxrec, children As List(Of taxrec), ancestor As List(Of taxrec),

showSource As Boolean, dbAllowed As Integer, sendingMode As Integer) As String

' makes a wikipedia list page, for a bunch of children of a taxon.

Dim s, s1, bugname As String

Dim childCount As Integer

Dim sChildcount As String

Dim species As New List(Of taxrec)

Dim sb As StringBuilder

Dim wikibug As String

Dim refs As New references

Dim wrefs As New List(Of refrec)

Dim source As String

Dim sourceUsed As Boolean = False

Dim uh As String

Dim spiderflag As Boolean

Dim rm As RegularExpressions.Match

Dim s2 As String

Dim descr As String = ""

Dim upperrank As String = ""

Dim uppertax As String = ""

Dim commonwikilink As String = ""

Dim ss As List(Of String)

Dim sq As List(Of String)

If children.Count <= 0 Then Return ""

sb = New StringBuilder

bugname = tMatch.taxon

s1 = getDisambig(tMatch)

If s1 = "" Then

wikibug = "" & tMatch.taxon & ""

Else

wikibug = "" & tMatch.taxon & ""

End If

If eqstr(tMatch.rank, "species") OrElse eqstr(tMatch.rank, "genus") OrElse eqstr(tMatch.rank, "subspecies") Then

bugname = "" & bugname & ""

wikibug = "" & wikibug & ""

End If

'ancestor = getancestors(tMatch, dbAllowed, True, "phylum", False)

defineRefs(tMatch, ancestor, bugname, refs, showSource)

wrefs = getWikiRefs(ancestor)

' if there's a taxlink species file and reference, use taxlink for a specific link in the reference

For Each wref As refrec In wrefs

If wref.url.ToLower.Contains("speciesfile.org") AndAlso tMatch.taxlink.ToLower.StartsWith(wref.url.ToLower) And

tMatch.taxlink.ToLower.Contains("taxonnameid") Then

' use it as a more specific species file link

rm = Regex.Match(tMatch.taxlink, ":\/\/(.+?)\.")

If rm.Groups.Count = 2 Then s1 = rm.Groups(1).Value Else s1 = ""

s1 = StrConv(s1, VbStrConv.ProperCase)

If s1 <> "" Then

s2 = tMatch.rank & " " & tMatch.taxon & " " & tMatch.authority

wref.url = tMatch.taxlink

wref.etc &= "|website = " & wref.title

wref.title = s2

End If

refs.addref("speciesfile", citation(wref))

Exit For

End If

Next wref

getDescr(tMatch, ancestor, descr, upperrank, uppertax, commonwikilink)

sb.AppendLine("{{DISPLAYTITLE:List of " & bugname & " " & pluralRank(children(0).rank) & "}}")

s = "These " & children.Count & " " & pluralRank(children(0).rank)

If tMatch.commonNames Is Nothing Then tMatch.commonNames = New List(Of String)

If tMatch.commonNames.Count > 0 OrElse (descr = "" Or upperrank = "" Or uppertax = "") Then

s &= " belong to the " & LCase(tMatch.rank) & " " & wikibug

If tMatch.commonNames.Count > 0 Then

s &= ", " & tMatch.commonNames(0) & "."

Else

s &= "."

End If

Else

If "aeiou".Contains(LCase(tMatch.rank).Substring(0, 1)) Then uh = ", an " Else uh = ", a "

s &= " belong to " & wikibug & uh & LCase(tMatch.rank) & " of " & descr & " in the " & upperrank & " " & uppertax & "."

End If

If s.EndsWith("..") Then s = s.Substring(0, s.Length - 1) ' etc..

If itisRankID(tMatch.rank) < 180 Then

species = allDescendants(tMatch, "species", dbAllowed)

childCount = species.Count

If childCount < 10 Then

sChildcount = numeral(childCount)

Else

sChildcount = Format(roundoff(childCount), "#,#")

End If

If childCount > 1 Then

If childCount >= 20 Or childCount <= 4 Then

s &= " There are at least " & sChildcount & " described species in " & bugname & "."

Else

s &= " There are about " & sChildcount & " described species in " & bugname & "."

End If

End If

End If

' these could be blank

If tMatch.itistsn <> 0 OrElse showSource Then s &= refs.Ref("itis")

If tMatch.gbifID <> "" OrElse showSource Then s &= refs.Ref("gbif")

If showSource Then s &= refs.Ref("catlife") ' catlife is only for showsource

s &= refs.Ref("spidercat")

If refs.refExists("bugguide", "") > 0 Then

s &= refs.Ref("bugguide") ' generic

Else

s &= refs.Ref("buglink") ' specific

End If

s &= refs.Ref("speciesfile") ' if it's there

s &= refs.Ref("paleo") ' if it's there

sb.AppendLine(s)

sb.AppendLine()

sb.AppendLine("==" & bugname & " " & LCase(pluralRank(children(0).rank)) & "==")

If children.Count >= maxColumn Then

If itisRankID(children(0).rank) >= 220 Then

sb.AppendLine("{{col div|colwidth=29em}}") ' species or subspecies

Else

sb.AppendLine("{{col div|colwidth=22em}}") ' single word taxon

End If

Else

sb.AppendLine()

End If

ss = New List(Of String)

spiderflag = False

For i1 As Integer = 0 To children.Count - 1

s1 = getDisambig(children(i1))

If s1 = "" Then

s1 = children(i1).taxon

If eqstr(tMatch.rank, "genus") AndAlso tMatch.extinct AndAlso (Not children(i1).taxon.StartsWith(tMatch.taxon)) Then

sq = s1.Split({ChrW(32)}, 2).ToList

If sq.Count = 2 AndAlso Not eqstr(sq(0), tMatch.taxon) Then

s1 = tMatch.taxon & " " & sq(1)

End If

End If

Else

s1 = s1 & "|" & children(i1).taxon

End If

If Not eqstr(children(i1).rank, "subspecies") Then s1 = "" & s1 & "" ' wikilink

If tMatch.spiderID > 0 And children(i1).spiderID <= 0 Then

s1 = "(" & s1 & ")"

spiderflag = True

End If

If eqstr(children(i1).rank, "species") OrElse eqstr(children(i1).rank, "genus") OrElse

eqstr(children(i1).rank, "subspecies") Then

s1 = "" & s1 & " "

Else

s1 = s1 & " "

End If

If children(i1).extinct Then s1 = "† " & s1

s1 = "* " & s1

If children(i1).authority <> "" Then s1 &= "" & children(i1).authority & ""

source = ""

If showSource Then

If children(i1).itistsn > 0 Then source &= " i"

If children(i1).catLifeID IsNot Nothing AndAlso children(i1).catLifeID <> "" Then source &= " c"

If children(i1).gbifID <> "" Then source &= " g"

If LCase(children(i1).link).Contains("bugguide") Then source &= " b"

If children(i1).spiderID > 0 Then source &= " s"

If source <> "" Then

s1 &= "^{" & source & "}"

sourceUsed = True

End If

End If

If children(i1).taxid <> "" Then

s = firstCommon(children(i1).taxid)

If s <> "" Then s1 &= " (" & s & ")"

End If

ss.Add(s1)

Next i1

ss.Sort()

For i As Integer = 0 To ss.Count - 1

sb.AppendLine(ss(i))

Next i

If children.Count >= maxColumn Then sb.AppendLine("{{Col div end}}") ' close column template

If sourceUsed Then

If isAncestor(ancestor, "Araneae", 0) Then

s1 = "Data sources: i = ITIS," & refs.Ref("itis") & " c = Catalogue of Life," & refs.Ref("catlife") &

" g = GBIF," & refs.Ref("gbif") & " b = Bugguide.net," & refs.Ref("bugguide") &

" s = World Spider Catalog" & refs.Ref("spider") & ""

sb.AppendLine(s1)

If spiderflag Then

s1 = vbCrLf & "" & StrConv(tMatch.rank, VbStrConv.ProperCase) & "names in parentheses may no longer be valid."

sb.AppendLine(s1)

End If

Else

s1 = "Data sources: i = ITIS," & refs.Ref("itis") & " c = Catalogue of Life," & refs.Ref("catlife") &

" g = GBIF," & refs.Ref("gbif") & " b = Bugguide.net" & refs.Ref("bugguide") & ""

sb.AppendLine(s1)

End If

End If

sb.AppendLine()

sb.AppendLine("==References==")

sb.AppendLine("{{Reflist|refs=")

sb.AppendLine(refs.allRefs & "}}")

sb.AppendLine()

sb.AppendLine()

s = getCategoryRank(ancestor, 0)

If s <> "" Then sb.AppendLine("*")

If isAncestor(ancestor, "insecta", 0) And eqstr(children(0).rank, "species") Then sb.AppendLine("Category:Lists of insect species")

If sendingMode = 1 Then sb.AppendLine(botCreateCategory)

sb.AppendLine()

sb.AppendLine()

Return sb.ToString

End Function

Function getListPageName(m As taxrec, children As List(Of taxrec)) As String

' for consistency

Return "List of " & m.taxon & " " & pluralRank(children(0).rank)

End Function

Function WikiPediaEntry(tMatch As taxrec, images As List(Of String), captions As List(Of String),

uprights As List(Of String), children As List(Of taxrec), ancestor As List(Of taxrec),

showSource As Boolean, dbAllowed As Integer, sendingMode As Integer) As String

' makes the text for a new wikipedia entry

Dim sb As New StringBuilder

Dim s, s1, s2 As String

Dim fName As String

Dim ss As List(Of String)

Dim nref As Integer = 0

Dim maxPics As Integer = 2

Dim reflist As New List(Of String)

Dim ix As New List(Of Integer)

Dim keys As New List(Of String)

Dim nextLetter = "a"

Dim refName, ref As String

Dim idup As Integer

Dim monoGenus As Boolean = False

Dim monoFamily As Boolean = False ' for anything above genus

Dim sq() As String

Dim kids As List(Of taxrec)

Dim m As New taxrec

Dim irec As New imagerec

Dim wrefs As New List(Of refrec)

Dim refs As New references

Dim bugName As String

Dim i2, k, pageid As Integer

Dim rm As RegularExpressions.Match

If tMatch.taxon = "" Then Return ""

If Not eqstr(ancestor(ancestor.Count - 1).rank, "phylum") Then

Stop

Return ""

End If

wrefs = getWikiRefs(ancestor)

' if there's a taxlink species file and reference, use taxlink for a specific link in the reference

For Each wref As refrec In wrefs

If wref.url.ToLower.Contains("speciesfile.org") AndAlso tMatch.taxlink.ToLower.StartsWith(wref.url.ToLower) And

tMatch.taxlink.ToLower.Contains("taxonnameid") Then

' use it as a more specific species file link

rm = Regex.Match(tMatch.taxlink, ":\/\/(.+?)\.")

If rm.Groups.Count = 2 Then s1 = rm.Groups(1).Value Else s1 = ""

s1 = StrConv(s1, VbStrConv.ProperCase)

If s1 <> "" Then

s2 = tMatch.rank & " " & tMatch.taxon & " " & tMatch.authority

wref.url = tMatch.taxlink

wref.etc &= "|website = " & wref.title

wref.title = s2

End If

End If

Next wref

If eqstr(tMatch.rank, "genus") OrElse eqstr(tMatch.rank, "species") OrElse

eqstr(tMatch.rank, "subspecies") Then

bugName = "" & tMatch.taxon & ""

Else

bugName = tMatch.taxon

End If

defineRefs(tMatch, ancestor, bugName, refs, showSource)

For i1 As Integer = 0 To images.Count - 1

images(i1) = images(i1).Replace("=", "%3D")

Next i1

If children.Count = 1 Then

If eqstr(children(0).rank, "species") AndAlso eqstr(tMatch.rank, "genus") Then monoGenus = True

If eqstr(children(0).rank, "genus") Then monoFamily = True

End If

If eqstr(tMatch.rank, "species") Or monoGenus Then

sb.AppendLine("{{Speciesbox")

Else

sb.AppendLine("{{Automatic taxobox")

End If

If images.Count >= 1 Then

ss = images(0).Split(" ").ToList

fName = ss(ss.Count - 1) ' last word is filename

irec = getImageRec(fName)

s1 = images(0)

If s1.StartsWith("File:") Then s1 = s1.Substring(5)

sb.AppendLine("| image = " & s1)

If captions.Count > 0 Then

sb.AppendLine("| image_caption = " & captions(0))

End If

If uprights(0) <> "" Then sb.AppendLine("| image_upright = " & uprights(0))

End If

' ----------- species box ----------------------

If monoGenus Then ' genus page, but show species also

sb.AppendLine("| genus = " & getTaxAmbig(tMatch.taxon))

sq = children(0).taxon.Split(" ")

sb.AppendLine("| species = " & sq(1))

If tMatch.authority <> "" Then sb.AppendLine("| parent_authority = " & tMatch.authority)

If children(0).authority <> "" Then sb.AppendLine("| authority = " & children(0).authority)

ElseIf monoFamily Then ' redirect to genus page, exit

s = "#REDIRECT " & children(0).taxon & "" & vbCrLf & "{{R from monotypic taxon}}" & vbCrLf

outLog("Redirect from " & tMatch.taxon & " to " & children(0).taxon)

Return s

Else ' normal, not monotypic from or to genus

If eqstr(tMatch.rank, "species") Then

sq = ancestor(0).taxon.Split(" ")

sb.AppendLine("| genus = " & getTaxAmbig(sq(0)))

sb.AppendLine("| species = " & sq(1))

Else ' not species, one word

sb.AppendLine("| taxon = " & getTaxAmbig(tMatch.taxon))

End If

If tMatch.authority <> "" Then sb.AppendLine("| authority = " & tMatch.authority)

End If

If tMatch.extinct Then

s1 = extinctRange(tMatch)

If s1 <> "" Then sb.AppendLine(s1)

End If

' display_parents = k

If tMatch.rank = "species" Then

s1 = getHigherRank("genus")

i2 = 2 ' skip genus when looking for higherrank.

k = 1 ' show an extra parent, for genus

Else

s1 = getHigherRank(tMatch.rank)

i2 = 1

k = 0

End If

For i As Integer = i2 To ancestor.Count - 1

If eqstr(ancestor(i).rank, s1) Then Exit For

k += 1

Next i

If k > 1 Then sb.AppendLine("| display_parents = " & k)

If tMatch.iucnStatus <> "" AndAlso Not eqstr(tMatch.iucnStatus, "dd") Then ' add endangered status

sb.AppendLine("| status = " & tMatch.iucnStatus)

sb.AppendLine("| status_system = iucn" & tMatch.iucnVersion)

If tMatch.iucnID <> "" Then sb.AppendLine("| status_ref = " & refs.Ref("iucn")) ' http://www.iucnredlist.org/details/42685/0

End If

If children.Count >= maxlist Then

sb.AppendLine("| diversity_link = " & getListPageName(tMatch, children))

sb.AppendLine("| diversity = at least " & roundoff(children.Count) & " " & pluralRank(children(0).rank))

End If

' show children?

kids = getChildren(tMatch, False, dbAllowed) ' get immediate children

For i As Integer = kids.Count - 1 To 0 Step -1

If Not itisRankID.ContainsKey(kids(i).rank) OrElse

itisRankID(kids(i).rank) >= 220 OrElse mainRank.IndexOf(kids(i).rank) >= 0 Then kids.RemoveAt(i)

Next i

If kids.Count > 1 Then ' minor ranks only

sb.AppendLine("| subdivision_ranks = " & StrConv(pluralRank(kids(0).rank), VbStrConv.ProperCase))

sb.AppendLine("| subdivision =")

ss = New List(Of String)

For Each kid As taxrec In kids

If kid.extinct Then s = "* † " & kid.taxon & "" Else s = "* " & kid.taxon & ""

If kid.authority <> "" Then s &= " " & kid.authority & ""

ss.Add(s)

Next kid

ss.Sort()

For Each s3 As String In ss

sb.AppendLine(s3)

Next s3

End If

If tMatch.synonyms IsNot Nothing AndAlso tMatch.synonyms.Count > 0 Then

sb.Append("| synonyms = ")

If eqstr(tMatch.rank, "species") Then

sb.AppendLine("{{Species list")

Else

sb.AppendLine("{{Taxon list")

End If

For j As Integer = 0 To tMatch.synonyms.Count - 1

If tMatch.synauth.Count > j Then

sb.AppendLine("| " & tMatch.synonyms(j) & " | " & tMatch.synauth(j))

Else

sb.AppendLine("| " & tMatch.synonyms(j) & " |")

End If

Next j

sb.AppendLine("}}") ' synonyms

If tMatch.itistsn > 0 Then sb.AppendLine("| synonyms_ref = " & refs.Ref("itis"))

End If

sb.AppendLine("}}")

sb.AppendLine()

'---------title-------------------

s = "" & bugName & ""

'---------introduction---------------

s &= formatAncestors(tMatch, ancestor, dbAllowed)

'---------common names------------------

If 1 = 0 Then

ss = New List(Of String)

ss.AddRange(tMatch.commonNames)

For i As Integer = 0 To ss.Count - 1

ss(i) = """" & ss(i) & """"

Next i

If tMatch.commonNames.Count > 0 Then

If eqstr(tMatch.rank, "species") Or eqstr(tMatch.rank, "subspecies") Then

s &= " The " & LCase(tMatch.rank) & " is known generally as " ' """ & tmatch.commonNames(0) & """."

s1 = formatList(ss, "or")

If Not s1.StartsWith("the") Then s1 = "the " & s1

s &= s1 & "."

Else

s &= "Members of the " & LCase(tMatch.rank) & " " & bugName & " include " ' & tmatch.commonNames(0) & "."

s1 = formatList(ss, "and")

If Not s1.StartsWith("the") Then s1 = "the " & s1

s &= s1 & "."

End If

End If

End If

'---------range----------------------

s1 = getRange(tMatch)

If s1 <> "" Then s &= " " & s1

'---------primary references----------------------

' some of these may be blank

' refs.ref sets the used flag (if not blank) -- required.

If tMatch.itistsn <> 0 OrElse showSource Then s &= refs.Ref("itis")

If tMatch.gbifID <> "" OrElse showSource Then s &= refs.Ref("gbif")

s &= refs.Ref("spidercat")

s &= refs.Ref("iucn")

s &= refs.Ref("buglink")

s &= refs.Ref("paleo") ' if it's there

sb.AppendLine(s)

'---------conservation status------------------

If tMatch.iucnStatus <> "" AndAlso Not eqstr(tMatch.iucnStatus, "dd") Then ' add endangered status

s = "The IUCN conservation status of " & bugName & " is " & iucnstatus(tMatch.iucnStatus, tMatch.iucnTrend, tMatch.iucnYear)

s &= refs.Ref("iucn")

sb.AppendLine()

sb.AppendLine(s)

End If

'-----------Hodges number-----------------

If tMatch.hodges <> "" Then

s = "The MONA or Hodges number for " & bugName & " is "

If isAncestor(ancestor, "Papilionoidea", 0) Then ' butterfly, don't link to moths

s &= tMatch.hodges & "." & refs.Ref("mpg")

Else

s &= "" & tMatch.hodges & "." & refs.Ref("mpg")

End If

sb.AppendLine()

sb.AppendLine(s)

End If

'---------additional references on page. These are at the end of the text, so use

s = "" : nextLetter = "a"

For i As Integer = 0 To wrefs.Count - 1

If LCase(wrefs(i).reftype).StartsWith("ref") Then ' reftype is refpub, refweb, refbook, etc. to go in the text.

refName = "ref" & Format(i, "00")

ref = citation(wrefs(i))

If wrefs(i).alast.Count > 0 Then ' use author name, year for ref name

refName = wrefs(i).alast

idup = refName.IndexOf("|")

If idup >= 0 Then refName = refName.Substring(0, idup)

refName &= wrefs(i).year

End If

idup = refs.refExists(refName, ref)

If idup = 1 Then ' name exists

refName &= nextLetter

nextLetter = ChrW(Asc(nextLetter) + 1)

End If

idup = refs.refExists(refName, ref)

If idup = 1 Then refs.Ref("ref" & i) ' duplicate name (should never happen)

If idup <= 1 Then ' 2 is duplicate reference content -- don't add it.

refs.addref(refName, ref)

s &= refs.Ref(refName)

End If

End If

Next i

If s <> "" Then sb.AppendLine(s)

'---------photos----------------------------

k = 1

For i As Integer = 1 To maxPics ' first one's been used.

Do While k <= images.Count - 1

pageid = getPageID(images(k), urlWikiMedia)

If pageid > 0 Then Exit Do

k += 1

Loop

If k >= images.Count Then Exit For

ss = images(k).Split(" ").ToList

fName = ss(ss.Count - 1)

s = "[[" & images(k) & "| thumb"

If uprights(k) <> "" Then s &= "| upright"

irec = getImageRec(fName)

If captions.Count > i AndAlso captions(k) <> "" Then

s &= "|" & captions(k) & "]]"

Else

s1 = wikiCaption(tMatch, True)

If s1 = "" Then

s &= "]]"

Else

If irec.taxonid = "" Then

s &= "|" & s1 & "]]"

Else

s &= "|" & s1 & "]]" 's &= "|" & s1 & xpref & "]]"

End If

End If

End If

sb.AppendLine(s)

k += 1

Next i

'---------children--------------------------------

If (children.Count > 1 And children.Count < maxlist) Then

s = formatchildren(tMatch, children, refs, ancestor, showSource)

If s <> "" Then

sb.AppendLine()

sb.AppendLine(s)

End If

End If

'---------see also (list page)---------------------

If children.Count >= maxlist Then

sb.AppendLine()

sb.AppendLine("==See also==")

sb.AppendLine("* " & getListPageName(tMatch, children) & "") ' function is for consistency

End If

sb.Replace("/>" & vbCrLf & "

'---------inline references------------------------

sb.AppendLine()

sb.AppendLine("==References==")

sb.AppendLine("{{Reflist|refs=")

sb.AppendLine(refs.allRefs & "}}")

'---------further reading---------------------

reflist = New List(Of String)

For Each wref As refrec In wrefs

If Not LCase(wref.reftype).StartsWith("ref") Then ' no external links And Not LCase(wref.reftype).EndsWith("web") Then

reflist.Add(citation(wref)) ' paper reference

ix.Add(ix.Count) ' for sort

s1 = wref.alast

If s1 = "" Then s1 = wref.elast

'If s1 = "" Then s1 = wref.authors

If s1 = "" Then

s1 = wref.title

If s1.StartsWith("A ") Then s1 = s1.Substring(2)

If s1.StartsWith("An ") Then s1 = s1.Substring(3)

If s1.StartsWith("The ") Then s1 = s1.Substring(4)

End If

keys.Add(s1) ' for sort

End If

Next wref

If reflist.Count > 0 And Not tMatch.extinct Then ' no further reading for extinct bugs

sb.AppendLine()

sb.AppendLine("==Further reading==")

sb.AppendLine("{{refbegin}}")

MergeSort(keys, ix, 0, reflist.Count - 1)

For i1 As Integer = 0 To reflist.Count - 1

sb.AppendLine("* " & reflist(ix(i1)))

Next i1

sb.AppendLine("{{refend}}")

End If

sb.AppendLine()

If images.Count > 0 Then

sb.AppendLine("==External links==")

sb.AppendLine("{{refbegin}}")

'sb.AppendLine("* {{Commons category-inline|" & tMatch.taxon & "}}")

sb.AppendLine("* {{Commons-inline}}")

sb.AppendLine("{{refend}}")

sb.AppendLine()

End If

s1 = tMatch.wikidataid

If s1 = "" Then s1 = getQnumber(tMatch, ancestor)

If s1 <> "" Then

sb.AppendLine("{{Taxonbar|from=" & s1 & "}}")

Else

sb.AppendLine("{{Taxonbar}}")

End If

sb.AppendLine()

s = "Category:" & getCategoryRank(ancestor, 1) & ""

sb.AppendLine(s)

If isAncestor(ancestor, "diplopoda", 0) Then sb.AppendLine("Category:Millipedes of North America")

If sendingMode = 1 Then sb.AppendLine(botCreateCategory)

sb.AppendLine()

sb.AppendLine()

sb.AppendLine(getStubs(ancestor, images.Count))

Return sb.ToString

End Function

Function getStubs(ancestor As List(Of taxrec), nImages As Integer) As String

' return the appropriate stub tag

Dim tax As String

Dim stub As String = ""

If ancestor(0).extinct And (isAncestor(ancestor, "arthropoda", 0) Or isAncestor(ancestor, "euarthropoda", 0)) Then Return "{{Paleo-arthropod-stub}}"

For i1 As Integer = 0 To ancestor.Count - 1

tax = LCase(ancestor(i1).taxon)

If stubs.ContainsKey(tax) Then Return stubs(tax)

Next i1

If isAncestor(ancestor, "insecta", 0) Then Return "{{Insect-stub}}"

If isAncestor(ancestor, "arthropoda", 0) Then Return "{{Arthropod-stub}}"

If isAncestor(ancestor, "animalia", 0) Then Return "{{Animal-stub}}"

Return stub

End Function

Function getWikiUsers(titleParm As String, url As String, rvlimit As String) As List(Of String)

' loads pages from wiki, 1 or more (rvlimit) revisions

' 0 is the latest iteration, spages.count-1 is the original creator

Dim parms As New Dictionary(Of String, String)

Dim r1 As HttpResponseMessage

Dim qcontent As FormUrlEncodedContent

Dim s As String

Dim jq As JObject

Dim sPages As New List(Of String)

Dim pageID As String

parms = New Dictionary(Of String, String)

parms.Add("action", "query")

parms.Add("titles", titleParm)

parms.Add("prop", "revisions")

parms.Add("rvprop", "user")

If rvlimit <> "1" And rvlimit <> "" Then

parms.Add("rvlimit", rvlimit) ' number of revisions to return

End If

parms.Add("rvslots", "*") ' format?

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(url, qcontent).Result

s = r1.Content.ReadAsStringAsync().Result

jq = JObject.Parse(s)

Try

pageID = jq.SelectToken("query.pages.*").SelectToken("pageid")

If pageID IsNot Nothing Then

For i As Integer = 0 To jq.SelectToken("query.pages.*.revisions").Count - 1

sPages.Add(jq.SelectToken("query.pages.*.revisions(" & i & ").user").ToString)

Next i

End If

Catch ex As Exception

MsgBox("json error: " & ex.Message)

Return New List(Of String)

End Try

Return sPages

End Function

Function getWikiPages(titleParm As String, url As String, rvlimit As String) As List(Of String)

' loads pages from wiki, 1 or more (rvlimit) revisions

' 0 is the latest iteration

Dim parms As New Dictionary(Of String, String)

Dim r1 As HttpResponseMessage

Dim qcontent As FormUrlEncodedContent

Dim s As String

Dim ssk As List(Of JToken)

Dim jq As JObject

Dim sPages As New List(Of String)

Dim page As String

Dim pageID As String

If titleParm = "" Then Return New List(Of String)

parms = New Dictionary(Of String, String)

parms.Add("action", "query")

parms.Add("titles", titleParm)

parms.Add("prop", "revisions")

parms.Add("rvprop", "content")

If rvlimit <> "1" And rvlimit <> "" Then

parms.Add("rvlimit", rvlimit) ' number of revisions to return

End If

parms.Add("rvslots", "*") ' format?

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(url, qcontent).Result

s = r1.Content.ReadAsStringAsync().Result

jq = JObject.Parse(s)

Try

pageID = jq.SelectToken("query.pages.*").SelectToken("pageid")

If pageID IsNot Nothing Then

For i As Integer = 0 To jq.SelectToken("query.pages.*.revisions").Count - 1

Try

ssk = jq.SelectToken("query.pages.*.revisions(" & i & ").slots.main").ToList

If ssk.Count >= 3 Then

page = ssk(2)

sPages.Add(page)

End If

Catch ex As Exception

outLog("error reading " & titleParm & ", page " & i + 1 & ", " & ex.Message)

End Try

Next i

End If

Catch ex As Exception

MsgBox("json error: " & ex.Message)

Return New List(Of String)

End Try

Return sPages

End Function

Sub updatePageID(m As taxrec, pageID As String)

' save the wikipediapageid to the database. The ID is not used at the moment, just non-zero shows a wikipage exists

Dim k As Integer

If Not IsNumeric(pageID) OrElse m.taxid = "" Then Exit Sub

k = getScalar("select count(*) from oddinfo where taxid = @parm1", m.taxid)

If k = 0 Then

k = nonQuery("insert into oddinfo (taxid, name, wikipediapageid) values (@parm1, @parm2, @parm3);",

m.taxid, m.taxon, pageID)

If k <> 1 Then Stop

Else

k = nonQuery("update oddinfo set wikipediapageid = @parm1 where taxid = @parm2", pageID, m.taxid)

If k <> 1 Then Stop

End If

End Sub

Sub updatePagesMade(m As taxrec, pageTitle As String)

Dim s1 As String

Dim k As Integer

s1 = Format(Now, "yyyy-MM-dd HH:mm:ss")

k = getScalar("select count(*) from pagesmade where taxon = @parm1", m.taxon)

If k = 0 Then

k = nonQuery("insert into pagesmade (time, pagetitle, taxon, madeby) values (@parm1, @parm2, @parm3, 'qbugbot')",

s1, pageTitle, m.taxon)

Else

k = nonQuery("update pagesmade set time=@parm1, madeby='qbugbot' where taxon = @parm2", s1, m.taxon)

End If

If k <> 1 Then outLog("Database error, inserting into pagesmade")

End Sub

Sub getwikipics(m As taxrec, ByRef images As List(Of String), ByRef captions As List(Of String),

ByRef uprights As List(Of String), dbAllowed As Integer)

' returns a list of images for a single taxon

Dim ds As New DataSet

ds = getDS("select * from wikipics where wikipics.taxon = @parm1", m.taxon)

For Each dr As DataRow In ds.Tables(0).Rows

If (dr("taxon") <> m.taxon) AndAlso dr("taxon") <> "" AndAlso m.taxon <> "" Then ' Stop

End If

images.Add(dr("wikititle"))

If eqstr(m.rank, "species") OrElse eqstr(m.rank, "genus") OrElse eqstr(m.rank, "subspecies") Then

captions.Add("" & m.taxon & "")

Else

captions.Add(m.taxon)

End If

uprights.Add(dr("upright")) ' upright parameter for aspect ratio

Next dr

End Sub

Function checktaxtemplate(ancestor As List(Of taxrec), pagesmade As List(Of String), pageTitle As String) As List(Of String)

' generate taxonomy templates for the ancestors that are missing.

' returns a string of all generated templates

Dim pageID As Integer

Dim template As String

Dim s As String

Dim k As Integer

Dim topEmpty As Integer

Dim lastTaxon As String

Dim pages As List(Of String)

Dim s1 As String

Dim m As taxrec

Dim upperRank As String = ""

Dim upperTax As String = ""

pages = New List(Of String)

topEmpty = ancestor.Count - 2

lastTaxon = ancestor(topEmpty + 1).taxon

' start at the bottom and find the last missing rank

For i1 As Integer = 0 To ancestor.Count - 2 ' skip topmost rank

lastTaxon = ancestor(i1).taxon

If itisRankID(ancestor(i1).rank) > 60 AndAlso itisRankID(ancestor(i1).rank) < 220 Then

' rank is lower than class and >= genus.

If ancestor(i1).taxid <> "" Then

s = getScalar("select taxtemplateid from oddinfo where taxid = @parm1;", ancestor(i1).taxid)

Else

s = ""

End If

If IsNumeric(s) Then pageID = s Else pageID = 0

s1 = getTaxAmbig(ancestor(i1).taxon)

If pageID = 0 Then pageID = getPageID("Template:Taxonomy/" & s1, urlWikiPedia)

'If itisRankID(ancestor(i1).rank) >= 100 Then pageID = 0 ' for debugging!

If pageID > 0 Then

topEmpty = i1 - 1

lastTaxon = ancestor(i1).taxon

Exit For

End If

End If

Next i1

k = getTaxFam(ancestor, topEmpty + 1, upperRank, upperTax)

If k = 0 Then outLog("Ancestor not in tax template for " & lastTaxon & ", " & upperRank & " " & upperTax)

For i1 As Integer = topEmpty To 0 Step -1

If itisRankID(ancestor(i1).rank) > 60 AndAlso itisRankID(ancestor(i1).rank) < 220 Then

' rank is lower than class and >= genus.

If ancestor(i1).taxid <> "" Then

s = getScalar("select taxtemplateid from oddinfo where taxid = @parm1;", ancestor(i1).taxid)

Else

s = ""

End If

If IsNumeric(s) Then pageID = s Else pageID = 0

'If itisRankID(ancestor(i1).rank) >= 100 Then pageID = 0 ' for debugging!

If pageID <= 0 Then

s1 = getTaxAmbig(ancestor(i1).taxon)

template = "template:Taxonomy/" & s1

If pagesmade.IndexOf(template) < 0 Then

pageID = getPageID(template, urlWikiPedia)

'If itisRankID(ancestor(i1).rank) >= 100 Then pageID = 0 ' for debugging!

If pageID = 0 Then

m = ancestor(i1)

taxrecAddon(m)

If i1 = 0 AndAlso m.ambigLink = "" And pageTitle.Contains("(") Then m.ambigLink = pageTitle ' read from taxlist.txt

If ancestor(i1).itistsn > 0 OrElse ancestor(i1).catLifeID <> "" OrElse (ancestor(i1).gbifID <> "" And ancestor(i1).gbifID <> "0") OrElse

ancestor(i1).spiderlink <> "" OrElse (ancestor(i1).taxid <> "") Then

s = createTaxTemplate(m, lastTaxon)

If s <> "" Then

pages.Add(template)

pages.Add(s)

End If

outLog("created " & template)

pagesmade.Add(template)

End If

Else ' save an internet call next time

If ancestor(i1).taxid <> "" Then

k = getScalar("select count(*) from oddinfo where taxid = @parm1", ancestor(i1).taxid)

If k > 0 Then ' update oddinfo record

k = nonQuery("update oddinfo set taxtemplateid = @parm1 where taxid = @parm2;",

pageID, ancestor(i1).taxid)

If k <> 1 Then Stop

Else ' insert record into oddinfo

k = nonQuery("insert into oddinfo (taxid, name, taxtemplateid) values (@parm1, @parm2, @parm3)",

ancestor(i1).taxid, ancestor(i1).taxon, pageID)

If k <> 1 Then Stop

End If

End If

End If

End If

End If

End If

lastTaxon = ancestor(i1).taxon

Next i1

Return pages

End Function

Function getTaxFam(anc As List(Of taxrec), taxStart As Integer, ByRef taxRank As String, ByRef taxTaxon As String) As Boolean

' determines whether the taxobox will conflict with article text in " in the family 'taxTaxon' " (formatancestor)

Dim ancTax As String

Dim taxPage As String = ""

Dim taxTitle As String = ""

Dim rank As String = ""

Dim parent As String = ""

Dim rm As RegularExpressions.Match

Dim iCount As Integer

' get family, order, or class of the taxonomy templates in ancestor

ancTax = ""

taxTaxon = ""

taxRank = ""

parent = anc(taxStart).taxon

' select family, order, or class

For i1 As Integer = 1 To anc.Count - 1

Select Case LCase(anc(i1).rank)

Case "family"

taxRank = "family"

ancTax = anc(i1).taxon

Exit For

Case "order"

taxRank = "order"

ancTax = anc(i1).taxon

Exit For

Case "class"

taxRank = "class"

ancTax = anc(i1).taxon

Exit For

End Select

Next i1

If ancTax = "" Then Return False

iCount = 0

Do While iCount = 0 Or

(parent <> "" AndAlso (Not itisRankID.ContainsKey(rank) OrElse itisRankID(taxRank) < itisRankID(rank)) And iCount < 50)

taxTitle = parent

taxPage = getWikiPage("Template:taxonomy/" & taxTitle, urlWikiPedia)

rm = Regex.Match(taxPage, "\| *?rank *?= *?([a-zA-Z]+?)[^a-zA-Z]")

If rm.Groups.Count = 2 Then rank = rm.Groups(1).Value

rm = Regex.Match(taxPage, "\| *?parent *?= *?([a-zA-Z]+?)[^a-zA-Z]")

If rm.Groups.Count = 2 Then parent = rm.Groups(1).Value

iCount += 1

Loop

If itisRankID.ContainsKey(rank) AndAlso itisRankID(taxRank) > itisRankID(rank) Then

Return True ' skipped taxRank, let it go

End If

If eqstr(rank, latinRank(taxRank)) Then

taxTaxon = taxTitle

Return eqstr(taxTaxon, ancTax)

Else

taxTaxon = ""

Return False

End If

End Function

Sub makePage(m As taxrec, dbRequired As Integer, dbAllowed As Integer, pageTitle As String,

templateOnly As Boolean, sendingMode As Integer, alteration As String)

' makes a wikipedia page, and ancestor pages as needed.

' handles overhead and calls wikipiaentry and wikipedialist.

' sendingmode 2 = update, 1 = create, 0 = don't send

Dim s, s1, s2 As String

Dim k As Integer

Dim ancestor As List(Of taxrec) = Nothing

Dim taxAncestor As List(Of taxrec) = Nothing

Dim images As New List(Of String)

Dim captions As New List(Of String)

Dim uprights As New List(Of String)

Dim children As New List(Of taxrec)

Dim sp As New List(Of String)

Dim sTalk As String

Dim inPages As List(Of String)

Dim bugname As String

Dim monoType As Boolean

Dim mp As taxrec

Dim showSource As Boolean = False

getwikipics(m, images, captions, uprights, dbAllowed)

s = validTaxon(m, dbRequired)

If s <> "" Then

If LCase(s).Contains("itis") AndAlso images.Count > 0 Then

outLog("No itis, but imagecount = " & images.Count & ". " & m.taxon)

Exit Sub ' remove to relax itis restriction for pages with images

Else

outLog("invalid taxon: " & m.taxon & ", " & s)

Exit Sub

End If

End If

ancestor = getancestors(m, dbAllowed, True, "phylum")

children = allDescendants(m, getLowerRank(m.rank), dbAllowed) ' get children

bugname = m.taxon ' for edit summary

If eqstr(m.rank, "species") OrElse eqstr(m.rank, "genus") OrElse eqstr(m.rank, "subspecies") Then

bugname = "" & bugname & ""

End If

If itisRankID(m.rank) >= 100 Then ' get pics if rank is order through but not including species

' get descendant images for upper taxons

For Each m3 As taxrec In children

getwikipics(m3, images, captions, uprights, dbAllowed)

Next m3

If images.Count > 2 Then

images = {images(0), images(images.Count - 1)}.ToList ' get first and last image if there are several

captions = {captions(0), captions(captions.Count - 1)}.ToList ' get first and last image if there are several

uprights = {uprights(0), uprights(uprights.Count - 1)}.ToList ' get first and last image if there are several

End If

End If

' sTalk is the project name for the stub notice on the talk page.

If isAncestor(ancestor, "lepidoptera", 0) Then

sTalk = "Lepidoptera"

ElseIf isAncestor(ancestor, "coleoptera", 0) Then

sTalk = "Beetles"

ElseIf isAncestor(ancestor, "formicidae", 0) Then

sTalk = "Insects|ants=yes"

ElseIf isAncestor(ancestor, "hymenoptera", 0) Then

sTalk = "Insects|Hymenoptera=yes|Hymenoptera-importance=low"

ElseIf isAncestor(ancestor, "insecta", 0) Then

sTalk = "Insects"

ElseIf isAncestor(ancestor, "Araneae", 0) Then

sTalk = "Spiders"

ElseIf isAncestor(ancestor, "Arthropoda", 0) Then

sTalk = "Arthropods"

ElseIf isAncestor(ancestor, "Amphibia", 0) Then

sTalk = "Amphibians and Reptiles"

ElseIf isAncestor(ancestor, "Reptilia", 0) Then

sTalk = "Amphibians and Reptiles"

ElseIf isAncestor(ancestor, "Animalia", 0) Then

sTalk = "Animals"

ElseIf isAncestor(ancestor, "Aves", 0) Then

sTalk = "Birds"

ElseIf isAncestor(ancestor, "Bivalvia", 0) Then

sTalk = "Bivalves"

ElseIf isAncestor(ancestor, "Felidae", 0) Then

sTalk = "Cats"

ElseIf isAncestor(ancestor, "Cephalopoda", 0) Then

sTalk = "Cephalopods"

ElseIf isAncestor(ancestor, "Cetacea", 0) Then

sTalk = "Cetaceans"

ElseIf isAncestor(ancestor, "Dinosauria", 0) Then

sTalk = "Dinosaurs"

ElseIf isAncestor(ancestor, "Canis", 0) Then

sTalk = "Dogs"

ElseIf isAncestor(ancestor, "Agnatha", 0) Then

sTalk = "Fishes"

ElseIf isAncestor(ancestor, "Chondrichthyes", 0) Then

sTalk = "Fishes"

ElseIf isAncestor(ancestor, "Osteichthyes", 0) Then

sTalk = "Fishes"

ElseIf isAncestor(ancestor, "Gastropoda", 0) Then

sTalk = "Gastropods"

ElseIf isAncestor(ancestor, "Mammalia", 0) Then

sTalk = "Mammals"

ElseIf isAncestor(ancestor, "Plantae", 0) Then

sTalk = "Plants"

ElseIf isAncestor(ancestor, "Primates", 0) Then

sTalk = "Primates"

ElseIf isAncestor(ancestor, "Rodentia", 0) Then

sTalk = "Rodents"

ElseIf isAncestor(ancestor, "Selachimorpha", 0) Then

sTalk = "Sharks"

ElseIf isAncestor(ancestor, "Testudines", 0) Then

sTalk = "Turtles"

Else

sTalk = "Animals"

End If

sTalk = "{{WikiProject " & sTalk & "|class=stub|importance=low}}" & vbCrLf

If m.extinct Then sTalk &= "{{WikiProject Palaeontology|class=stub|importance=low}}" & vbCrLf

If sendingMode = 1 Then

sTalk &= vbCrLf & botCreateMessage & vbCrLf ' create page

k = getPageID(pageTitle, urlWikiPedia)

If k > 0 Then outLog("page exists: " & m.taxon) Else Stop

End If

If k <= 0 Or sendingMode <> 1 Then ' make the pages sendingmode 2 = update, 1 = create, 0 = don't send

taxAncestor = getancestors(ancestor(0), 27, True, "phylum") ' allow itis, catlife, etc. for the templates

sp = checktaxtemplate(taxAncestor, pagesMade, pageTitle)

For i1 As Integer = 0 To sp.Count - 1 Step 2

madePage.Append("=================" & sp(i1) & "======================" & vbCrLf) ' title

madePage.Append(sp(i1 + 1) & vbCrLf & vbCrLf & vbCrLf) ' content

If sendingMode <> 0 And nPagesSent < maxPagesSent Then ' update or create

s2 = "Created " & sp(i1)

sendWikiPage(sp(i1), sp(i1 + 1), urlWikiPedia, s2, 1) ' sendingmode: create only for templates

End If

Next i1

If Not templateOnly Then

madePage.Append("=================" & pageTitle & "======================" & vbCrLf)

s = WikiPediaEntry(m, images, captions, uprights, children, ancestor, showSource, dbAllowed, sendingMode)

madePage.Append(s)

'If images.Count = 0 Then sTalk = sTalk.Replace("}}", "|needs-photo=yes}}")

If s <> "" Then

If sendingMode <> 0 And nPagesSent < maxPagesSent Then

If sendingMode = 2 Then s2 = alteration Else s2 = "Created page for the " & LCase(m.rank) & " " & bugname

s = sendWikiPage(pageTitle, s, urlWikiPedia, s2, sendingMode)

If IsNumeric(s) Then

updatePageID(m, s) ' mark as "page exists" in database

updatePagesMade(m, pageTitle) ' update pagesmade database

End If

addTalkPage(sendingMode, pageTitle, sTalk, "Created talk page: stub class, low importance")

nPagesSent += 1

appendPageTitle(pageTitle)

If nPagesSent >= maxPagesSent Then outLog("Pages sent: " & nPagesSent & ", max: " & maxPagesSent)

End If

End If

madePage.Append(vbCrLf & vbCrLf & sTalk)

outLog("saved page: " & m.taxon)

If children.Count >= maxlist And sendingMode <> 2 Then ' create a list page

s = WikiPedialist(m, children, ancestor, showSource, dbAllowed, sendingMode) ' make a list page for the children

sTalk = sTalk.Replace("|class=stub", "|class=list")

'sTalk = sTalk.Replace("|needs-photo=yes}}", "}}")

madePage.Append("=======================================" & vbCrLf)

madePage.Append(s)

madePage.Append(vbCrLf & vbCrLf & sTalk)

outLog("saved page: " & m.taxon & " list page")

s2 = getListPageName(m, children) ' to be consistent with link in main page

If sendingMode <> 0 And nPagesSent < maxPagesSent Then

s1 = sendWikiPage(s2, s, urlWikiPedia, "Created list page for the " & LCase(m.rank) & " " & bugname, sendingMode)

If IsNumeric(s1) Then

updatePagesMade(m, s2)

addTalkPage(sendingMode, s2, sTalk, "Created talk page: list class, low importance")

End If

nPagesSent += 1

appendPageTitle(s2)

If nPagesSent >= maxPagesSent Then outLog("Pages sent: " & nPagesSent & ", max: " & maxPagesSent)

End If

End If

pagesMade.Add(m.taxon)

End If

End If

'End If

If Not templateOnly Then

' crawl up the ancestors and make missing pages, (creation only)

If sendingMode = 1 Then

For i1 As Integer = 1 To ancestor.Count - 1

mp = ancestor(i1)

If mp.unimportant = 0 AndAlso pagesMade.IndexOf(mp.taxon) < 0 Then

If mp.taxid <> "" Then

k = getScalar("select count(*) from oddinfo where wikipediapageid > 0 and taxid = @parm1", mp.taxid)

Else

k = 0

End If

If k <= 0 Then ' no wikipedia id in database

s1 = getDisambig(mp)

If s1 = "" Then s1 = mp.taxon

k = getPageID(s1, urlWikiPedia) ' not on wikipedia

If k = 0 Then

makePage(mp, dbRequired, dbAllowed, s1, templateOnly, sendingMode, "") ' make an ancestor page

End If

End If

End If

Next i1

End If

If Not monoType Then

'If sendingMode Then ' check for orphans

inPages = orphanCheck(pageTitle)

If inPages.Count = 0 Then

outLog("orphan: " & pageTitle)

If sendingMode <> 0 Then appendPageTitle("orphan" & vbTab & ancestor(1).taxon)

Else

' see if it's an orphan except for child's link

k = 0

For i1 As Integer = 0 To children.Count - 1

If inPages.IndexOf(children(i1).taxon) >= 0 Then k += 1

Next i1

If k >= inPages.Count Then

outLog("orphan almost: " & pageTitle)

If sendingMode <> 0 Then appendPageTitle("orphan" & vbTab & ancestor(1).taxon & vbTab & ancestor(2).taxon)

End If

End If

End If

End If

End Sub

Sub addTalkPage(sendingMode As Integer, pageTitle As String, sTalk As String, logMessage As String)

Dim s As String

If sendingMode = 1 Then ' create

s = sendWikiPage("Talk:" & pageTitle, sTalk, urlWikiPedia, logMessage, sendingMode)

ElseIf sendingMode = 2 Then ' update

s = getWikiPage("Talk:" & pageTitle, urlWikiPedia)

If Not s.ToLower.Contains("{{wikiproject") Then

If s = "" Then

s = sTalk

Else

s = s.Trim & vbCrLf & vbCrLf & sTalk

End If

s = sendWikiPage("Talk:" & pageTitle, s, urlWikiPedia, logMessage, sendingMode)

End If

End If

End Sub

Sub loadTaxList()

' reads a list of titles from taxlist file and makes pages for all the items, even if they've been done before.

Dim i1 As Integer

Dim s1 As String

Dim ds As DataSet

Dim m, m2 As New taxrec

Dim ss As List(Of String)

Dim pageTitle As String

Dim dbRequired, dbAllowed As Integer

Dim templateOnly As Boolean

Dim result As MsgBoxResult

Dim sendingMode As Integer

File.WriteAllText(outFile, "")

madePage = New StringBuilder

ss = New List(Of String)

ss = File.ReadAllLines(My.Settings.taxlist).ToList

dbRequired = 0 ' 1 = taxa, 2 = itis, 4 = catlife, 8 = gbif, 16 = spidercat(andable)

'dbAllowed = 31 ' allowed: all (taxa=1, itis=2, catlife = 4, gbif = 8, 16 = spidercat) for ancestors and children

'dbAllowed = 29 ' allowed: not itis (taxa=1, itis=2, catlife = 4, gbif = 8, 16 = spidercat) for ancestors and children

'dbAllowed = 27 ' allowed: not catlife (taxa=1, itis=2, catlife = 4, gbif = 8, 16 = spidercat) for ancestors and children

dbAllowed = 27 ' allowed: (taxa=1, itis=2, catlife = 4, gbif = 8, 16 = spidercat) for ancestors and children

templateOnly = False

sendingMode = 0

nPagesSent = 0

maxPagesSent = 20

If sendingMode <> 0 Then

result = MsgBox("Send Pages?", MsgBoxStyle.YesNoCancel)

If result <> MsgBoxResult.Yes Then

Me.Cursor = Cursors.Default

Exit Sub

End If

s1 = qlogin(urlWikiPedia)

sToken = gettoken(urlWikiPedia)

End If

pagesMade = New List(Of String)

'pagesToMake = New List(Of String)

For Each rec As String In ss

rec = rec.Trim

rec = rec.Replace(Chr(&HE2) & Chr(&H80) & Chr(&H8E), "")

rec = rec.Replace(Chr(&HE2), "")

rec = rec.Replace(Chr(&H80), "")

rec = rec.Replace(Chr(&H8E), "")

' get disambig pagetitle if it's in the file.

i1 = rec.IndexOf("(")

If i1 >= 0 Then

pageTitle = rec

rec = rec.Substring(0, i1)

Else

pageTitle = ""

End If

If rec.Trim <> "" Then

If rec.StartsWith("---") Then Exit For

m = loadMatch(rec, True)

If eqstr(m.taxon, rec) Then ' leaves out species single words

If pageTitle = "" Then pageTitle = getDisambig(m)

If pageTitle = "" Then pageTitle = m.taxon

makePage(m, dbRequired, dbAllowed, pageTitle, templateOnly, sendingMode, "") ' change to true to make a page that has a wikipediapageid, true to require itis

Else

outLog("not in taxa database: " & rec)

ds = getDS("select * from itis.taxonomic_units where complete_name = @parm1 and name_usage = 'valid';", rec)

If ds.Tables(0).Rows.Count > 0 Then

For Each dr As DataRow In ds.Tables(0).Rows

m = getItisTaxrec(dr, True)

If pageTitle = "" Then pageTitle = getDisambig(m)

If pageTitle = "" Then pageTitle = m.taxon

makePage(m, dbRequired, dbAllowed, pageTitle, templateOnly, sendingMode, "") ' change to true to make a page that has a wikipediapageid, true to require itis

Next dr

Else

ds = getDS("select * from gbif.tax where name = @parm1 and usable <> ''", rec)

If ds.Tables(0).Rows.Count > 0 Then

For Each dr As DataRow In ds.Tables(0).Rows

m = getTaxrecg(dr, True)

If pageTitle = "" Then pageTitle = getDisambig(m)

If pageTitle = "" Then pageTitle = m.taxon

makePage(m, dbRequired, dbAllowed, pageTitle, templateOnly, sendingMode, "") ' change to true to make a page that has a wikipediapageid, true to require itis

Next dr

Else

ds = getDS("select * from catlife.tax where name = @parm1 and namestatus = 'accepted name';", rec)

If ds.Tables(0).Rows.Count > 0 Then

For Each dr As DataRow In ds.Tables(0).Rows

m = getCatLifeTaxrec(dr, True)

If pageTitle = "" Then pageTitle = getDisambig(m)

If pageTitle = "" Then pageTitle = m.taxon

makePage(m, dbRequired, dbAllowed, pageTitle, templateOnly, sendingMode, "") ' change to true to make a page that has a wikipediapageid, true to require itis

Next dr

Else

ds = getDS("select * from spidercat where name = @parm1;", rec)

If ds.Tables(0).Rows.Count > 0 Then

For Each dr As DataRow In ds.Tables(0).Rows

m = getspiderTaxrec(dr, True)

If pageTitle = "" Then pageTitle = getDisambig(m)

If pageTitle = "" Then pageTitle = m.taxon

makePage(m, dbRequired, dbAllowed, pageTitle, templateOnly, sendingMode, "") ' change to true to make a page that has a wikipediapageid, true to require itis

Next dr

End If

End If

End If

End If

End If

End If

File.AppendAllText(outFile, madePage.ToString)

madePage = New StringBuilder

Next rec

madePage.Append("=======================================" & vbCrLf)

File.AppendAllText(outFile, madePage.ToString)

madePage = New StringBuilder

End Sub

Private Sub cmdList_Click(sender As Object, e As EventArgs) Handles cmdList.Click

' make wikipedia pages from a list of taxa.

Me.Cursor = Cursors.WaitCursor

loadTaxList()

Me.Cursor = Cursors.Default

End Sub

Private Sub cmdRandom_Click(sender As Object, e As EventArgs) Handles cmdRandom.Click

' generate a set of pages selected over the database randomly.

' it doesn't seem very random, but that's not important.

Dim ds As DataSet

Dim dr As DataRow

Dim m, m2 As New taxrec

Dim s As String

Dim i As Integer

Dim nPages As Integer

Dim dbRequired, dbAllowed As Integer

Dim templateOnly As Boolean

Dim result As MsgBoxResult

Dim sendingMode As Integer

Me.Cursor = Cursors.WaitCursor

File.WriteAllText(outFile, "")

madePage = New StringBuilder

pagesMade = New List(Of String)

dbRequired = 3 ' requires itis and taxa for initial page

dbAllowed = 27 ' allows taxa, itis, and catlife (taxa=1, itis=2, catlife = 4, gbif = 8, spidercat = 16) for ancestors and children

templateOnly = False

sendingMode = 0

Rnd(-1) : Randomize(1) ' repeatable sequence of randoms. Increment randomize parameter for new set

nPagesSent = 0

maxPagesSent = 3

nPages = maxPagesSent * 1.5 ' number from database (some will be excluded)

If sendingMode <> 0 Then

result = MsgBox("Send Pages?", MsgBoxStyle.YesNoCancel)

If result <> MsgBoxResult.Yes Then

Me.Cursor = Cursors.Default

Exit Sub

End If

qlogout(urlWikiPedia)

s = qlogin(urlWikiPedia)

If s <> "Success" Then

MsgBox("login failure")

Me.Cursor = Cursors.Default

Exit Sub

End If

sToken = gettoken(urlWikiPedia)

appendPageTitle("")

End If

ds = getDS("select * from taxatable where rank = 'species';")

For i1 As Integer = 0 To ds.Tables(0).Rows.Count - 1

' i = i1 for finish

i = Rnd() * ds.Tables(0).Rows.Count

dr = ds.Tables(0).Rows(i)

m = getTaxrec(dr, True)

makePage(m, dbRequired, dbAllowed, m.taxon, templateOnly, sendingMode, "") ' m, make existing pages, itis required

File.AppendAllText(outFile, madePage.ToString)

madePage = New StringBuilder

If nPagesSent >= maxPagesSent Then Exit For

Next i1

madePage.Append("=======================================" & vbCrLf)

File.AppendAllText(outFile, madePage.ToString)

madePage = New StringBuilder

Me.Cursor = Cursors.Default

End Sub

Function readrefs(rec As String) As List(Of refrec)

' gets the {{cite...}} references from the string rec and returns a list of refrecs

Dim rm As RegularExpressions.MatchCollection

Dim s As String

Dim sq() As String

Dim sv() As String

Dim ref As New refrec

Dim refs As New List(Of refrec)

rm = Regex.Matches(rec, "\{\{(.+?)\}\}", RegexOptions.Singleline Or RegexOptions.IgnoreCase)

For Each r As RegularExpressions.Match In rm

If r.Groups.Count > 1 Then

s = r.Groups(1).ToString

s = Regex.Replace(s, "(\[\^\+?)\|(.+?\]\])", "$1~~$2") ' change | inside wikilinks to ~~ temporarily

sq = s.Split("|")

If sq.Count >= 2 AndAlso s.Contains("=") Then

ref = New refrec

ref.pubtype = sq(0).Trim.Split(" ")(1)

For i As Integer = 1 To sq.Count - 1 ' skip first

sq(i) = sq(i).Replace("~~", "|")

sv = sq(i).Split("=")

sv(0) = LCase(sv(0).Trim)

sv(1) = sv(1).Trim

Select Case sv(0)

Case "title"

ref.title = sv(1)

Case "year"

ref.year = sv(1)

Case "date"

ref.year = sv(1)

Case "url"

ref.url = sv(1)

Case "series"

ref.series = sv(1)

Case "journal"

ref.journal = sv(1)

Case "volume"

ref.volume = sv(1)

Case "issue"

ref.issue = sv(1)

Case "chapter"

ref.chapter = sv(1)

Case "publisher"

ref.publisher = sv(1)

Case "pages", "page"

ref.pages = sv(1)

Case "isbn"

ref.isbn = sv(1)

Case "issn"

ref.issn = sv(1)

Case "doi"

ref.doi = sv(1)

Case "doi-access"

ref.doiaccess = sv(1)

Case "etc"

ref.etc = sv(1)

Case "comment"

ref.comment = sv(1)

Case "accessdate"

Case "displayauthors"

End Select

If sv(0).StartsWith("first") Then

If ref.afirst = "" Then ref.afirst = sv(1) Else ref.afirst &= "|" & sv(1)

End If

If sv(0).StartsWith("last") Then

If ref.alast = "" Then ref.alast = sv(1) Else ref.alast &= "|" & sv(1)

End If

If sv(0).StartsWith("editor") AndAlso sv(0).EndsWith("first") Then

If ref.efirst = "" Then ref.efirst = sv(1) Else ref.efirst &= "|" & sv(1)

End If

If sv(0).StartsWith("editor") AndAlso sv(0).EndsWith("last") Then

If ref.elast = "" Then ref.elast = sv(1) Else ref.elast &= "|" & sv(1)

End If

Next i

refs.Add(ref)

End If

End If

Next r

Return refs

End Function

Function crlf(source) As String

' convert lf to crlf

Dim page As String

page = source

page = page.Replace(vbCrLf, "~^~")

page = page.Replace(vbLf, "~^~")

page = page.Replace(vbCr, vbCrLf)

page = page.Replace("~^~", vbCrLf)

Return page

End Function

Function updatePage(tax As String, title As String, ByRef alteration As String) As String

' updates a page previously made by this bot

' alteration tells what changes were made for the wikipedia watchlist

Dim sPages As List(Of String)

Dim sUsers As List(Of String)

Dim original, current, page As String

Dim s, pageTitle As String

If title <> "" Then pageTitle = title Else pageTitle = tax

madePage = New StringBuilder

sPages = getWikiPages(title, urlWikiPedia, "max")

If sPages.Count > 0 Then

sUsers = getWikiUsers(title, urlWikiPedia, "max")

If sUsers.Count > 0 AndAlso eqstr(sUsers(sUsers.Count - 1), "qbugbot") Then ' only update pages created by qbugbot

original = crlf(sPages(sPages.Count - 1))

current = crlf(sPages(0))

page = current

s = botban(page, "qbugbot")

If s <> "" Then

outLog(tax & " - bot ban: " & s)

Return ""

End If

alteration = ""

s = current

page = checkTaxobox(tax, original, s)

If s <> page Then

If s.Contains("Speciesbox") Then alteration &= "speciesbox, " Else alteration &= "taxobox, "

s = page

End If

page = checkText(tax, original, s)

If s <> page Then

alteration &= "introduction/references, "

s = page

End If

page = refReplace(tax, original, s, "Further reading", "External links")

If s <> page Then

alteration &= "further reading, "

s = page

End If

page = addPhotos(tax, original, s)

If s <> page Then

alteration &= "photos, "

s = page

End If

page = removeTags(tax, s)

If s <> page Then

alteration &= "removed tags, "

s = page

End If

page = addcommons(tax, s)

If s <> page Then alteration &= "external links, "

If alteration.EndsWith(", ") Then alteration = alteration.Substring(0, alteration.Length - 2)

' fix faulty line spacing

page = Regex.Replace(page, "(\r\n)*\{\{Taxonbar", vbCrLf & vbCrLf & "{{Taxonbar")

page = Regex.Replace(page, "(\r\n)+==", vbCrLf & vbCrLf & "==")

page = page.Trim

If page = current.Trim Then

outLog(tax & " - no change: " & pageTitle)

alteration = ""

Return ""

Else

If alteration = "" Then Return ""

Return page

End If

End If

Else

outLog(tax & " - missing page or creator: " & pageTitle)

Return ""

End If

Return ""

End Function

Function addcommons(tax As String, page As String) As String

' add a commons-inline in external links

Dim i As Integer

If Regex.Match(page, "\{\{ *commons", RegexOptions.IgnoreCase).ToString = "" Then ' commons not already there

If Regex.Match(page, "\| *image *=", RegexOptions.IgnoreCase).ToString <> "" Or

Regex.Match(page, "\[\[ *file:", RegexOptions.IgnoreCase).ToString <> "" Then

i = LCase(page).IndexOf(vbCrLf & "{{taxonbar")

If i < 0 Then i = LCase(page).IndexOf(vbLf & "{{taxonbar")

If i >= 0 Then page = page.Substring(0, i) & vbCrLf & vbCrLf &

"==External links==" & vbCrLf &

"{{refbegin}}" & vbCrLf &

"* {{Commons category-inline|" & tax & "}}" & vbCrLf &

"{{refend}}" & vbCrLf &

page.Substring(i)

End If

End If

Return page

End Function

Function botban(page As String, botname As String) As String

' check and see if the bot is banned, return "" if it's OK.

'{{nobots}} Ban all compliant bots (shortcut)

'{{bots}} Allow all bots (shortcut)

'{{bots|allow=}} Ban all compliant bots not in the list

'{{bots|deny=}} Ban all compliant bots in the list

'{{bots|allow=SineBot,Legobot}}

'{{bots|allow=all}} Allow all bots

'{{bots|allow=none}} Ban all compliant bots

'{{bots|deny=all}} Ban all compliant bots

'{{bots|deny=none}}

Dim rbot As RegularExpressions.Match

Dim sq As New List(Of String)

Dim s As String

If Regex.Match(page, "\{\{ *nobots *\}\}", RegexOptions.IgnoreCase).Value <> "" Then Return "nobots"

rbot = Regex.Match(page, "(\{\{bots[ " & vbCrLf & "]*\|[ " & vbCrLf & "]*([a-z]+?)[ " &

vbCrLf & "]*=(([ " & vbCrLf & "]*,?[ " & vbCrLf & "]*[a-z]+?)*)[ " & vbCrLf & "]*\}\})",

RegexOptions.Singleline Or RegexOptions.IgnoreCase)

If rbot.Groups.Count >= 4 Then

s = rbot.Groups(3).Value ' comma separated botlist

sq = s.Split(",".ToCharArray, StringSplitOptions.RemoveEmptyEntries).ToList

For i1 As Integer = 0 To sq.Count - 1 : sq(i1) = LCase(sq(i1)).Trim : Next i1

If eqstr(rbot.Groups(2).Value.Trim, "deny") AndAlso

(sq.IndexOf(botname) >= 0 Or sq.IndexOf("all") >= 0) Then Return "denied"

If eqstr(rbot.Groups(2).Value.Trim, "allow") AndAlso

(sq.IndexOf(botname) < 0 Or sq.IndexOf("none") >= 0) Then Return "not allowed"

End If

Return ""

End Function

Function checkTaxobox(tax As String, original As String, current As String) As String

' update taxobox if it hasn't changed, but leave the original image

Dim s, s1 As String

Dim rMatch As RegularExpressions.Match

Dim m As taxrec

Dim page As String

Dim tx, oldtx, newtx As String

Dim search As String

Dim pageTitle As String

Dim dbAllowed, dbRequired As Integer

Dim newimage, tximage, imgsearch As String

page = current

search = "^(.+?\}\})[" & vbLf & vbCr & "]+?('{3,5}" & tax & ")" ' page start to end of taxobox

'search = "(\}\}[" & vbLf & vbCr & "]+?('{3,5}" & tax & ".+?)==Further)"

rMatch = Regex.Match(original, search, RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' get intro text through references in a string

If rMatch.Groups.Count = 3 Then

oldtx = rMatch.Groups(1).ToString

Else

Return current

End If

rMatch = Regex.Match(current, search, RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' get intro text through references in a string

If rMatch.Groups.Count = 3 Then

tx = rMatch.Groups(1).ToString

Else

Return current

End If

If tx.Replace(vbLf, "").Replace(" ", "") = oldtx.Replace(vbLf, "").Replace(" ", "") Then ' it has not been modified -- go ahead and update the text.

dbRequired = 0 ' 1 = taxa, 2 = itis, 4 = catlife, 8 = gbif, 16 = spidercat(andable)

dbAllowed = 27 ' allowed: itis and catlife (taxa=1, itis=2, catlife = 4, gbif = 8, 16 = spidercat) for ancestors and children

m = loadMatch(tax, True)

pageTitle = getDisambig(m)

If pageTitle = "" Then pageTitle = tax

If madePage.ToString = "" Then makePage(m, dbRequired, dbAllowed, pageTitle, False, 0, "")

s = madePage.ToString

rMatch = Regex.Match(s, "^===[=]+?" & tax & "[=]+?[" & vbCr & vbLf & "]{1}(.*)$", RegexOptions.Singleline Or RegexOptions.IgnoreCase)

s1 = rMatch.Groups(1).ToString

rMatch = Regex.Match(s1, search, RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' get citations in a string

If rMatch.Groups.Count = 3 Then

newtx = rMatch.Groups(1).ToString

newtx = newtx.Replace("reflist", "Reflist")

' keep the old image in the taxobox if it's there.

imgsearch = "^.+?((\| *image *=.+?)(\| *image.+?=.+?)?(\| *image.+?=.+?)?)\|"

rMatch = Regex.Match(newtx, imgsearch, RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' get image in taxobox (if any)

newimage = rMatch.Groups(1).Value

rMatch = Regex.Match(tx, imgsearch, RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' get image in taxobox (if any)

tximage = rMatch.Groups(1).Value

If tximage <> "" And newimage <> "" Then newtx = newtx.Replace(newimage, tximage)

If tx <> newtx Then page = current.Replace(tx, newtx)

End If

End If

Return page.Trim

End Function

Function checkText(tax As String, original As String, current As String) As String

Dim s, s1 As String

Dim rMatch As RegularExpressions.Match

Dim m As taxrec

Dim page As String

Dim tx, oldtx, newtx As String

Dim search As String

Dim pageTitle As String

Dim dbAllowed, dbRequired As Integer

page = current

search = "(\}\}[" & vbLf & vbCr & "]+?('{3,5}" & tax & ".+?)(==Further|==External|\{\{Taxonbar))"

'search = "(\}\}[" & vbLf & vbCr & "]+?('{3,5}" & tax & ".+?)==Further)"

rMatch = Regex.Match(original, search, RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' get intro text through references in a string

If rMatch.Groups.Count = 4 Then

oldtx = rMatch.Groups(2).ToString

oldtx = oldtx.Replace("reflist", "Reflist")

Else

Return current

End If

rMatch = Regex.Match(current, search, RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' get intro text through references in a string

If rMatch.Groups.Count = 4 Then

tx = rMatch.Groups(2).ToString

tx = tx.Replace("reflist", "Reflist")

Else

Return current

End If

If tx.Replace(vbLf, "").Replace(" ", "") = oldtx.Replace(vbLf, "").Replace(" ", "") Then ' it has not been modified -- go ahead and update the text.

dbRequired = 0 ' 1 = taxa, 2 = itis, 4 = catlife, 8 = gbif, 16 = spidercat(andable)

dbAllowed = 27 ' allowed: itis and catlife (taxa=1, itis=2, catlife = 4, gbif = 8, 16 = spidercat) for ancestors and children

m = loadMatch(tax, True)

pageTitle = getDisambig(m)

If pageTitle = "" Then pageTitle = tax

If madePage.ToString = "" Then makePage(m, dbRequired, dbAllowed, pageTitle, False, 0, "")

s = madePage.ToString

rMatch = Regex.Match(s, "^===[=]+?" & tax & "[=]+?[" & vbCr & vbLf & "]{1}(.*)$",

RegexOptions.Singleline Or RegexOptions.IgnoreCase)

s1 = rMatch.Groups(1).ToString

rMatch = Regex.Match(s1, search, RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' get citations in a string

If rMatch.Groups.Count = 4 Then

newtx = rMatch.Groups(2).ToString

If tx <> newtx Then page = current.Replace("reflist", "Reflist").Replace(tx, newtx)

End If

End If

Return page

End Function

Function addPhotos(tax As String, original As String, current As String) As String

Dim page As String

Dim ds As DataSet

Dim pic, pictax, picUpright As String

Dim dr As DataRow

page = current

If Regex.Match(page, "\| *image *=", RegexOptions.IgnoreCase).ToString <> "" Or

Regex.Match(page, "\[\[ *file:", RegexOptions.IgnoreCase).ToString <> "" Then Return current

'({{Automatic taxobox|{{Speciesbox|{{Taxobox.+?)

'\1\r\n| Image = asdf.jpg

' first one in taxobox

ds = getDS("select * from wikipics where taxon = @parm1", tax)

If ds.Tables(0).Rows.Count = 0 Then Return current

pic = ds.Tables(0).Rows(0)("wikititle")

pictax = ds.Tables(0).Rows(0)("taxon")

pic = pic.Replace("File:", "")

pic = "| image = " & pic

picUpright = ds.Tables(0).Rows(0)("upright")

If Not eqstr(tax, pictax) Then pic &= vbCrLf & "| caption = " & pictax & ""

If picUpright <> "" Then pic &= vbCrLf & "| upright = " & picUpright

page = Regex.Replace(page, "({{Automatic taxobox|{{Speciesbox|{{Taxobox.+?)", "$1" & vbCrLf & pic,

RegexOptions.Singleline Or RegexOptions.IgnoreCase)

' the rest underneath taxobox

For i1 As Integer = 1 To ds.Tables(0).Rows.Count - 1

dr = ds.Tables(0).Rows(i1)

pic = dr("wikititle")

If Not pic.StartsWith("File:") Then pic = "File:" & pic

pictax = dr("taxon")

If picUpright <> "" Then picUpright = "upright |"

page = Regex.Replace(page, "((\{\{Automatic taxobox|\{\{Speciesbox|\{\{Taxobox.+?).+?(\{\{.+?\}\})+?.*\}\}" & vbCrLf & ")",

"$1" & "" & pic & "" & vbCrLf,

RegexOptions.Singleline Or RegexOptions.IgnoreCase)

Next i1

Return page

End Function

Function removeTags(tax As String, current As String) As String

' remove orphan and underlink tags from current page

Dim page As String

Dim rm As RegularExpressions.Match

Dim k As Integer

Dim multi As String

page = current

page = Regex.Replace(page, "(\{\{Underlink.+?\}\})[\r\n]{0,2}", "", RegexOptions.Singleline Or RegexOptions.IgnoreCase)

page = Regex.Replace(page, "(\{\{Orphan.+?\}\})[\r\n]{0,2}", "", RegexOptions.Singleline Or RegexOptions.IgnoreCase)

multi = "(\{\{multiple issues.+?(\{\{.+?\}\})?[^\{\}]+?\}\})[\r\n]{0,2}"

rm = Regex.Match(page, multi, RegexOptions.Singleline Or RegexOptions.IgnoreCase)

k = Regex.Matches(rm.Value, "(\{\{)", RegexOptions.Singleline Or RegexOptions.IgnoreCase).Count

If k = 1 Then

page = Regex.Replace(page, multi, "", RegexOptions.Singleline Or RegexOptions.IgnoreCase)

ElseIf k = 2 Then

page = Regex.Replace(page, multi, rm.Groups(2).Value, RegexOptions.Singleline Or RegexOptions.IgnoreCase)

End If

Return page

End Function

Function refReplace(taxon As String, original As String, current As String, pubtype As String, pubtype2 As String) As String

' replace old references with new in a web page

' original is the original page as made by the bot at first

' current is the currently edited version of the page

' pubtype is "further reading", pubtype2 is "external links"

' external links gets merged with further reading and the external links section is deleted

Dim s As String

Dim refs As New List(Of refrec)

Dim oldrefs As New List(Of refrec)

Dim newrefs As New List(Of refrec)

Dim rMatch As RegularExpressions.Match

Dim ancestor As New List(Of taxrec)

Dim m As taxrec

Dim found As Integer

Dim page As String

Dim search, search2 As String

search = "(==[ ]?" & pubtype & "[ ]?==.+?refbegin\}\}(.+?)\{\{refend\}\})"

rMatch = Regex.Match(original, search, RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' get citations in a string

If rMatch.Groups.Count = 3 Then

oldrefs = readrefs(rMatch.Groups(2).ToString)

End If

' get original references in oldrefs

If pubtype2 <> "" Then ' count external links as further reading, add to oldrefs

search2 = search.Replace(pubtype, pubtype2)

rMatch = Regex.Match(original, search2, RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' get old citations in a string

If rMatch.Groups.Count = 3 Then

oldrefs.AddRange(readrefs(rMatch.Groups(2).ToString))

End If

End If

' get current references in refs

rMatch = Regex.Match(current, search, RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' get current citations in a string

If rMatch.Groups.Count = 3 Then

refs = readrefs(rMatch.Groups(2).ToString)

End If

' add any current external links to refs

If pubtype2 <> "" Then ' count external links as further reading, add to current refs

search2 = search.Replace(pubtype, pubtype2)

rMatch = Regex.Match(current, search2, RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' get citations in a string

If rMatch IsNot Nothing AndAlso rMatch.Groups.Count = 3 Then

refs.AddRange(readrefs(rMatch.Groups(2).ToString))

End If

End If

m = loadMatch(taxon, True)

ancestor = getancestors(m, 27, True, "phylum")

newrefs = getWikiRefs(ancestor)

' remove all the inline citations "refpub", etc., this is for "further reading". Otherwise they're duplicated both places.

For i As Integer = newrefs.Count - 1 To 0 Step -1

If LCase(newrefs(i).reftype).StartsWith("ref") Then

found = -1

' these are in the inline citations, so remove them from current further reading

For i1 As Integer = refs.Count - 1 To 0 Step -1

If newrefs(i).title = refs(i1).title OrElse

(newrefs(i).alast <> "" And newrefs(i).alast = refs(i1).alast And newrefs(i).year = refs(i1).year) Then

found = i ' newrefs(i) is found in refs. Remove it from refs

Exit For

End If

Next i1

If found >= 0 Then refs.RemoveAt(found) ' it was in the new inline citations.

newrefs.RemoveAt(i) ' remove inline citation from new list of further reading

End If

Next i

' remove any current references (refs) that are in the original version (oldrefs), to be replaced by those in newrefs

For i As Integer = refs.Count - 1 To 0 Step -1

found = -1

For Each ref As refrec In oldrefs

If refs(i).title = ref.title OrElse

(refs(i).alast <> "" And refs(i).alast = ref.alast And refs(i).year = ref.year) Then

found = i ' refs(i) is found in oldrefs. Remove it from refs

Exit For

End If

Next ref

If found >= 0 Then refs.RemoveAt(found) ' it was in the original version.

Next i

' add any existing references not in the original revision

For i As Integer = 0 To refs.Count - 1

found = -1

For Each ref As refrec In newrefs

If refs(i).title = ref.title OrElse

(refs(i).alast <> "" And refs(i).alast = ref.alast And refs(i).year = ref.year) Then

found = i

Exit For

End If

Next ref

If found < 0 Then ' ref added by someone else, not already in newrefs

newrefs.Add(refs(i))

End If

Next i

If newrefs.Count = 0 Then

s = vbCrLf

Else

s = vbCrLf & "==" & pubtype & "==" & vbCrLf & "{{refbegin}}" & vbCrLf

For i As Integer = 0 To newrefs.Count - 1

s &= "* " & citation(newrefs(i)) & vbCrLf

Next i

s &= "{{refend}}" & vbCrLf

End If

page = current

page = Regex.Replace(page, "\r\n(==" & pubtype2 & "==.+?refbegin\}\}(.+?)\{\{refend\}\})\r\n", vbCrLf,

RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' remove external links

page = Regex.Replace(page, "\r\n(==" & pubtype & "==.+? *\{\{refbegin.*?\}\}(.+?)\{\{refend\}\})\r\n", s,

RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' replace further reading

page = Regex.Replace(page, "\r\n\{\{(clear|-)\}\}", "",

RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' remove clear template

page = Regex.Replace(page, "\r\n\.+?", "",

RegexOptions.Singleline Or RegexOptions.IgnoreCase) ' remove eol references

page = Regex.Replace(page, "", "",

RegexOptions.Singleline Or RegexOptions.IgnoreCase)

Return page

End Function

Function taxFamily(mm As List(Of taxrec), toprank As String) As String

' returns "" if genus, family, and order taxonomy templates match mm.

Dim mrank As New List(Of String) ' list of tax templates ranks up to toprank

Dim mtax As New List(Of String) ' list of tax templates names to toprank

Dim parent, rank, tax As String

Dim pages As List(Of String)

Dim rmatch As RegularExpressions.Match

Dim i, k As Integer

Dim msg As String = ""

Dim s1 As String

If eqstr(mm(0).rank, "species") Then k = 1 Else k = 0

parent = mm(k).taxon

rank = ""

Do While rank = "" OrElse (Not itisRankID.ContainsKey(rank)) OrElse itisRankID(rank) >= itisRankID(toprank)

tax = parent

pages = getWikiPages("Template:Taxonomy/" & getTaxAmbig(tax), urlWikiPedia, 1)

If pages.Count > 0 Then

s1 = Regex.Match(pages(0), "(#REDIRECT .+?\]\])").ToString

If s1 <> "" Then Return mm(0).taxon & vbTab & s1

rmatch = Regex.Match(pages(0), "parent[ ]*=[ ]*(.+?)[\n\|\}]")

If rmatch.Groups.Count = 2 Then parent = rmatch.Groups(1).ToString.Trim

rmatch = Regex.Match(pages(0), "rank[ ]*=[ ]*(.+?)[\n|]")

If rmatch.Groups.Count = 2 Then rank = rmatch.Groups(1).ToString.Trim

If rank = "" Then Return mm(0).taxon & vbTab & "error - no rank" & vbTab & tax

Else

Return mm(0).taxon & vbTab & "missing template" & vbTab & tax

End If

rank = rank.Replace("familia", "family")

rank = rank.Replace("ordo", "order")

If mainRank.IndexOf(rank) >= 0 Then ' save the template name, rank

mrank.Add(LCase(rank))

mtax.Add(LCase(tax))

End If

Loop

For i1 As Integer = mainRank.Count - 1 To 0 Step -1

k = itisRankID(mainRank(i1))

If k < itisRankID(toprank) Then Exit For

If k <= 180 Then

i = mrank.IndexOf(mainRank(i1))

For i2 As Integer = 0 To mm.Count - 1

If eqstr(mm(i2).rank, mainRank(i1)) Then

If i < 0 Then

Return mm(i2).taxon & vbTab & "no template" & vbTab & mainRank(i1)

Else

If Not eqstr(mm(i2).taxon, mtax(i)) Then ' different taxa

Return mm(i2).taxon & vbTab & "different taxa" & vbTab & mtax(i) & vbTab & mainRank(i1)

End If

End If

End If

Next i2

End If

Next i1

Return ""

End Function

Private Sub cmdUpdate_Click(sender As Object, e As EventArgs) Handles cmdUpdate.Click

' update a page's references, etc.

' qbugbot 3

Dim tax As String

Dim pageTitle As String

Dim m As New taxrec

Dim s, s1 As String

Dim page As String

Dim k As Integer

Dim nPages As Integer

Dim nSent As Integer

Dim result As MsgBoxResult

Dim sendingMode As Integer

Dim alteration As String = ""

Dim dr As DataRow

Me.Cursor = Cursors.WaitCursor

File.WriteAllText(outFile, "")

sendingMode = 2 ' 2 = update only (1 = create only, 0 = no sending)

Rnd(-1) : Randomize(2) ' repeatable sequence of randoms. Increment randomize parameter for new set

nSent = 0

maxPagesSent = 20000

'nPages = maxPagesSent * 1.5 ' number from database (some will be excluded)

If sendingMode <> 0 Then

result = MsgBox("Send Pages?", MsgBoxStyle.YesNoCancel)

If result <> MsgBoxResult.Yes Then

Me.Cursor = Cursors.Default

Exit Sub

End If

qlogout(urlWikiPedia)

s = qlogin(urlWikiPedia)

If s <> "Success" Then

MsgBox("login failure")

Me.Cursor = Cursors.Default

Exit Sub

End If

sToken = gettoken(urlWikiPedia)

appendPageTitle("")

End If

Using ds As DataSet = getDS("select * from pagesmade where updated = '' and madeby = 'qbugbot';")

nPages = 20000

If nPages > ds.Tables(0).Rows.Count Then nPages = ds.Tables(0).Rows.Count

For i1 As Integer = 0 To nPages - 1

dr = ds.Tables(0).Rows(i1)

m = loadMatch(dr("taxon"), True)

'ss = File.ReadAllLines("c:\taxlist.txt")

'For i1 As Integer = 0 To ss.Count - 1

'If ss(i1).StartsWith("---") Then Exit For

'm = loadMatch(ss(i1), False)

If m.taxon <> "" Then

tax = m.taxon

pageTitle = getDisambig(m)

If pageTitle = "" Then pageTitle = tax

page = updatePage(tax, pageTitle, alteration)

If page <> "" Then

File.AppendAllText(outFile, vbCrLf & "=============" & tax & "================" &

vbCrLf & page & vbCrLf & vbCrLf)

If sendingMode <> 0 And nSent < maxPagesSent Then

If alteration <> "" Then alteration = "Page update: " & alteration

s1 = sendWikiPage(pageTitle, page, urlWikiPedia, alteration, sendingMode)

If s1 <> "" Then

nSent += 1

k = nonQuery("update pagesmade set updated = @parm1 where pagetitle = @parm2", Format(Now, "yyyy-MM-dd HH:mm:ss"), pageTitle)

If k > 1 Then Stop

If k = 0 Then outLog("database pagesmade not updated. pagetitle: " & pageTitle)

outLog("update: " & pageTitle & ", " & alteration)

Else

outLog("not sent: " & pageTitle)

End If

End If

If nSent >= maxPagesSent Then Exit For

Else

outLog("no update necessary: " & pageTitle)

k = nonQuery("update pagesmade set updated = @parm1 where pagetitle = @parm2", "Checked " & Format(Now, "yyyy-MM-dd HH:mm:ss"), pageTitle)

If k <> 1 Then outLog("cannot update pagesmade database: " & pageTitle & ", " & alteration)

End If

End If

Next i1

End Using

File.AppendAllText(outFile, "=========================================" & vbCrLf)

Me.Cursor = Cursors.Default

End Sub

Private Sub cmdEtc_Click(sender As Object, e As EventArgs) Handles cmdEtc.Click

' utility command button

Me.Cursor = Cursors.WaitCursor

formatChildList(False, 27)

Me.Cursor = Cursors.Default

End Sub

Sub selfredirect()

' reads a list of titles from the self-redir file and makes pages for redirect pages or delinks the recursive links.

' qbugbot 4

Dim m, m2 As New taxrec

Dim tax, lasttax As String

Dim mm As New List(Of taxrec)

Dim ss As List(Of String)

Dim sr As List(Of String)

Dim dbRequired, dbAllowed As Integer

Dim sendingMode As Integer

Dim n, n1, n2, n3 As Integer

Dim s As String

Dim replacePage As Boolean

Dim page, pagetitle, editsummary As String

Dim result As MsgBoxResult

maxPagesSent = 3

nPagesSent = 0

sendingMode = 0 ' 0 = no sending, 1 = create only, 2 = update possible

dbRequired = 0

dbAllowed = 27

If sendingMode <> 0 Then

result = MsgBox("Send Pages?", MsgBoxStyle.YesNoCancel)

If result <> MsgBoxResult.Yes Then

Me.Cursor = Cursors.Default

Exit Sub

End If

qlogout(urlWikiPedia)

s = qlogin(urlWikiPedia)

If s <> "Success" Then

MsgBox("login failure")

Me.Cursor = Cursors.Default

Exit Sub

End If

sToken = gettoken(urlWikiPedia)

End If

File.WriteAllText(outFile, "")

n = 0 : n1 = 0 : n2 = 0 : n3 = 0

tax = ""

ss = New List(Of String)

ss = File.ReadAllLines(My.Settings.redirlist).ToList

lasttax = ""

page = "" : pagetitle = "" : editsummary = ""

For i1 As Integer = 0 To ss.Count - 1

If nPagesSent >= maxPagesSent Then Exit For

If ss(i1).Trim.StartsWith("----") Then Exit For

sr = ss(i1).Split(vbTab.ToCharArray).ToList

If sr.Count >= 4 AndAlso eqstr(sr(0), "arthropoda") Then ' process a record

tax = sr(1).Split("(")(0)

If tax.StartsWith("List of") Then tax = tax.Split(" ")(2)

If tax <> lasttax And page <> "" Then

s = botban(page, "qbugbot")

If s <> "" Then

outLog(tax & " - bot ban: " & s)

File.AppendAllText(outFile, " - bot ban: " & s & vbCrLf & "=========================" & vbCrLf)

Else

If getDisambig(m2) <> "" Then Stop

nPagesSent += 1

s = sendWikiPage(pagetitle, page, urlWikiPedia, editsummary, sendingMode)

File.AppendAllText(outFile, "=========mod===" & pagetitle & "=============" & vbCrLf & page & vbCrLf & "=========================" & vbCrLf)

End If

page = "" : pagetitle = "" : editsummary = ""

End If

m = loadMatch(tax, True)

If m.taxon = "" Then Stop ' parent not found.

m2 = loadMatch(sr(3), True)

If m2.taxon = "" OrElse Not eqstr(m2.rank, sr(4)) Then ' child not found or different ranks. Remove the link

File.AppendAllText(outFile, "=======================" & vbCrLf & "Redirect page not in database (or different rank): " & sr(3) & vbCrLf)

replacePage = False

ElseIf m.rank = m2.rank Then ' probably synonyms

replacePage = False

ElseIf eqstr(m2.rank, "species") Then ' make page if not monotypic, else remove link

If Not eqstr(tax, lasttax) Then

mm = getChildren(m, False, 27)

End If

If mm.Count = 1 Then ' single child in database. remove link

replacePage = False

Else ' not monotypic - replace page

replacePage = True

End If

Else ' not species

If eqstr(m2.rank, "genus") Or eqstr(m2.rank, "family") Then ' make page

replacePage = True

End If

End If

If replacePage Then ' replace the redirect page, m2

If getDisambig(m2) <> "" Then Stop

' make sure it's a redirect

s = getWikiPage(m2.taxon, urlWikiPedia).ToLower

If Not s.Contains("#redirect") Then

outLog(m2.taxon & " - not a redirect page")

File.AppendAllText(outFile, "========= Not a redirect page: " & m2.taxon & vbCrLf &

"=========================" & vbCrLf)

Else

s = botban(page, "qbugbot")

If s <> "" Then

outLog(tax & " - bot ban: " & s)

File.AppendAllText(outFile, " - bot ban: " & s & vbCrLf & "=========================" & vbCrLf)

Else

makePage(m2, dbRequired, dbAllowed, sr(3), False, sendingMode, "qBugbot replaced self-redirect with article.")

File.AppendAllText(outFile, madePage.ToString)

madePage = New StringBuilder

End If

End If

Else ' remove link to self-redirect

If page = "" Then

page = getWikiPage(sr(1), urlWikiPedia)

If page = "" Then Stop

pagetitle = sr(1)

End If

s = page

page = page.Replace("" & sr(3) & "", sr(3))

page = Regex.Replace(page, "\[\[" & sr(3) & "\|(.+?)\]\]", "$1")

If s <> page Then

If editsummary = "" Then

editsummary = "Removed link to a self-redirect page."

Else

editsummary = "Removed links to self-redirect pages."

End If

Else

If editsummary = "" Then page = "" ' no change so far

End If

End If

lasttax = tax

End If

Next i1

If page <> "" Then ' last page

s = botban(page, "qbugbot")

If s <> "" Then

outLog(tax & " - bot ban: " & s)

File.AppendAllText(outFile, " - bot ban: " & s & vbCrLf & "=========================" & vbCrLf)

Else

If getDisambig(m2) <> "" Then Stop

nPagesSent += 1 : If nPagesSent <= maxPagesSent Or sendingMode = 0 Then

s = sendWikiPage(pagetitle, page, urlWikiPedia, editsummary, sendingMode)

File.AppendAllText(outFile, "=========mod===" & pagetitle & "=============" & vbCrLf & page & vbCrLf & "=========================" & vbCrLf)

End If

End If

End If

End Sub

Private Sub cmdRedir_Click(sender As Object, e As EventArgs) Handles cmdRedir.Click

Me.Cursor = Cursors.WaitCursor

selfredirect()

Me.Cursor = Cursors.Default

End Sub

End Class

' main.vb, by Robert Webster (CC BY-SA 3.0 US)

' various functions, global variables, main sub (startup)

Imports System.Net

Imports System.Net.Http

Imports System.Text

Imports System.Text.RegularExpressions

Imports System.Collections.Generic

Imports System.IO

Imports System.Data

Imports MySql.Data.MySqlClient

Imports Newtonsoft.Json

Imports Newtonsoft.Json.Linq

Public Module main

Structure refstruc

Dim used As Boolean

Dim shortref As String

Dim longref As String

End Structure

Public Class taxrec

Public rank As String

Public taxon As String

Public descr As String

Public taxid As String

Public parentid As String

Public imageCounter As Integer

Public childimageCounter As Integer

Public link As String

Public taxlink As String

Public authority As String

Public extinct As Boolean ' string in database

Public parentTsn As Integer ' not in database, used for list pages

Public catLifeID As String ' not in database, used for list pages

Public catLifeParentID As String ' not in database, used for list pages

Public gbifID As String ' not in database, used for list pages

Public gbifParent As String ' not in database, used for list pages

Public gbifUsable As String ' not in taxatable, in gbif

Public spiderID As Integer ' not in database, used for list pages

Public spiderParent As Integer ' not in database, used for list pages

Public spiderlink As String ' not in database, used for list pages

Public spiderdist As String ' not in database, used for list pages

Public iucnStatus As String ' not in taxatable, in iucn

Public iucnTrend As String ' not in taxatable, in iucn

Public iucnYear As String ' not in taxatable, in iucn

Public iucnID As String ' not in taxatable, in iucn

Public iucnVersion As String ' not in taxatable, in iucn

Public itistsn As Integer

' old wikirec stuff, now in oddinfo

Public synonyms As List(Of String)

Public synauth As List(Of String)

Public syresource As List(Of String)

Public wikipediaPageID As String

Public commonNames As List(Of String)

Public commonWikiLink As String

Public hodges As String

Public wikidataid As String

Public ambigLink As String

Public unimportant As Integer ' tells whether it's an autogenerated ancestor

Sub New()

rank = ""

taxon = ""

descr = ""

taxid = ""

parentid = ""

link = ""

taxlink = ""

authority = ""

catLifeID = ""

catLifeParentID = ""

gbifID = ""

gbifParent = ""

gbifUsable = ""

spiderlink = ""

spiderdist = ""

commonNames = New List(Of String)

ambigLink = ""

unimportant = 0

itistsn = 0

' old wikirec stuff, now in oddinfo

synonyms = New List(Of String)

synauth = New List(Of String)

syresource = New List(Of String)

wikipediaPageID = 0

commonWikiLink = ""

hodges = ""

wikidataid = ""

extinct = False

iucnStatus = ""

iucnTrend = ""

iucnYear = ""

iucnID = ""

iucnVersion = ""

End Sub

End Class

Class refrec

Public refid As Integer

Public reftype As String

Public pubtype As String

Public afirst As String

Public alast As String

Public efirst As String

Public elast As String

Public year As String

Public title As String

Public journal As String

Public publisher As String

Public series As String

Public volume As String

Public issue As String

Public chapter As String

Public pages As String

Public url As String

Public isbn As String

Public issn As String

Public doi As String

Public doiaccess As String

Public taxon As String

Public taxonExcept As String

Public bottomRank As Integer

Public updated As String

Public etc As String ' a set of "| a = b| c = d..."

Public urlAccessed As String ' last access date for cite web

Public comment As String ' a set of "| a = b| c = d..."

Sub New()

refid = 0

reftype = ""

pubtype = ""

afirst = ""

alast = ""

efirst = ""

elast = ""

year = ""

title = ""

journal = ""

publisher = ""

series = ""

volume = ""

issue = ""

chapter = ""

pages = ""

url = ""

isbn = ""

issn = ""

doi = ""

doiaccess = ""

taxon = ""

taxonExcept = ""

bottomRank = 0

etc = ""

updated = ""

urlAccessed = ""

End Sub

End Class

Structure imagerec

Dim imageid As Integer

Dim filename As String

Dim photodate As String

Dim dateadded As String

Dim modified As String

Dim taxonid As String

Dim gps As String

Dim elevation As String

Dim rating As Integer

Dim confidence As Integer

Dim remarks As String

Dim originalpath As String

Dim bugguide As String

Dim size As String

Dim location As String

Dim county As String

Dim state As String

Dim country As String

End Structure

Public maxlist As Integer = 100 ' how many in a list before you make a list page

Public maxColumn As Integer = 12 ' how many in a list before you use multiple columns

Public taxaConn As String ' mysql connection string

Public stubs As New Dictionary(Of String, String)(System.StringComparer.OrdinalIgnoreCase)

Public taxAmbig As New Dictionary(Of String, String)(System.StringComparer.OrdinalIgnoreCase)

Public itisRankID As New Dictionary(Of String, Integer)(System.StringComparer.OrdinalIgnoreCase)

Public itisRanks As New Dictionary(Of Integer, String)

Public pluralRank As New Dictionary(Of String, String)(System.StringComparer.OrdinalIgnoreCase)

Public mainRank As New List(Of String)

Public latinRank As New Dictionary(Of String, String)(System.StringComparer.OrdinalIgnoreCase)

Public locationID As New Dictionary(Of String, String)(System.StringComparer.OrdinalIgnoreCase)

Public numeral As New Dictionary(Of Integer, String)

Public urlWikiMedia As String = "https://commons.wikimedia.org/w/api.php"

Public urlWikiPedia As String = "https://en.wikipedia.org/w/api.php"

Public urlWikiData As String = "https://www.wikidata.org/w/api.php"

Public urlwikiSpecies As String = "https://species.wikimedia.org/w/api.php"

Public cookies As CookieContainer

Public handler As HttpClientHandler

Public qClient As HttpClient ' need these for cookies

Public outFile As String

Public botCreateMessage As String = "This article was created by the bot Qbugbot. " &

"For more information, see User:Qbugbot/info. " &

"For questions and comments, leave a message at User:Qbugbot/talk."

Public botCreateCategory As String = "Category:Articles created by Qbugbot"

Public sToken As String ' editing token

Sub main()

Dim ds As DataSet

taxaConn = My.Settings.taxaconn

outFile = My.Settings.outFile ' output file for pages

ds = getDS("select * from stubs order by taxon")

For Each dr As DataRow In ds.Tables(0).Rows

stubs.Add(dr("taxon"), "{{" & dr("stubname") & "-stub}}")

Next dr

numeral.Add(0, "zero")

numeral.Add(1, "one")

numeral.Add(2, "two")

numeral.Add(3, "three")

numeral.Add(4, "four")

numeral.Add(5, "five")

numeral.Add(6, "six")

numeral.Add(7, "seven")

numeral.Add(8, "eight")

numeral.Add(9, "nine")

locationID.Add("1", "Europe")

locationID.Add("2", "Africa")

locationID.Add("3", "temperate Asia")

locationID.Add("4", "tropical Asia")

locationID.Add("5", "Australasia")

locationID.Add("6", "the Pacific Ocean")

locationID.Add("7", "North America")

locationID.Add("8", "South America")

locationID.Add("9", "the Antarctic")

locationID.Add("10", "northern Europe")

locationID.Add("11", "Middle Europe")

locationID.Add("12", "southwestern Europe")

locationID.Add("13", "southeastern Europe")

locationID.Add("14", "eastern Europe")

locationID.Add("20", "northern Africa")

locationID.Add("21", "Macaronesia")

locationID.Add("22", "west tropical Africa")

locationID.Add("23", "west-central tropical Africa")

locationID.Add("24", "northeast Tropical Africa")

locationID.Add("25", "east tropical Africa")

locationID.Add("26", "south tropical Africa")

locationID.Add("27", "southern Africa")

locationID.Add("28", "the mid Atlantic Ocean")

locationID.Add("29", "the western Indian Ocean")

locationID.Add("30", "Siberia")

locationID.Add("31", "the Russian Far East")

locationID.Add("32", "Middle Asia")

locationID.Add("33", "Caucasus")

locationID.Add("34", "western Asia")

locationID.Add("35", "the Arabian Peninsula")

locationID.Add("36", "China")

locationID.Add("37", "Mongolia")

locationID.Add("38", "eastern Asia")

locationID.Add("40", "the Indian subcontinent")

locationID.Add("41", "Indo-China")

locationID.Add("42", "Malesia")

locationID.Add("43", "Papuasia")

locationID.Add("50", "Australia")

locationID.Add("51", "New Zealand")

locationID.Add("60", "the southwestern Pacific")

locationID.Add("61", "the south-central Pacific")

locationID.Add("62", "the northwestern Pacific")

locationID.Add("63", "the north-central Pacific")

locationID.Add("70", "subarctic America")

locationID.Add("71", "western Canada")

locationID.Add("72", "eastern Canada")

locationID.Add("73", "the northwestern United States")

locationID.Add("74", "the north-central United States")

locationID.Add("75", "the northeastern United States")

locationID.Add("76", "the southwestern United States")

locationID.Add("77", "the south-central United States")

locationID.Add("78", "the southeastern United States")

locationID.Add("79", "Mexico")

locationID.Add("80", "Central America")

locationID.Add("81", "Caribbean")

locationID.Add("82", "northern South America")

locationID.Add("83", "western South America")

locationID.Add("84", "Brazil")

locationID.Add("85", "southern South America")

locationID.Add("90", "the Subantarctic Islands")

locationID.Add("91", "the Antarctic continent")

' for template:taxonomy/ disambiguation

taxAmbig.Add("Abroma", "Abroma (cicada)")

taxAmbig.Add("Acanthocephala", "Acanthocephala (bug)")

taxAmbig.Add("Agathis", "Agathis (wasp)")

taxAmbig.Add("Apoda", "Apoda (moth)")

taxAmbig.Add("Anisotoma", "Anisotoma (beetle)")

taxAmbig.Add("Baloghia", "Baloghia (arachnid)")

taxAmbig.Add("Bremia", "Bremia (gall midge)")

taxAmbig.Add("Chrysopogon", "Chrysopogon (fly)")

taxAmbig.Add("Clusia", "Clusia (fly)")

taxAmbig.Add("Colocasia", "Colocasia (moth)")

taxAmbig.Add("Collinsia", "Collinsia(spider)")

taxAmbig.Add("Crossosoma", "Crossosoma (millipede)")

taxAmbig.Add("Ctenophora", "Ctenophora (fly)")

taxAmbig.Add("Danae", "Danae (beetle)")

taxAmbig.Add("Dasypogon", "Dasypogon (fly)")

taxAmbig.Add("Dictyoptera", "Dictyoptera (genus)")

taxAmbig.Add("Eremothera", "Eremothera (arachnid)")

taxAmbig.Add("Euclea", "Euclea (moth)")

taxAmbig.Add("Euthyneura", "Euthyneura (insect)")

taxAmbig.Add("Gesneria", "Gesneria (moth)")

taxAmbig.Add("Hubbardia", "Hubbardia (arachnid)")

taxAmbig.Add("Iris", "Iris (insect)")

taxAmbig.Add("Isotoma", "Isotoma (springtail)")

taxAmbig.Add("Lobopoda", "Lobopoda (beetle)")

taxAmbig.Add("Luperini", "Luperini (beetle)")

taxAmbig.Add("Malagasia", "Malagasia (cicada)")

taxAmbig.Add("Osbornia", "Osbornia (bug)")

taxAmbig.Add("Pellaea", "pellaea (bug)")

taxAmbig.Add("Pelophila", "Pelophila (beetle)")

taxAmbig.Add("Pentagramma", "Pentagramma (bug)")

taxAmbig.Add("Phaleria", "Phaleria (beetle)")

taxAmbig.Add("Platynota", "Platynota (moth)")

taxAmbig.Add("Podolasia", "Podolasia (beetle)")

taxAmbig.Add("Raphia", "Raphia (moth)")

taxAmbig.Add("Reichenbachia", "Reichenbachia (beetle)")

taxAmbig.Add("Rustia", "Rustia (cicada)")

taxAmbig.Add("Sagenista", "Sagenista (wasp)")

taxAmbig.Add("Scaphium", "Scaphium (beetle)")

taxAmbig.Add("Sida", "Sida (arthropod)")

taxAmbig.Add("Stelis", "Stelis (insect)")

taxAmbig.Add("Thesium", "Thesium (beetle)")

taxAmbig.Add("Thryallis", "Thryallis (beetle)")

taxAmbig.Add("Trichodesma", "Trichodesma (beetle)")

taxAmbig.Add("Trichopetalum", "Trichopetalum (millipede)")

itisRankID.Add("kingdom", 10)

itisRankID.Add("subkingdom", 20)

itisRankID.Add("infrakingdom", 25)

itisRankID.Add("superphylum", 27)

itisRankID.Add("phylum", 30)

itisRankID.Add("subphylum", 40)

itisRankID.Add("infraphylum", 45)

itisRankID.Add("superclass", 50)

itisRankID.Add("class", 60)

itisRankID.Add("subclass", 70)

itisRankID.Add("infraclass", 80)

itisRankID.Add("superorder", 90)

itisRankID.Add("order", 100)

itisRankID.Add("suborder", 110)

itisRankID.Add("infraorder", 120)

itisRankID.Add("parvorder", 122)

itisRankID.Add("nanorder", 123)

itisRankID.Add("section", 124)

itisRankID.Add("subsection", 126)

itisRankID.Add("superfamily", 130)

itisRankID.Add("epifamily", 135)

itisRankID.Add("family", 140)

itisRankID.Add("subfamily", 150)

itisRankID.Add("supertribe", 155)

itisRankID.Add("tribe", 160)

itisRankID.Add("subtribe", 170)

itisRankID.Add("genus", 180)

itisRankID.Add("subgenus", 190)

itisRankID.Add("species", 220)

itisRankID.Add("subspecies", 230)

' add latin ranks (where different)

itisRankID.Add("regnum", 10)

itisRankID.Add("subregnum", 20)

itisRankID.Add("infraregnum", 25)

itisRankID.Add("superclassis", 50)

itisRankID.Add("classis", 60)

itisRankID.Add("subclassis", 70)

itisRankID.Add("infraclassis", 80)

itisRankID.Add("superordo", 90)

itisRankID.Add("ordo", 100)

itisRankID.Add("subordo", 110)

itisRankID.Add("infraordo", 120)

itisRankID.Add("parvordo", 122)

itisRankID.Add("nanordo", 123)

itisRankID.Add("sectio", 124)

itisRankID.Add("subsectio", 126)

itisRankID.Add("superfamilia", 130)

itisRankID.Add("epifamilia", 135)

itisRankID.Add("familia", 140)

itisRankID.Add("subfamilia", 150)

itisRankID.Add("supertribus", 155)

itisRankID.Add("tribus", 160)

itisRankID.Add("subtribus", 170)

itisRanks.Add(10, "kingdom")

itisRanks.Add(20, "subkingdom")

itisRanks.Add(25, "infrakingdom")

itisRanks.Add(27, "superphylum")

itisRanks.Add(30, "phylum")

itisRanks.Add(40, "subphylum")

itisRanks.Add(45, "infraphylum")

itisRanks.Add(50, "superclass")

itisRanks.Add(60, "class")

itisRanks.Add(70, "subclass")

itisRanks.Add(80, "infraclass")

itisRanks.Add(90, "superorder")

itisRanks.Add(100, "order")

itisRanks.Add(110, "suborder")

itisRanks.Add(120, "infraorder")

itisRanks.Add(124, "section")

itisRanks.Add(126, "subsection")

itisRanks.Add(130, "superfamily")

itisRanks.Add(135, "epifamily")

itisRanks.Add(140, "family")

itisRanks.Add(150, "subfamily")

itisRanks.Add(155, "supertribe")

itisRanks.Add(160, "tribe")

itisRanks.Add(170, "subtribe")

itisRanks.Add(180, "genus")

itisRanks.Add(190, "subgenus")

itisRanks.Add(220, "species")

itisRanks.Add(230, "subspecies")

pluralRank.Add("class", "classes")

pluralRank.Add("family", "families")

pluralRank.Add("epifamily", "epifamilies")

pluralRank.Add("genus", "genera")

pluralRank.Add("infraclass", "infraclasses")

pluralRank.Add("infrakingdom", "infrakingdoms")

pluralRank.Add("infraorder", "infraorders")

pluralRank.Add("infraphylum", "infraphylums")

pluralRank.Add("order", "orders")

pluralRank.Add("phylum", "phylums")

pluralRank.Add("section", "sections")

pluralRank.Add("species", "species")

pluralRank.Add("subclass", "subclasses")

pluralRank.Add("subfamily", "subfamilies")

pluralRank.Add("subgenus", "subgenera")

pluralRank.Add("subkingdom", "subkingdoms")

pluralRank.Add("suborder", "suborders")

pluralRank.Add("subphylum", "subphylums")

pluralRank.Add("subsection", "subsections")

pluralRank.Add("subspecies", "subspecies")

pluralRank.Add("subtribe", "subtribes")

pluralRank.Add("superclass", "superclasses")

pluralRank.Add("superfamily", "superfamilies")

pluralRank.Add("superorder", "superorders")

pluralRank.Add("superphylum", "superphylums")

pluralRank.Add("supertribe", "supertribes")

pluralRank.Add("tribe", "tribes")

pluralRank.Add("kingdom", "kingdoms")

mainRank.Add("phylum")

mainRank.Add("class")

mainRank.Add("order")

mainRank.Add("order")

mainRank.Add("family")

mainRank.Add("genus")

mainRank.Add("species")

mainRank.Add("subspecies")

latinRank.Add("class", "classis")

latinRank.Add("cohort", "cohort")

latinRank.Add("division", "divisio")

latinRank.Add("domain", "domain")

latinRank.Add("epifamily", "epifamilia")

latinRank.Add("family", "familia")

latinRank.Add("form", "forma")

latinRank.Add("genus", "genus")

latinRank.Add("grandorder", "grandordo")

latinRank.Add("infraclass", "infraclassis")

latinRank.Add("infrakingdom", "infraregnum")

latinRank.Add("infralegion", "infralegio")

latinRank.Add("infraorder", "infraordo")

latinRank.Add("infraphylum", "infraphylum")

latinRank.Add("infratribe", "infratribus")

latinRank.Add("kingdom", "regnum")

latinRank.Add("legion", "legio")

latinRank.Add("magnorder", "magnordo")

latinRank.Add("microphylum", "microphylum")

latinRank.Add("microrder", "micrordo")

latinRank.Add("mirorder", "mirordo")

latinRank.Add("nanophylum", "nanophylum")

latinRank.Add("nanorder", "nanordo")

latinRank.Add("order", "ordo")

latinRank.Add("parafamily", "parafamilia")

latinRank.Add("parvorder", "parvordo")

latinRank.Add("phylum", "phylum")

latinRank.Add("section", "sectio")

latinRank.Add("species", "species")

latinRank.Add("subclass", "subclassis")

latinRank.Add("subcohort", "subcohort")

latinRank.Add("subdivision", "subdivisio")

latinRank.Add("subfamily", "subfamilia")

latinRank.Add("subgenus", "subgenus")

latinRank.Add("subkingdom", "subregnum")

latinRank.Add("sublegion", "sublegio")

latinRank.Add("suborder", "subordo")

latinRank.Add("subphylum", "subphylum")

latinRank.Add("subsection", "subsectio")

latinRank.Add("subspecies", "subspecies")

latinRank.Add("subtribe", "subtribus")

latinRank.Add("superclass", "superclassis")

latinRank.Add("supercohort", "supercohort")

latinRank.Add("superdivision", "superdivisio")

latinRank.Add("superdomain", "superdomain")

latinRank.Add("superfamily", "superfamilia")

latinRank.Add("superkingdom", "superregnum")

latinRank.Add("superlegion", "superlegio")

latinRank.Add("superorder", "superordo")

latinRank.Add("superphylum", "superphylum")

latinRank.Add("supertribe", "supertribus")

latinRank.Add("tribe", "tribus")

latinRank.Add("variety", "varietas")

Application.Run(frmMain)

End Sub

Function singular(s As String) As String

' converts most (not all) plural nouns to singular

Dim s1 As String

s1 = s

' this line makes "singular" a nongeneral function

If s1.Contains(" and ") Or s1.Contains(", ") Or s1.Contains(" & ") Then Return s1

If s1.EndsWith("is") Or s1.EndsWith("us") Then Return s1 ' not general, but works for common names.

If s1 = "barracks" Or

s1 = "cantus" Or

s1 = "chassis" Or

s1 = "corps" Or

s1 = "debris" Or

s1 = "diabetes" Or

s1 = "gallows" Or

s1 = "headquarters" Or

s1 = "herpes" Or

s1 = "mumps" Or

s1 = "news" Or

s1 = "nexus" Or

s1 = "rabies" Or

s1 = "rhinoceros" Or

s1 = "series" Or

s1 = "species" Or

s1 = "testes" Or

s1 = "thrips" Then Return s1

If s = s1 Then s1 = s1.Replace("atlases", "atlas") Else Return s1

If s = s1 Then s1 = s1.Replace("cookies", "cookie") Else Return s1

If s = s1 Then s1 = s1.Replace("corpuses", "corpus") Else Return s1

If s = s1 Then s1 = s1.Replace("curves", "curve") Else Return s1

If s = s1 Then s1 = s1.Replace("foes", "foe") Else Return s1

If s = s1 Then s1 = s1.Replace("genera", "genus") Else Return s1

If s = s1 Then s1 = s1.Replace("genies", "genie") Else Return s1

If s = s1 Then s1 = s1.Replace("hooves", "hoof") Else Return s1

If s = s1 Then s1 = s1.Replace("leaves", "leaf") Else Return s1

If s = s1 Then s1 = s1.Replace("loaves", "loaf") Else Return s1

If s = s1 Then s1 = s1.Replace("niches", "niche") Else Return s1

If s = s1 Then s1 = s1.Replace("octopuses", "octopus") Else Return s1

If s = s1 Then s1 = s1.Replace("opuses", "opus") Else Return s1

If s = s1 Then s1 = s1.Replace("penises", "penis") Else Return s1

If s = s1 Then s1 = s1.Replace("testes", "testis") Else Return s1

If s = s1 Then s1 = s1.Replace("waves", "wave") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "([nrlm]ese|deer|fish|sheep|measles|ois|pox|media|ss)$", "$1") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "^(sea[- ]bass)$", "$1") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(s)tatuses$", "$1tatus") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(f)eet$", "$1oot") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(t)eeth$", "$1ooth") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "^(.*)(menu)s$", "$1\2") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(quiz)zes$", "$\1") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(matr)ices$", "$1ix") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(vert|ind)ices$", "$1ex") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "^(ox)en", "$1") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(alias)(es)*$", "$1") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(alumn|bacill|cact|foc|fung|nucle|radi|stimul|syllab|termin|viri?)i$", "$1us") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "([ftw]ax)es", "$1") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(cris|ax|test)es$", "$1is") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(shoe|slave)s$", "$1") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(o)es$", "$1") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "ouses$", "ouse") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "([^a])uses$", "\1us") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "([m|l])ice$", "$1ouse") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(x|ch|ss|sh)es$", "$1") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(m)ovies$", "$1\2ovie") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(s)eries$", "$1\2eries") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "([^aeiouy]|qu)ies$", "$1y") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "([lr])ves$", "$1f") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(tive)s$", "$1") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(hive)s$", "$1") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(drive)s$", "$1") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "([^fo])ves$", "$1fe") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(^analy)ses$", "$1sis") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(analy|diagno|^ba|(p)arenthe|(p)rogno|(s)ynop|(t)he)ses$", "$1\2sis") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "([ti])a$", "$1um") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(p)eople$", "$1\2erson") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(m)en$", "$1an") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(c)hildren$", "$1\2hild") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "(n)etherlands$", "$1\2etherlands") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "eaus$", "eau") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "^(.*us)$", "$1") Else Return s1

If s = s1 Then s1 = Regex.Replace(s1, "s$", "")

Return s1

End Function

Function getLowerRank(rank As String) As String

' returns the next lower main rank

If rank = "" Then Return ""

For i1 As Integer = 0 To mainRank.Count - 1

If itisRankID(mainRank(i1)) > itisRankID(rank) Then Return mainRank(i1)

Next i1

Return ""

End Function

Function getHigherRank(rank As String) As String

' returns the next higher main rank

If rank = "" Then Return ""

For i1 As Integer = mainRank.Count - 1 To 0 Step -1

If itisRankID(mainRank(i1)) < itisRankID(rank) Then Return mainRank(i1)

Next i1

Return ""

End Function

Function getDS(ByVal scmd As String,

Optional ByRef parm1 As Object = "",

Optional ByRef parm2 As Object = "",

Optional ByRef parm3 As Object = "",

Optional ByRef parm4 As Object = "",

Optional ByRef parm5 As Object = "") As DataSet

' returns ds, uses @parm1, @parm2, etc. in query

Dim cmd As MySqlCommand = Nothing

Dim da As New MySqlDataAdapter

Dim ds As New DataSet

ds.Clear()

Try

Using conn As New MySqlConnection(taxaConn)

conn.Open()

cmd = New MySqlCommand(scmd, conn)

cmd.Parameters.AddWithValue("@parm1", parm1)

cmd.Parameters.AddWithValue("@parm2", parm2)

cmd.Parameters.AddWithValue("@parm3", parm3)

cmd.Parameters.AddWithValue("@parm4", parm4)

cmd.Parameters.AddWithValue("@parm5", parm5)

da.SelectCommand = cmd

da.Fill(ds)

cmd.Dispose()

End Using

Catch ex As Exception

MsgBox("Error, getDS: " & ex.Message)

If cmd IsNot Nothing Then cmd.Dispose()

Return Nothing

End Try

Return ds

End Function

Function nonQuery(ByVal scmd As String,

Optional ByRef parm1 As Object = "", Optional ByRef parm2 As Object = "",

Optional ByRef parm3 As Object = "", Optional ByRef parm4 As Object = "",

Optional ByRef parm5 As Object = "", Optional ByRef parm6 As Object = "",

Optional ByRef parm7 As Object = "", Optional ByRef parm8 As Object = "",

Optional ByRef parm9 As Object = "") As Object

' does a nonquery database call. uses @parm1 and @parm2 in query

Dim cmd As MySqlCommand = Nothing

Dim i As Integer

Try

Using conn As New MySqlConnection(taxaConn)

conn.Open()

cmd = New MySqlCommand(scmd, conn)

cmd.Parameters.AddWithValue("@parm1", parm1)

cmd.Parameters.AddWithValue("@parm2", parm2)

cmd.Parameters.AddWithValue("@parm3", parm3)

cmd.Parameters.AddWithValue("@parm4", parm4)

cmd.Parameters.AddWithValue("@parm5", parm5)

cmd.Parameters.AddWithValue("@parm6", parm6)

cmd.Parameters.AddWithValue("@parm7", parm7)

cmd.Parameters.AddWithValue("@parm8", parm8)

cmd.Parameters.AddWithValue("@parm9", parm9)

i = cmd.ExecuteNonQuery

cmd.Dispose()

Return i

End Using

Catch ex As Exception

MsgBox("Error, nonQuery: " & ex.Message)

If cmd IsNot Nothing Then cmd.Dispose()

Return 0

End Try

End Function

Function getScalar(ByVal scmd As String,

Optional ByRef parm1 As Object = "", Optional ByRef parm2 As Object = "",

Optional ByRef parm3 As Object = "") As Object

' returns scalar query result, uses @parm1 and @parm2 in query

Dim cmd As MySqlCommand = Nothing

Dim q As Object

Try

Using conn As New MySqlConnection(taxaConn)

conn.Open()

cmd = New MySqlCommand(scmd, conn)

cmd.Parameters.AddWithValue("@parm1", parm1)

cmd.Parameters.AddWithValue("@parm2", parm2)

cmd.Parameters.AddWithValue("@parm3", parm3)

q = cmd.ExecuteScalar

If IsDBNull(q) OrElse q Is Nothing Then

Return ""

Else

Return q

End If

End Using

Catch ex As Exception

MsgBox("Error, getScalar: " & ex.Message)

If cmd IsNot Nothing Then cmd.Dispose()

Return Nothing

End Try

End Function

Function getTaxrecByID(ByVal taxid As String, addon As Boolean) As List(Of taxrec)

' gbif ids start with g: g1234, for example.

Dim ds As New DataSet

Dim m As New taxrec

Dim matches As New List(Of taxrec)

If taxid = "" Then Return matches

If eqstr(taxid.Substring(0, 1), "g") Then ' gbif database

ds = getDS("select * from gbif.tax where taxid = @parm1 and usable <> '';",

taxid.Substring(1).Trim)

'ds = getDS("select * from gbif.tax join taxa.gbifplus using (taxid) where taxid = @parm1 and usable <> '';",

' taxid.Substring(1).Trim)

If ds IsNot Nothing Then

For Each dr As DataRow In ds.Tables(0).Rows

m = getTaxrecg(dr, addon)

matches.Add(m)

Next dr

End If

Else ' taxatable database

ds = getDS("select * from taxatable where taxid = @parm1", taxid)

If ds IsNot Nothing Then

For Each dr As DataRow In ds.Tables(0).Rows

m = getTaxrec(dr, addon)

matches.Add(m)

Next dr

End If

End If

Return matches

End Function

Function getTaxrec(ByRef dr As DataRow, addon As Boolean) As taxrec

Dim match As New taxrec

' load drow into match

If IsDBNull(dr("rank")) Then match.rank = "" Else match.rank = dr("rank")

If IsDBNull(dr("taxon")) Then match.taxon = "" Else match.taxon = dr("taxon")

If IsDBNull(dr("descr")) Then match.descr = "" Else match.descr = dr("descr")

If IsDBNull(dr("taxid")) Then match.taxid = "" Else match.taxid = dr("taxid")

If IsDBNull(dr("parentid")) Then match.parentid = "" Else match.parentid = dr("parentid")

If IsDBNull(dr("imagecounter")) Then match.imageCounter = 0 Else match.imageCounter = dr("imagecounter")

If IsDBNull(dr("childimagecounter")) Then match.childimageCounter = 0 Else match.childimageCounter = dr("childimagecounter")

If IsDBNull(dr("link")) Then match.link = "" Else match.link = dr("link")

If IsDBNull(dr("taxlink")) Then match.taxlink = "" Else match.taxlink = dr("taxlink")

If IsDBNull(dr("authority")) Then match.authority = "" Else match.authority = dr("authority")

match.authority = match.authority.Replace(" and ", " & ")

If IsDBNull(dr("extinct")) OrElse dr("extinct") = "" Then match.extinct = False Else match.extinct = True ' yes or extinct (or anything else) = true

If addon Then taxrecAddon(match)

Return match

End Function

Function getTaxrecg(ByRef dr As DataRow, addon As Boolean) As taxrec

' get a taxref from gbif database

Dim match As New taxrec

Dim matches As New List(Of taxrec)

Dim vnames As New List(Of String)

Dim taxid As String

Dim ds As DataSet

Dim s As String

Dim ss() As String

If IsDBNull(dr("taxid")) Then taxid = "" Else taxid = dr("taxid")

If taxid <> "" Then match.taxid = "g" & taxid ' gbif id prefix

' load dr into match

If IsDBNull(dr("rank")) Then match.rank = "" Else match.rank = dr("rank")

If IsDBNull(dr("name")) Then match.taxon = "" Else match.taxon = dr("name")

If IsDBNull(dr("parent")) Then match.parentid = "" Else match.parentid = "g" & dr("parent")

If IsDBNull(dr("authority")) Then match.authority = "" Else match.authority = dr("authority")

match.authority = match.authority.Replace(" and ", " & ")

If IsDBNull(dr("usable")) Then match.gbifUsable = "" Else match.gbifUsable = dr("usable")

' get image counters and links, if possible

ds = getDS("select * from gbifplus where taxid = @parm1", taxid)

For Each dr2 As DataRow In ds.Tables(0).Rows

If IsDBNull(dr2("imagecounter")) Then match.imageCounter = 0 Else match.imageCounter = dr2("imagecounter")

If IsDBNull(dr2("childimagecounter")) Then match.childimageCounter = 0 Else match.childimageCounter = dr2("childimagecounter")

If IsDBNull(dr2("link")) Then match.link = "" Else match.link = dr2("link")

Next dr2

' get common names from oddinfo

ds = getDS("select * from oddinfo where name = @parm1", match.taxon)

For Each dr2 As DataRow In ds.Tables(0).Rows

If dr2("commonnames") <> "" Then

s = dr2("commonnames")

ss = s.Split("|")

If ss.Count >= 1 AndAlso ss(0) <> "" Then

match.commonNames = ss.ToList

End If

Exit For

End If

Next dr2

' get descr from taxatable, if possible

ds = getDS("select * from taxatable where taxon = @parm1", match.taxon)

For Each dr2 As DataRow In ds.Tables(0).Rows

If dr2("descr") <> "" Then

match.descr = dr2("descr")

Exit For

End If

Next dr2

If addon Then taxrecAddon(match)

If match.taxlink = "" Then match.taxlink = "https://www.gbif.org/species/" & match.taxid.Substring(1) ' no "g"

Return match

End Function

Sub getCatLifeTaxByID(ByVal taxid As String, ByRef match As taxrec)

Dim dset As New DataSet

dset = getDS("select * from catlife.tax where taxid = @parm1 limit 1;", taxid)

If dset IsNot Nothing AndAlso dset.Tables(0).Rows.Count >= 1 Then

match = getCatLifeTaxrec(dset.Tables(0).Rows(0), True)

Else

match = New taxrec

End If

End Sub

Function getGbifVernacular(taxid As String, toprank As String) As List(Of String)

' returns a list of gbif vernacular names

' upCount tells how far up the ancestry to go, "" for no ancestors

Dim tax As String

Dim ds As DataSet

Dim s As String

Dim k As Integer

Dim rank, parent As String

Dim vNames As New List(Of String)

If Not taxid.StartsWith("g") Then Return vNames ' empty list - not gbif

tax = taxid.Substring(1) ' no "g"

Do While vNames.Count = 0 And k <= 10

ds = getDS("select * from gbif.tax where taxid = @parm1", tax)

parent = ds.Tables(0).Rows(0)("parent")

rank = ds.Tables(0).Rows(0)("rank")

ds = getDS("select * from gbif.vernacularname where taxid = @parm1 and language = 'en'", tax)

If ds IsNot Nothing Then

For Each dr As DataRow In ds.Tables(0).Rows

s = dr("vernacularname")

If vNames.IndexOf(s) < 0 Then vNames.Add(LCase(s))

Next dr

End If

If Not itisRankID.ContainsKey(toprank) OrElse Not itisRankID.ContainsKey(rank) OrElse

itisRankID(rank) < itisRankID(toprank) Then Exit Do ' stop at toprank

tax = parent

k += 1

Loop

Return vNames

End Function

Sub taxrecAddon(ByRef m As taxrec)

' load up the non-database things into m

Dim s As String

Dim k As Integer

Dim ss() As String

Dim ds As DataSet

Dim dr As DataRow

Dim catRank As String

Dim vNames As List(Of String)

s = getScalar("select is_extant from paleo.tax where taxon_name = @parm1", m.taxon)

If eqstr(s, "extinct") Then m.extinct = True

If m.itistsn = 0 Then

ds = getDS("select * from itis.taxonomic_units where name_usage = 'valid' and kingdom_id = 5 and complete_name = @parm1", m.taxon)

If ds.Tables(0).Rows.Count = 1 Then

m.itistsn = ds.Tables(0).Rows(0)("tsn")

m.parentTsn = ds.Tables(0).Rows(0)("parent_tsn")

End If

Else

If m.parentTsn = 0 Then

k = getScalar("select parent_tsn from itis.taxonomic_units where tsn = @parm1", m.itistsn)

'If IsNumeric(v) Then m.parentTsn = v

m.parentTsn = k

End If

End If

If m.catLifeID = "" Then

m.catLifeParentID = ""

catRank = m.rank

If eqstr(catRank, "Subspecies") Then catRank = "Infraspecies"

ds = getDS("select * from catlife.tax where name = @parm1 and rank = @parm2", m.taxon, catRank)

If ds.Tables(0).Rows.Count = 1 Then

dr = ds.Tables(0).Rows(0)

If Not IsDBNull(dr("author")) AndAlso m.authority = "" Then m.authority = dr("author")

m.authority = m.authority.Replace(" and ", " & ")

If Not IsDBNull(dr("taxid")) Then m.catLifeID = dr("taxid")

If Not IsDBNull(dr("parent")) Then m.catLifeParentID = dr("parent")

End If

End If

If m.gbifID = "" Or m.gbifID = "0" Then

m.gbifParent = ""

ds = getDS("select * from gbif.tax where name = @parm1 and rank = @parm2 and usable <> ''",

m.taxon, m.rank)

'ds = getDS("select * from gbif.tax join taxa.gbifplus using (taxid) where name = @parm1 and rank = @parm2 and usable <> ''",

' m.taxon, m.rank) ' and status = 'accepted'

If ds.Tables(0).Rows.Count = 1 Then

dr = ds.Tables(0).Rows(0)

If Not IsDBNull(dr("authority")) AndAlso m.authority = "" Then m.authority = dr("authority")

m.authority = m.authority.Replace(" and ", " & ")

If Not IsDBNull(dr("taxid")) Then m.gbifID = dr("taxid")

If Not IsDBNull(dr("parent")) Then m.gbifParent = dr("parent")

If Not IsDBNull(dr("usable")) Then m.gbifUsable = dr("usable")

'If m.gbifUsable = "extinct" Then ' ignore extinct in gbif -- it's unreliable.

End If

End If

If m.spiderID = 0 Then

m.spiderParent = 0

ds = getDS("select * from spidercat where name = @parm1 and rank = @parm2", m.taxon, m.rank)

If ds.Tables(0).Rows.Count = 1 Then

dr = ds.Tables(0).Rows(0)

If Not IsDBNull(dr("authority")) AndAlso m.authority = "" Then m.authority = dr("authority")

m.authority = m.authority.Replace(" and ", " & ")

If Not IsDBNull(dr("idq")) Then m.spiderID = dr("idq")

If Not IsDBNull(dr("parentid")) Then m.spiderParent = dr("parentid")

If Not IsDBNull(dr("url")) Then m.spiderlink = dr("url")

If Not IsDBNull(dr("distribution")) Then m.spiderdist = dr("distribution")

End If

End If

m.iucnStatus = ""

m.iucnTrend = ""

m.iucnYear = ""

m.iucnID = ""

m.iucnVersion = ""

ds = getDS("select * from iucn where name = @parm1;", m.taxon)

If ds.Tables(0).Rows.Count = 1 Then

dr = ds.Tables(0).Rows(0)

m.iucnStatus = dr("status")

m.iucnTrend = dr("populationtrend")

m.iucnYear = dr("yearassessed")

m.iucnID = dr("speciesid")

m.iucnVersion = dr("criteriaversion")

End If

m.commonNames = New List(Of String)

If m.taxid.StartsWith("g") Then ' gbif

vNames = getGbifVernacular(m.taxid, "")

If vNames.Count > 0 Then m.commonNames = vNames

End If

' get the old wikirec (now part of taxrec) from oddinfo

If m.taxid <> "" Then ds = getDS("select * from oddinfo where taxid = @parm1", m.taxid) Else ds = Nothing

If ds IsNot Nothing AndAlso ds.Tables(0).Rows.Count = 1 Then

dr = ds.Tables(0).Rows(0)

s = ""

If m.taxid <> "" Then

s = dr("commonnames")

ss = s.Split("|")

If ss.Count >= 1 AndAlso ss(0) <> "" Then m.commonNames = ss.ToList ' replaces anything already here (like gbif)

End If

If Not IsDBNull(dr("ambiglink")) Then m.ambigLink = dr("ambiglink") Else m.ambigLink = ""

If Not IsDBNull(dr("unimportant")) Then m.unimportant = dr("unimportant") Else m.unimportant = ""

m.synonyms = New List(Of String)

m.synauth = New List(Of String)

ds = getDS("select * from syns where taxonid = @parm1", m.taxid)

For Each dr1 As DataRow In ds.Tables(0).Rows

m.synonyms.Add(dr1("syname"))

m.synauth.Add(dr1("synauth"))

Next dr1

If m.synonyms IsNot Nothing Then

m.synonyms.Sort()

For i As Integer = m.synonyms.Count - 1 To 0 Step -1

m.synonyms(i) = m.synonyms(i).Trim

If m.synonyms(i) = "" Then

m.synonyms.RemoveAt(i) ' remove blank

ElseIf i < m.synonyms.Count - 1 AndAlso m.synonyms(i) = m.synonyms(i + 1) Then

m.synonyms.RemoveAt(i) ' remove dup

End If

Next i

End If

If Not IsDBNull(dr("wikipediaPageID")) Then m.wikipediaPageID = dr("wikipediaPageID")

If Not IsDBNull(dr("commonwikilink")) Then m.commonWikiLink = dr("commonwikilink")

If Not IsDBNull(dr("hodges")) Then m.hodges = dr("hodges")

If Not IsDBNull(dr("wikidataid")) Then m.wikidataid = dr("wikidataid")

If Not IsDBNull(dr("ambiglink")) Then m.ambigLink = dr("ambiglink")

If Not IsDBNull(dr("unimportant")) Then m.unimportant = dr("unimportant")

End If

If m.commonNames.Count = 0 AndAlso m.descr <> "" AndAlso Not m.descr.Contains(" and ") AndAlso

Not m.descr.ToLower.Contains("hodges") Then m.commonNames.Add(m.descr.ToLower)

End Sub

Function getImageRec(fname As String) As imagerec

' gets an imagerec from the taxa database, based on the file name.

Dim dset As New DataSet

Dim drow As DataRow

Dim irec As New imagerec

dset = getDS("SELECT * FROM images WHERE filename = @parm1 limit 1", fname)

If dset IsNot Nothing AndAlso dset.Tables(0).Rows.Count > 0 Then

drow = dset.Tables(0).Rows(0)

If IsDBNull(drow("taxonid")) Then Return irec

Else

Return irec

End If

irec = getimagerecDr(drow) ' load drow into irec

Return irec

End Function

Function getimagerecDr(drow As DataRow) As imagerec

Dim irec As New imagerec

' load drow into irec

If IsDBNull(drow.Item("imageid")) Then irec.imageid = 0 Else irec.imageid = drow.Item("imageid")

If IsDBNull(drow.Item("filename")) Then irec.filename = "" Else irec.filename = drow.Item("filename")

If IsDBNull(drow.Item("photodate")) Then irec.photodate = "" Else irec.photodate = drow.Item("photodate")

If IsDBNull(drow.Item("dateadded")) Then irec.dateadded = "" Else irec.dateadded = drow.Item("dateadded")

If IsDBNull(drow.Item("modified")) Then irec.modified = "" Else irec.modified = drow.Item("modified")

If IsDBNull(drow.Item("taxonid")) Then irec.taxonid = "" Else irec.taxonid = drow.Item("taxonid")

If IsDBNull(drow.Item("gps")) Then irec.gps = "" Else irec.gps = drow.Item("gps")

If IsDBNull(drow.Item("elevation")) Then irec.elevation = "" Else irec.elevation = drow.Item("elevation")

If IsDBNull(drow.Item("rating")) Then irec.rating = 0 Else irec.rating = drow.Item("rating")

If IsDBNull(drow.Item("confidence")) Then irec.confidence = 0 Else irec.confidence = drow.Item("confidence")

If IsDBNull(drow.Item("remarks")) Then irec.remarks = "" Else irec.remarks = drow.Item("remarks")

If IsDBNull(drow.Item("originalpath")) Then irec.originalpath = "" Else irec.originalpath = drow.Item("originalpath")

If IsDBNull(drow.Item("bugguide")) Then irec.bugguide = "" Else irec.bugguide = drow.Item("bugguide")

If IsDBNull(drow.Item("size")) Then irec.size = "" Else irec.size = drow.Item("size")

If IsDBNull(drow.Item("location")) Then irec.location = "" Else irec.location = drow.Item("location")

If IsDBNull(drow.Item("county")) Then irec.county = "" Else irec.county = drow.Item("county")

If IsDBNull(drow.Item("state")) Then irec.state = "" Else irec.state = drow.Item("state")

If IsDBNull(drow.Item("country")) Then irec.country = "" Else irec.country = drow.Item("country")

Return irec

End Function

Function getDescr(ByRef inMatch As taxrec, ByVal shortForm As Boolean) As String

' start at taxon, then ascend through the parents until a description is found.

' shortform is true to omit "Family: Brushfoot etc."

Dim match As New taxrec

Dim mm As List(Of taxrec)

Dim parent As Integer

Dim iter As Integer = 0

If inMatch.parentid = "" Then ' inmatch might only have the taxonid

' load everything else into inmatch

'getTaxonByID(i, inMatch) Then

mm = getTaxrecByID(inMatch.taxid, False)

If mm.Count > 1 Then Stop

inMatch = mm(0)

End If

If inMatch.descr <> "" Or shortForm Then Return inMatch.descr

parent = inMatch.parentid

Do While parent >= 0 And iter < 25

iter = iter + 1

'getTaxonByID(parent, match)

mm = getTaxrecByID(parent, False)

If mm.Count = 0 Then Return "" Else If mm.Count > 1 Then Stop

match = mm(0)

If match.descr <> "" AndAlso match.rank <> "No Taxon" And

(match.rank <> "Species" Or inMatch.rank = "Subspecies") And match.rank <> "Subspecies" Then

Return match.rank & ": " & match.descr.Trim

End If

parent = match.parentid

Loop

Return ""

End Function

Function TaxonkeySearch(ByVal findme As String) As DataSet

' get dataset taxatable record for taxon or common name findme

Dim ds As New DataSet

If findme Is Nothing OrElse findme.Trim = "" Then Return Nothing

findme = findme.Trim

ds = getDS("select * from taxatable where taxon = @parm1 order by taxon;", findme)

Return ds

End Function

Function validTaxon(m As taxrec, dbRequired As Integer) As String

Dim ds As DataSet = Nothing

Dim ds2 As DataSet = Nothing

Dim ds3 As DataSet = Nothing

Dim dr As DataRow = Nothing

Dim dr2 As DataRow = Nothing

'Dim n, iRow As Integer

Dim s, s1 As String

s = LCase(m.taxon)

If s.Split(" ").Length > 3 OrElse

(s.Contains(" ") AndAlso (itisRankID.ContainsKey(m.rank) AndAlso itisRankID(m.rank) < 220)) OrElse

s.Contains("""") OrElse

s.Contains("(") OrElse

s.Contains("--") OrElse

s.Contains("-cf-") OrElse

s.Contains("-new-") OrElse

s.Contains("-non-") OrElse

s.Contains("-nr-") OrElse

s.Contains("-or-") OrElse

s.Contains("-sp-") OrElse

s.Contains("-idae") OrElse

s.Contains(".") OrElse

s.Contains("/") OrElse

s.Contains("assigned") OrElse

s.Contains("adventive") OrElse

s.Contains("established") OrElse

s.Contains("incertae") OrElse

s.Contains("introduction") OrElse

s.Contains("maybe") OrElse

s.Contains("near-") OrElse

s.Contains("possible") OrElse

s.Contains("possibly") OrElse

s.Contains("likely") OrElse

s.Contains("probably") OrElse

s.Contains("sensu lato") OrElse

s.Contains("suspected") OrElse

s.Contains("undescribed") OrElse

s.Contains("undetermined") OrElse

s.Contains("known") OrElse

s.Contains("unnamed") OrElse

s.Contains("placed") OrElse

s.EndsWith("-cf") OrElse

s.EndsWith("-like") OrElse

s.EndsWith("-sp") OrElse

s.EndsWith("complex") OrElse

s.EndsWith("group") OrElse

s.EndsWith("pseudo") OrElse

s.StartsWith("cf-") OrElse

s.StartsWith("n-") OrElse

s.StartsWith("new-") OrElse

s.StartsWith("non-") OrElse

s.StartsWith("nr-") OrElse

s.StartsWith("on-") OrElse

s.StartsWith("-xxxx") OrElse

s.StartsWith("sp-") Then Return "non-taxonomic text in name."

s1 = ""

If (dbRequired And 1) And m.taxid = "" Then s1 &= " taxa"

If (dbRequired And 2) And m.itistsn <= 0 Then s1 &= " itis"

If (dbRequired And 4) And m.catLifeID = "" Then s1 &= " catlife"

If (dbRequired And 8) And m.gbifID = "" Then s1 &= " gbif"

If (dbRequired And 16) And m.spiderID = 0 Then s1 &= " spidercat"

If s1 <> "" Then Return m.taxon & " was not found in" & s1 & ", dbRequired = " & dbRequired & "."

If Not itisRankID.ContainsKey(m.rank) Then Return "Invalid rank in taxa."

Return ""

End Function

Function getParent(ByVal m As taxrec, dbAllowed As Integer)

' returns parent based on dbAllowed: priority high to low for 1=bugguide/gbif, 16=spider 8=gbif, 2=itis, 4=catlife (anded)

Dim mp, mp1 As New taxrec

Dim mm As List(Of taxrec)

Dim mi As New taxrec

Dim ds As DataSet

If m.parentid IsNot Nothing AndAlso

(((dbAllowed And 1) And Not m.parentid.StartsWith("g")) Or

((dbAllowed And 8) And m.parentid.StartsWith("g"))) Then

mm = getTaxrecByID(m.parentid, True)

If mm.Count > 0 Then mp = mm(0)

End If

If mp.taxon = "" AndAlso (dbAllowed And 16) AndAlso m.spiderParent <> 0 Then

ds = getDS("select * from spidercat where idq = @parm1", m.spiderParent)

If ds.Tables(0).Rows.Count = 1 Then mp = getspiderTaxrec(ds.Tables(0).Rows(0), True)

End If

If mp.taxon = "" AndAlso (dbAllowed And 8) AndAlso m.gbifParent <> "" Then

ds = getDS("select name from gbif.tax where taxid = @parm1", m.gbifParent)

If ds.Tables(0).Rows.Count = 1 Then mp = loadMatch(ds.Tables(0).Rows(0)("name"), True)

End If

If (dbAllowed And 2) AndAlso m.parentTsn > 0 Then ' check even if there is one already

ds = getDS("select * from itis.taxonomic_units where tsn = @parm1", m.parentTsn)

If ds.Tables(0).Rows.Count = 1 Then

mp1 = getItisTaxrec(ds.Tables(0).Rows(0), True)

If mp.taxon = "" Then ' OrElse

'(mp.rank IsNot Nothing AndAlso mp1.rank IsNot Nothing AndAlso

'itisRankID.ContainsKey(mp1.rank) AndAlso itisRankID.ContainsKey(mp.rank) AndAlso

'itisRankID(mp1.rank) > itisRankID(mp.rank)) Then

mp = mp1 ' Itis has a lower rank (like subfamily vs. family)

End If

End If

End If

If mp.taxon = "" AndAlso (dbAllowed And 4) AndAlso m.catLifeParentID <> "" Then

ds = getDS("select name from catlife.tax where taxid = @parm1", m.catLifeParentID)

If ds.Tables(0).Rows.Count = 1 Then mp = loadMatch(ds.Tables(0).Rows(0)("name"), True)

End If

Return mp

End Function

Function getancestors(ByVal m1 As taxrec, dbAllowed As Integer,

ByVal excludeNoTaxon As Boolean, ByVal StopAt As String) As List(Of taxrec)

' returns a list of ancestors for ancestor(0). call with a single taxrec in the list "ancestor".

' StopAt the topmost rank, phylum if "".

Dim match As New taxrec

Dim m As New taxrec

Dim iter As Integer = 0

Dim catLifeID As String = ""

Dim ancestor As New List(Of taxrec)

ancestor.Add(m1)

match = getParent(m1, dbAllowed)

Do While (match.taxon <> "") And iter < 50

If (Not excludeNoTaxon OrElse Not eqstr(match.rank, "no taxon")) AndAlso

validTaxon(match, 0) = "" Then

ancestor.Add(match)

End If

If eqstr(match.rank, StopAt) Or (match.taxon = "") Then Exit Do

match = getParent(match, dbAllowed)

iter = iter + 1

Loop

Return ancestor

End Function

Function isAncestor(ancestor As List(Of taxrec), tax As String, start As Integer) As Boolean

' is taxon an ancestor? start tells where in ancestor to start looking.

For i1 As Integer = start To ancestor.Count - 1

If eqstr(ancestor(i1).taxon, tax) Then Return True

Next i1

Return False

End Function

Function getAncestor(ancestor As List(Of taxrec), tax As String, start As Integer) As taxrec

' is taxon an ancestor? start tells where in ancestor to start looking.

For i1 As Integer = start To ancestor.Count - 1

If eqstr(ancestor(i1).taxon, tax) Then Return ancestor(i1)

Next i1

Return Nothing

End Function

Function getCategoryRank(ancestor As List(Of taxrec), istart As Integer) As String

' returns the lowest existing category

' istart is 0 to include current taxon as a potential category, 1 for next higher, etc.

Dim tax, commoncat As String

Dim ds As DataSet

' istart is zero to include current taxon as a potential category.

For i As Integer = istart To ancestor.Count - 1

ds = getDS("select * from wikicats where taxon = @parm1", ancestor(i).taxon)

If ds.Tables(0).Rows.Count = 1 Then

tax = ds.Tables(0).Rows(0)("taxon")

commoncat = ds.Tables(0).Rows(0)("commoncat")

If commoncat <> "" Then Return commoncat Else Return tax

End If

Next i

If isAncestor(ancestor, "Arthropoda", 0) Then

Return "Arthropods"

Else

Return "Animals"

End If

End Function

Function getWikiPage(titleParm As String, url As String) As String

Dim parms As New Dictionary(Of String, String)

Dim r1 As HttpResponseMessage

Dim qcontent As FormUrlEncodedContent

Dim s As String

Dim jq As JObject

Dim pageID As String

Dim pageText As String

parms = New Dictionary(Of String, String)

parms.Add("action", "query")

parms.Add("titles", titleParm) ' "File:Aeoloplides turnbulli P1490124a.jpg"

parms.Add("prop", "revisions")

parms.Add("rvprop", "content")

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

Try

r1 = qClient.PostAsync(url, qcontent).Result

s = r1.Content.ReadAsStringAsync().Result

jq = JObject.Parse(s)

pageID = jq.SelectToken("query.pages.*").SelectToken("pageid")

If pageID IsNot Nothing Then

pageText = jq.SelectToken("query.pages.*.revisions").ToList(0).ToList(2)

Else

pageText = ""

End If

Catch ex As Exception

pageText = ""

End Try

Return pageText

End Function

Public Function getPageID(title As String, wikiurl As String) As Integer

' get the pageID for any wiki page based on title, url.

Dim s, s1 As String

Dim jq As JObject = Nothing

Dim jt As JToken = Nothing

Dim r1 As HttpResponseMessage

Dim qcontent As FormUrlEncodedContent

Dim parms As Dictionary(Of String, String)

If title.Trim = "" Then Return ""

parms = New Dictionary(Of String, String)()

parms.Add("action", "query")

parms.Add("titles", title)

parms.Add("prop", "revisions")

parms.Add("rvprop", "content")

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(wikiurl, qcontent).Result

s = r1.Content.ReadAsStringAsync().Result

If s.Contains("Wiki Error") Then

outLog("GetPageID error: " & title)

Return ""

End If

Try

jq = JObject.Parse(s)

jt = jq.SelectToken("$.query.pages.*")

If jt IsNot Nothing Then s1 = jt.SelectToken("pageid") Else s1 = ""

Catch ex As Exception

s1 = ""

Stop

End Try

If IsNumeric(s1) Then Return Int(s1) Else Return 0

End Function

Sub sortTaxrec(ByRef children As List(Of taxrec))

' sort a list of taxrecs

' this is ugly. I am lazy.

Dim ix As New List(Of Integer)

Dim keys As New List(Of String)

Dim sorted As New List(Of taxrec)

For i1 As Integer = 0 To children.Count - 1

ix.Add(i1)

keys.Add(children(i1).taxon)

sorted.Add(New taxrec)

Next i1

MergeSort(keys, ix, 0, ix.Count - 1)

For i1 As Integer = 0 To ix.Count - 1

sorted(i1) = children(ix(i1))

Next i1

children = New List(Of taxrec)

children.AddRange(sorted)

End Sub

Function getAncestorRank(ancestor As List(Of taxrec), rank As String) As taxrec

' return the ancestor at a given rank

For i As Integer = 0 To ancestor.Count - 1

If eqstr(ancestor(i).rank, rank) Then Return ancestor(i)

Next i

Return Nothing

End Function

Function getdescrMatch(ancestor As List(Of taxrec), sMinrank As String, sMaxrank As String,

sUsedRank As String, checkCurrent As Boolean) As taxrec

' return the lowest ancestor with a common name, upto and including maxrank

Dim checkNow As Boolean = False

Dim minRank, maxRank, usedRank, itisRank As Integer

If itisRankID.ContainsKey(sMinrank) Then minRank = itisRankID(sMinrank) Else minRank = 0

If itisRankID.ContainsKey(sMaxrank) Then maxRank = itisRankID(sMaxrank) Else maxRank = 0

If itisRankID.ContainsKey(sUsedRank) Then usedRank = itisRankID(sUsedRank) Else usedRank = 0

For i As Integer = 0 To ancestor.Count - 1

If itisRankID.ContainsKey(ancestor(i).rank) Then

itisRank = itisRankID(ancestor(i).rank)

Else

itisRank = 0

End If

If itisRank = minRank And checkCurrent Then checkNow = True

If checkNow Then

If ancestor(i).descr <> "" AndAlso itisRank <> usedRank AndAlso

itisRank <> 0 Then Return ancestor(i)

If itisRank = maxRank AndAlso itisRank <> usedRank Then

Return ancestor(i)

End If

Else

If itisRank <= minRank Then checkNow = True ' higher ranks have lower numbers

End If

Next i

Return Nothing

End Function

Function getChildren(tMatch As taxrec, addon As Boolean, dballowed As Integer) As List(Of taxrec)

' get all the immediate children of tmatch, in all database tables

Dim ds As DataSet

Dim desc As New List(Of taxrec)

Dim childNames As New List(Of String)

Dim m As New taxrec

If (dballowed And 1) Then

If tMatch.taxid <> "" Then

ds = getDS("select * from taxatable where parentid = @parm1", tMatch.taxid)

For Each dr As DataRow In ds.Tables(0).Rows

m = getTaxrec(dr, addon)

desc.Add(m)

childNames.Add(m.taxon)

Next dr

End If

End If

If tMatch.taxlink.ToLower.Contains("speciesfile.org") Then Return desc ' speciesfile implies correct, complete children.

If (dballowed And 2) AndAlso tMatch.itistsn > 0 Then

ds = getDS("select * from itis.taxonomic_units " &

"where parent_tsn = @parm1 and name_usage = 'valid';", tMatch.itistsn)

For Each dr As DataRow In ds.Tables(0).Rows

m = getItisTaxrec(dr, addon)

If childNames.IndexOf(m.taxon) < 0 Then ' new match

desc.Add(m)

childNames.Add(m.taxon)

End If

Next dr

End If

If (dballowed And 8) AndAlso tMatch.gbifID <> "" Then

ds = getDS("select * from gbif.tax where parent = @parm1 and usable <> '';", tMatch.gbifID)

'ds = getDS("select * from gbif.tax join taxa.gbifplus using (taxid) where parent = @parm1 and usable <> '';",

' tMatch.gbifID)

For Each dr As DataRow In ds.Tables(0).Rows

If eqstr(dr("name"), "Colonellus") Then Stop

m = getTaxrecg(dr, addon)

If childNames.IndexOf(m.taxon) < 0 Then ' new match

desc.Add(m)

childNames.Add(m.taxon)

End If

Next dr

End If

If (dballowed And 4) AndAlso tMatch.catLifeID <> "" Then

ds = getDS("select * from catlife.tax " &

"where parent = @parm1 and (namestatus = 'accepted name' or namestatus = 'provisionally accepted name');", tMatch.catLifeID)

If ds IsNot Nothing Then

For Each dr As DataRow In ds.Tables(0).Rows

m = getCatLifeTaxrec(dr, addon)

If childNames.IndexOf(m.taxon) < 0 Then ' new match

desc.Add(m)

childNames.Add(m.taxon)

End If

Next dr

End If

End If

If (dballowed And 16) AndAlso tMatch.spiderID > 0 Then

ds = getDS("select * from spidercat where parentid = @parm1;", tMatch.spiderID)

For Each dr As DataRow In ds.Tables(0).Rows

m = getspiderTaxrec(dr, addon)

If childNames.IndexOf(m.taxon) < 0 Then ' new match

desc.Add(m)

childNames.Add(m.taxon)

End If

Next dr

End If

Return desc

End Function

Function allDescendants(tMatch As taxrec, rank As String, dballowed As Integer) As List(Of taxrec)

' returns a sorted list of itis + bugguide descendant names, at rank (or all descendants if rank is "")

Dim children As New List(Of taxrec)

Dim chil As New List(Of taxrec)

Dim desc As New List(Of taxrec) ' all the descendants to return

Dim childName As New List(Of String)

Dim descName As New List(Of String)

Dim validName As String

Dim recRank As String

Dim i As Integer

children = getChildren(tMatch, True, dballowed) ' get immediate children, sources = dballowed

For i1 As Integer = children.Count - 1 To 0 Step -1

validName = validTaxon(children(i1), 0)

If validName = "" Then

recRank = children(i1).rank

If rank = "" OrElse eqstr(rank, recRank) Then

If descName.IndexOf(children(i1).taxon) < 0 Then ' add new taxrec

descName.Add(children(i1).taxon)

desc.Add(children(i1))

Else

children.RemoveAt(i1)

End If

ElseIf (itisRankID.ContainsKey(recRank) AndAlso itisRankID(rank) <= itisRankID(recRank)) Then ' rank is as low as target

children.RemoveAt(i1)

End If

End If

Next i1

For Each m As taxrec In children

If rank = "" OrElse Not eqstr(rank, m.rank) Then

chil = allDescendants(m, rank, dballowed)

For Each m2 As taxrec In chil

i = descName.IndexOf(m2.taxon)

If i < 0 Then ' add new taxrec

descName.Add(m2.taxon)

desc.Add(m2)

ElseIf m2.taxid <> "" Then

desc(i) = m2

End If

Next m2

End If

Next m

sortTaxrec(desc)

Return desc

End Function

Function getItisTaxrec(dr As DataRow, addon As Boolean) As taxrec

' get rank, taxon, authority, and tsn from Itis to a taxrec

Dim m As New taxrec

Dim s As String

If IsDBNull(dr("complete_name")) Then m.taxon = "" Else m.taxon = dr("complete_name").trim

If IsDBNull(dr("rank_id")) Then m.rank = "" Else m.rank = itisRanks(dr("rank_id"))

s = getScalar("select taxon_author from itis.taxon_authors_lkp, itis.taxonomic_units " &

"where taxon_authors_lkp.taxon_author_id = taxonomic_units.taxon_author_id and tsn = @parm1;", dr("tsn"))

If Not IsDBNull(s) AndAlso s IsNot Nothing AndAlso s <> "" Then m.authority = s Else m.authority = ""

m.authority = m.authority.Replace(" and ", " & ")

m.itistsn = dr("tsn")

m.link = ""

If Not IsDBNull(dr("parent_tsn")) Then m.parentTsn = dr("parent_tsn") Else m.parentTsn = 0

If addon Then taxrecAddon(m)

If m.taxlink = "" Then m.taxlink = "https://www.itis.gov/servlet/SingleRpt/SingleRpt?search_topic=TSN&search_value=" & m.itistsn

Return m

End Function

Function getspiderTaxrec(dr As DataRow, addon As Boolean) As taxrec

' get rank, taxon, etc from spider to a taxrec

Dim m As New taxrec

If IsDBNull(dr("name")) Then m.taxon = "" Else m.taxon = dr("name").trim

If IsDBNull(dr("rank")) Then m.rank = "" Else m.rank = dr("rank").trim

If IsDBNull(dr("authority")) Then m.authority = "" Else m.authority = dr("authority").trim

m.authority = m.authority.Replace(" and ", " & ")

If IsDBNull(dr("idq")) Then m.spiderID = 0 Else m.spiderID = dr("idq")

If IsDBNull(dr("parentid")) Then m.spiderParent = 0 Else m.spiderParent = dr("parentid")

m.link = ""

If addon Then taxrecAddon(m)

If m.taxlink = "" Then m.taxlink = dr("url")

Return m

End Function

Function getCatLifeTaxrec(dr As DataRow, addon As Boolean) As taxrec

' get rank, taxon, etc from catlife to a taxrec

Dim m As New taxrec

If IsDBNull(dr("name")) Then m.taxon = "" Else m.taxon = dr("name").trim

If IsDBNull(dr("rank")) Then m.rank = "" Else m.rank = dr("rank")

If eqstr(m.rank, "infraspecies") Then m.rank = "Subspecies"

If IsDBNull(dr("author")) Then m.authority = "" Else m.authority = dr("author").trim

m.authority = m.authority.Replace(" and ", " & ")

If IsDBNull(dr("taxid")) Then

m.catLifeID = ""

m.link = ""

Else

m.catLifeID = dr("taxid").trim

'm.link = "http://www.catalogueoflife.org/col/browse/tree/id/" & m.catLifeID

m.link = ""

End If

If IsDBNull(dr("parent")) Then m.catLifeParentID = "" Else m.catLifeParentID = dr("parent").trim

If addon Then taxrecAddon(m)

Return m

End Function

Function eqstr(ByRef s1 As String, ByRef s2 As String) As Boolean

' case insensitive string equals

Return String.Equals(s1, s2, StringComparison.OrdinalIgnoreCase)

End Function

Function getRefrec(dr As DataRow) As refrec

Dim rec As New refrec

If Not IsDBNull(dr("refid")) Then rec.refid = dr("refid")

If Not IsDBNull(dr("reftype")) Then rec.reftype = dr("reftype").trim

If Not IsDBNull(dr("pubtype")) Then rec.pubtype = dr("pubtype").trim

If Not IsDBNull(dr("afirst")) Then rec.afirst = dr("afirst").trim

If Not IsDBNull(dr("alast")) Then rec.alast = dr("alast").trim

If Not IsDBNull(dr("efirst")) Then rec.efirst = dr("efirst").trim

If Not IsDBNull(dr("elast")) Then rec.elast = dr("elast").trim

If Not IsDBNull(dr("year")) Then rec.year = dr("year").trim

If Not IsDBNull(dr("title")) Then rec.title = dr("title").trim

If Not IsDBNull(dr("journal")) Then rec.journal = dr("journal")

If Not IsDBNull(dr("publisher")) Then rec.publisher = dr("publisher")

If Not IsDBNull(dr("series")) Then rec.series = dr("series").trim

If Not IsDBNull(dr("volume")) Then rec.volume = dr("volume").trim

If Not IsDBNull(dr("issue")) Then rec.issue = dr("issue").trim

If Not IsDBNull(dr("chapter")) Then rec.chapter = dr("chapter").trim

If Not IsDBNull(dr("pages")) Then rec.pages = dr("pages").trim

If Not IsDBNull(dr("url")) Then rec.url = dr("url").trim

If Not IsDBNull(dr("isbn")) Then rec.isbn = dr("isbn").trim

If Not IsDBNull(dr("issn")) Then rec.issn = dr("issn").trim

If Not IsDBNull(dr("doi")) Then rec.doi = dr("doi").trim

If Not IsDBNull(dr("doiaccess")) Then rec.doiaccess = dr("doiaccess").trim

If Not IsDBNull(dr("taxon")) Then rec.taxon = dr("taxon").trim

If Not IsDBNull(dr("taxonexcept")) Then rec.taxonExcept = dr("taxonexcept").trim

If Not IsDBNull(dr("bottomrank")) Then rec.bottomRank = dr("bottomrank") Else rec.bottomRank = 230

If Not IsDBNull(dr("etc")) Then rec.etc = dr("etc").trim

If Not IsDBNull(dr("comment")) Then rec.comment = dr("comment").trim

If Not IsDBNull(dr("urlaccessed")) Then rec.urlAccessed = dr("urlaccessed").trim

If Not IsDBNull(dr("updated")) Then rec.updated = dr("updated").trim

's = getScalar("select wikilink from wikipubs where pubname = @parm1;", rec.journal)

'If s IsNot Nothing Then rec.wikilink = s

Return rec

End Function

Function getWikiRefs(ancestor As List(Of taxrec)) As List(Of refrec)

' returns the refrecs for a taxrec (using taxon lookup)

Dim ds As DataSet

Dim refs As New List(Of refrec)

Dim ref As New refrec

Dim ss() As String

For i1 As Integer = 0 To ancestor.Count - 1

' this will miss a few refs that have odd-ranked taxons.

ds = getDS("select * from wikiref where taxon = @parm1;", ancestor(i1).taxon)

For Each dr As DataRow In ds.Tables(0).Rows

ref = getRefrec(dr)

If itisRankID.ContainsKey(ancestor(0).rank) AndAlso itisRankID(ancestor(0).rank) <= dr("bottomrank") Then

If ref.taxonExcept <> "" Then ' does not apply to some taxons

ss = ref.taxonExcept.Split("|")

For Each rec As String In ss

rec = rec.Trim

If rec <> "" AndAlso isAncestor(ancestor, rec, 0) Then

ref.title = "" ' exclude ref from this taxon

Exit For

End If

Next rec

End If

If ref.title <> "" Then

For Each r As refrec In refs

If eqstr(r.title, ref.title) Then ' no dups

ref.title = "" ' skip -- it's a duplicate

Exit For

End If

Next r

If ref.title <> "" Then refs.Add(ref)

End If

End If

Next dr

Next i1

Return refs

End Function

Function iucnstatus(status As String, trend As String, year As String) As String

' translates the 2-character IUCN status into english

Dim s As String

s = """" & UCase(status) & """"

Select Case LCase(status)

Case "ex"

s &= ". The species is extinct."

Case "ew"

s &= ". The species is extinct in the wild."

Case "cr"

s &= ", critically endangered. The species faces an extremely high risk of extinction in the immediate future."

Case "en"

s &= ", endangered. The species faces a high risk of extinction in the near future."

Case "vu"

s &= ", vulnerable. The species faces a high risk of endangerment in the medium term."

Case "nt"

s &= ", near threatened. The species may be considered threatened in the near future."

Case "lc"

s &= ", least concern, with no immediate threat to the species' survival."

Case "dd"

s &= ", data deficient."

Case Else

s = ""

End Select

If trend = "stable" OrElse trend = "increasing" OrElse trend = "decreasing" Then

s &= " The population is " & trend & "."

End If

If year > 0 Then s &= " The IUCN status was reviewed in " & year & "."

Return s

End Function

Function getRange(m As taxrec) As String

' returns the range in english for a wikipedia entry.

Dim ref As String

Dim s1, s2 As String

Dim i1 As Integer

Dim range As String

Dim source As String

Dim iRange As New List(Of String)

ref = ""

If m.spiderID > 0 Then ' get spidercat range

s1 = getScalar("select distribution from spidercat where name = @parm1", m.taxon)

If s1 <> "" Then

s1 = m.spiderdist

s1 = s1.Replace("Is. Introduced to", "Islands, and has been introduced into")

s1 = s1.Replace(". Introduced to", ", has been introduced into")

s1 = s1.Replace(" Is.", " Islands")

iRange = s1.Split(",").ToList

End If

End If

If iRange.Count = 0 AndAlso m.taxid <> "" Then ' check oddinfo, already formatted

s1 = getScalar("select drange from oddinfo where taxid = @parm1", m.taxid)

If s1 <> "" Then iRange = s1.Split("|").ToList

End If

If iRange.Count = 0 Then ' get gbif countries, if any

source = ""

If eqstr(m.rank, "species") OrElse eqstr(m.rank, "subspecies") Then

iRange = getgbifrange(m, source)

End If

End If

If m.spiderdist <> "" Then

For i As Integer = 0 To iRange.Count - 1

iRange(i) = iRange(i).Trim

i1 = iRange(i).IndexOf(" to ")

If i1 > 0 Then ' USA to Nicaragua

s1 = iRange(i).Substring(0, i1)

s2 = iRange(i).Substring(i1 + 4)

s1 = translocation(s1)

s2 = translocation(s2)

iRange(i) = "a range from " & s1 & " to " & s2

Else

iRange(i) = translocation(iRange(i))

If iRange(i).Contains("into USA") Or iRange(i).Contains("into Caribbean") Or iRange(i).Contains("into Far East") Or iRange(i).Contains("into Near East") Then

iRange(i) = iRange(i).Replace("introduced into ", "introduced into the ")

End If

iRange(i) = iRange(i).Replace(" USA", " United States")

End If

Next i

Else ' non-spider irange

For i As Integer = 0 To iRange.Count - 1

iRange(i) = translocation(iRange(i))

Next i

End If

For i As Integer = iRange.Count - 1 To 0 Step -1 ' remove duplicates (from translocation, etc.)

For j As Integer = i - 1 To 0 Step -1

If iRange(i) = iRange(j) Then

iRange.RemoveAt(i)

Exit For

End If

Next j

Next i

Dim locale As New List(Of String)

Dim wlink As New List(Of String)

Dim ds As DataSet

Dim iTitle As Integer

ds = getDS("select * from translocation")

For Each dr As DataRow In ds.Tables(0).Rows

s1 = dr("newlocation")

If s1.StartsWith("the ") Then s1 = s1.Substring(4)

locale.Add(s1)

wlink.Add(dr("wikilink"))

Next dr

For i As Integer = iRange.Count - 1 To 0 Step -1 ' add wikilinks for some areas

iTitle = -1

s1 = iRange(i)

If s1.StartsWith("the ") Then s1 = s1.Substring(4)

For j As Integer = 0 To locale.Count - 1 ' check full title

If eqstr(s1, locale(j)) Then

iTitle = j

Exit For

End If

Next j

If iTitle < 0 Then

For j As Integer = 0 To locale.Count - 1 ' get the longest match

If (iTitle < 0 OrElse locale(j).Length > locale(iTitle).Length) AndAlso

iRange(i).Contains(locale(j)) Then iTitle = j

Next j

End If

If iTitle >= 0 AndAlso wlink(iTitle) <> "" Then ' add a wikilink

If locale(iTitle) = wlink(iTitle) Then

iRange(i) = iRange(i).Replace(wlink(iTitle), "" & wlink(iTitle) & "")

Else ' display different text than link

iRange(i) = iRange(i).Replace(locale(iTitle), "" & locale(iTitle) & "")

End If

End If

Next i

range = ""

If iRange.Count > 0 Then ' have some range

If eqstr(m.rank, "species") Or eqstr(m.rank, "subspecies") Then

range = "It is found in " & formatList(iRange, "and") & "."

Else

range = "They are found in " & formatList(iRange, "and") & "."

End If

End If

If range <> "" Then range = range.Replace("found in worldwide", "found worldwide")

If range.EndsWith("..") Then range = range.Substring(0, range.Length - 1)

If range.EndsWith("..") Then range = range.Substring(0, range.Length - 1)

Return range & ref

End Function

Function getgbifrange(m As taxrec, ByRef source As String) As List(Of String)

Dim ds, ds2 As DataSet

Dim irange As New List(Of String)

Dim countrycode, locationid, location, locality As String

Dim name1, name2 As String

Dim names1 As New List(Of String)

Dim names2 As New List(Of String)

Dim i, k As Integer

If m.gbifID = "" Then Return irange

ds = getDS("select * from gbif.distribution where taxonid = @parm1", m.gbifID)

For Each dr As DataRow In ds.Tables(0).Rows

locality = dr("locality")

If locality Is Nothing Then locality = ""

countrycode = dr("countrycode")

If countrycode Is Nothing Then countrycode = ""

locationid = dr("locationid")

If locationid Is Nothing Then locationid = ""

If dr("source") = "Integrated Taxonomic Information System (ITIS)" And locationid = "" And countrycode = "" Then

' use the locality

locality = locality.Replace("""", "")

locality = translocation(locality)

If irange.IndexOf(locality) < 0 Then irange.Add(locality)

Else ' get it from name1, name2

name1 = "" : name2 = ""

If countrycode IsNot Nothing AndAlso countrycode <> "" Then ' use countrycode

ds2 = getDS("select * from glocation where countrycode = @parm1", countrycode)

ElseIf Not locationid.StartsWith("TDWG") And countrycode = "" Then ' use the locality

ds2 = getDS("select * from glocation where name = @parm1 order by idq", locality)

ElseIf locationid IsNot Nothing AndAlso locationid <> "" Then ' use locationid

If locationid.StartsWith("TDWG:") Then locationid = locationid.Substring(5)

ds2 = getDS("select * from glocation where code = @parm1", locationid)

Else

ds2 = Nothing

End If

If ds2 IsNot Nothing AndAlso ds2.Tables(0).Rows.Count > 0 Then

name1 = ds2.Tables(0).Rows(0)("name1")

name2 = ds2.Tables(0).Rows(0)("name2")

name1 = translocation(name1)

name2 = translocation(name2)

End If

If name1 <> "" Then

If name2.Contains("United States") Then name2 = "the United States"

If name2.Contains("Canada") Then name2 = "Canada"

If name2.Contains("Atlantic Ocean") Then name2 = "the Atlantic Ocean"

If name2.Contains("Tropical Africa") Then name2 = "Tropical Africa"

End If

If name1.Contains("Europe &") OrElse name2.Contains("Europe &") Then Stop

Select Case name2

Case "the Caribbean",

"Central America",

"Mexico",

"China",

"Western Asia",

"Indo-China",

"the Indian Subcontinent",

"Australia",

"New Zealand"

' use name2

Case "the southwestern Pacific",

"the south-central Pacific",

"south-central Pacific",

"the northwestern Pacific",

"the north-central Pacific",

"north-central Pacific"

name1 = "the Pacific Ocean"

name2 = ""

Case Else

name2 = ""

End Select

i = names1.IndexOf(name1)

If i < 0 Then

names1.Add(name1)

names2.Add(name2)

ElseIf names2(i) <> name2 Then

names2(i) = "" ' go with continent if there's more than one country in it.

End If

If name1 IsNot Nothing AndAlso name1 <> "" Then

Select Case (dr("source"))

Case "Integrated Taxonomic Information System (ITIS)"

' source = "itis"

Case "Catalogue of Life"

' source = "catlife"

Case "World Register of Marine Species"

source = "worms"

End Select

End If

End If

Next dr

' combine temperate and tropical Asia into a single continent.

i = names1.IndexOf("temperate Asia")

k = names1.IndexOf("tropical Asia")

If i >= 0 AndAlso k >= 0 Then

names1(i) = "Asia" : names2(i) = ""

names1.RemoveAt(k) : names2.RemoveAt(k)

End If

' special case for Europe & itis

If irange.IndexOf("Europe & Northern Asia (excluding China)") >= 0 Then

i = names1.IndexOf("Europe")

If i >= 0 Then

names1.RemoveAt(i)

names2.RemoveAt(i)

End If

End If

For i1 As Integer = 0 To names1.Count - 1

If names2(i1) <> "" Then location = names2(i1) Else location = names1(i1)

If location <> "" AndAlso irange.IndexOf(location) < 0 Then irange.Add(location)

Next i1

Return irange

End Function

Function translocation(locality As String)

' translate locality to better form

Dim s As String

s = getScalar("select newlocation from translocation where original = @parm1", locality)

If s Is Nothing OrElse s = "" Then Return locality

Return s

End Function

Function formatList(ss As List(Of String), separator As String) As String

' add commas and ", and" to a list, return a single string

' separator is "and" or "or"

Dim s = ""

If ss.Count = 1 Then

s = ss(0)

ElseIf ss.Count = 2 Then

s = ss(0) & " " & separator & " " & ss(1)

Else

For i As Integer = 0 To ss.Count - 1

If i = ss.Count - 1 Then ' done

s &= ss(i)

ElseIf i = ss.Count - 2 Then ' next to last

s &= ss(i) & ", " & separator & " "

Else

s &= ss(i) & ", " ' others

End If

Next i

End If

Return s

End Function

Function loadMatch(sTaxon As String, addon As Boolean) As taxrec

' load a taxrec from the database for a taxon

Dim match As New taxrec

Dim ds As New DataSet

ds = TaxonkeySearch(sTaxon)

If ds IsNot Nothing Then

For Each dr As DataRow In ds.Tables(0).Rows

match = getTaxrec(dr, addon)

If eqstr(match.taxon, sTaxon) AndAlso match.rank <> "" AndAlso

itisRankID.ContainsKey(match.rank) Then Exit For

Next dr ' should only be one

End If

If match.taxid = "" AndAlso match.gbifID = "" Then ' check gbif

ds = getDS("select * from gbif.tax where name = @parm1 and usable <> ''", sTaxon)

'ds = getDS("select * from gbif.tax join taxa.gbifplus using (taxid) where name = @parm1 and usable <> ''", sTaxon)

If ds.Tables(0).Rows.Count = 1 Then match = getTaxrecg(ds.Tables(0).Rows(0), addon)

End If

If match.taxid = "" AndAlso match.catLifeID = "" Then ' check catlife

ds = getDS("select * from catlife.tax where name = @parm1 and namestatus = 'accepted name'", sTaxon)

If ds.Tables(0).Rows.Count = 1 Then match = getCatLifeTaxrec(ds.Tables(0).Rows(0), addon)

End If

If match.taxid = "" AndAlso match.spiderID <= 0 Then ' check spidercat

ds = getDS("select * from spidercat where name = @parm1", sTaxon)

If ds.Tables(0).Rows.Count = 1 Then match = getspiderTaxrec(ds.Tables(0).Rows(0), addon)

End If

Return match

End Function

Function loadGbifMatch(sTaxon As String, addon As Boolean) As taxrec

' like loadmatch, except for gbif including accepted and doubtful taxa.

Dim match As New taxrec

Dim ds As New DataSet

ds = getDS("select * from gbif.tax " &

" where name = @parm1 and (status = 'accepted' or status = 'doubtful')", sTaxon)

If ds.Tables(0).Rows.Count = 1 Then

match = getTaxrecg(ds.Tables(0).Rows(0), addon)

Return match

ElseIf ds.Tables(0).Rows.Count > 1 Then

For Each dr As DataRow In ds.Tables(0).Rows

If dr("usable") = "ok" Then

match = getTaxrecg(dr, addon)

Return match

End If

Next dr

For Each dr As DataRow In ds.Tables(0).Rows

If dr("status") = "accepted" Then

match = getTaxrecg(dr, addon)

Return match

End If

Next dr

match = getTaxrecg(ds.Tables(0).Rows(0), addon)

End If

Return match

End Function

Sub MergeSort(ByRef v As Object, ByRef ix As List(Of Integer), min As Integer, max As Integer)

' use for in-place sorting.

Dim half As Integer

Dim isString As Boolean

Dim j, i, k As Integer

If v.count - 1 < min Then Exit Sub

isString = TypeOf v(min) Is String

If max - min > 1 Then

Dim tix As New List(Of Integer)

tix.AddRange(ix) ' copy index array

half = (max + min) * 0.5

If min < half Then MergeSort(v, tix, min, half) ' sort lower half

If half + 1 < max Then MergeSort(v, tix, half + 1, max) ' sort upper half

' now merge the two sorted halves

i = min : j = half + 1 : k = min - 1

Do While i <= half Or j <= max

k = k + 1

If j > max Then

ix(k) = tix(i)

i = i + 1

ElseIf i > half Then

ix(k) = tix(j)

j = j + 1

' ignore case when comparing strings

ElseIf (isString AndAlso String.Compare(v(tix(i)), v(tix(j)), True) <= 0) OrElse _

(Not isString AndAlso v(tix(i)) <= v(tix(j))) Then

ix(k) = tix(i)

i = i + 1

Else

ix(k) = tix(j)

j = j + 1

End If

Loop

Else ' 1 or 2 elements -- do by hand

If max - min >= 1 Then

k = min

' If v(ix(k)) > v(ix(k + 1)) Then ' compare first and second items

If isString AndAlso String.Compare(v(ix(k)), v(ix(k + 1)), True) > 0 OrElse _

(Not isString) AndAlso v(ix(k)) > v(ix(k + 1)) Then

i = ix(k) : ix(k) = ix(k + 1) : ix(k + 1) = i ' swap

End If

End If

End If

End Sub

Function abbreviate(s1 As String)

' abbreviates the genus in a species or subspecies combination

Dim k As Integer

k = s1.IndexOf(" ")

If k >= 0 And k < s1.Length Then

Return UCase(s1.Substring(0, 1)) & ". " & s1.Substring(k + 1)

Else

Return s1

End If

End Function

Function getUrlDomain(s As String) As String

' get the domain of a url.

Dim i As Integer

If s Is Nothing OrElse s = "" Then Return ""

s = s.Replace("https://", "")

s = s.Replace("http://", "")

If s.StartsWith("www.") Then s = s.Replace("www.", "")

i = s.IndexOf("/")

If i < 0 Then i = s.IndexOf("?")

If i < 0 Then i = s.IndexOf("#")

If i < 0 Then i = s.IndexOf("|")

If i >= 0 Then s = s.Substring(0, i)

Return s

End Function

Function binsearch(ByRef ss As List(Of String), s As String, i1 As Integer, i2 As Integer) As Integer

Dim ihalf As Integer

Dim i As Integer

If s = ss(i2) Then Return i2

If i1 = i2 OrElse i1 + 1 = i2 Then Return -1

ihalf = (i1 + i2) \ 2

i = String.Compare(s, ss(ihalf), True)

If i > 0 Then

Return binsearch(ss, s, ihalf, i2)

ElseIf i < 0 Then

Return binsearch(ss, s, i1, ihalf)

Else

Return ihalf

End If

End Function

Sub gardener(PageID As String, ByRef inPages As List(Of String), ByRef level As Integer,

max As Integer, maxlev As Integer)

' check for walled garden

' returns a list of pages that link here, along with their incoming links, and theirs, etc.

' aborts when inpages.count reaches max or recursion level (no-repeats) reaches maxlev.

Dim s, s1 As String

Dim incoming As New List(Of String)

Dim ss As New List(Of String)

Dim r1 As HttpResponseMessage

Dim qcontent As FormUrlEncodedContent

Dim parms As Dictionary(Of String, String)

Dim jq As JObject

Dim jtt As List(Of JToken)

level += 1

If level > maxlev Then level = -1

If level < 0 Then Exit Sub

parms = New Dictionary(Of String, String)

parms.Add("action", "query")

parms.Add("pageids", PageID)

parms.Add("prop", "linkshere")

parms.Add("lhnamespace", "0")

parms.Add("lhlimit", max)

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

ss = New List(Of String)

r1 = qClient.PostAsync(urlWikiPedia, qcontent).Result

s = r1.Content.ReadAsStringAsync().Result

jq = JObject.Parse(s)

If jq.SelectToken("query.pages." & PageID & ".linkshere") IsNot Nothing Then

jtt = jq.SelectToken("query.pages." & PageID & ".linkshere").ToList

For Each jt As JToken In jtt

s1 = jt("pageid")

If inPages.IndexOf(s1) < 0 Then

ss.Add(s1)

inPages.Add(s1)

If inPages.Count >= max Then Exit Sub

End If

Next jt

For Each s1 In ss

gardener(s1, inPages, level, max, maxlev)

If level < 0 Or inPages.Count >= max Then Exit Sub

Next s1

End If

level -= 1

End Sub

Function getQnumber(m As taxrec, ancestor As List(Of taxrec)) As String

' get the wikidata qnumber of an animal.

Dim s, s1, s2, s3 As String

Dim sb As New StringBuilder

Dim qNumber As String

Dim jq As JObject

Dim jz, jz2, jt As JToken

Dim parms As New Dictionary(Of String, String)

Dim r1 As HttpResponseMessage

Dim qcontent As FormUrlEncodedContent

Dim pageID As String

Dim parentTaxon As String

's = getWikiDataPage(m.taxon, urlWikiData)

parms = New Dictionary(Of String, String)

parms.Add("action", "wbsearchentities")

parms.Add("search", m.taxon) ' "File:Aeoloplides turnbulli P1490124a.jpg"

parms.Add("language", "en")

parms.Add("limit", "50")

parms.Add("continue", "0")

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(urlWikiData, qcontent).Result

s = r1.Content.ReadAsStringAsync().Result

jq = JObject.Parse(s)

jz = jq.SelectToken("search")

qNumber = ""

For i1 As Integer = 0 To jz.Count - 1

Try

s1 = jz(i1).SelectToken("match.type").ToString

s2 = jz(i1).SelectToken("match.language").ToString

s3 = jz(i1).SelectToken("match.text").ToString

Catch ex As Exception

s1 = "" : s2 = "" : s3 = ""

End Try

pageID = jz(i1).SelectToken("title").ToString

If s1 = "label" And s2 = "en" And eqstr(s3, m.taxon) Then

pageID = jz(i1).SelectToken("title").ToString

parms = New Dictionary(Of String, String)

parms.Add("action", "wbgetentities")

parms.Add("ids", pageID) ' "File:Aeoloplides turnbulli P1490124a.jpg"

parms.Add("props", "claims") ' P815 P2464 = bugguide

parms.Add("languages", "en") ' P815

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(urlWikiData, qcontent).Result

s = r1.Content.ReadAsStringAsync().Result

jq = JObject.Parse(s)

jz2 = jq.SelectToken("entities." & pageID & ".claims") ' 109216

' P171 is parent

' P105 is rank

jt = jz2.SelectToken("P171") ' parent

If jt IsNot Nothing Then

s2 = jt.ToList(0)("mainsnak")("datavalue")("value")("id").ToString ' parent qnumber

If s2 <> "" Then

parms = New Dictionary(Of String, String)

parms.Add("action", "wbgetentities")

parms.Add("ids", s2) ' "File:Aeoloplides turnbulli P1490124a.jpg"

parms.Add("props", "claims") ' P815 P2464 = bugguide

parms.Add("languages", "en") ' P815

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(urlWikiData, qcontent).Result

s3 = r1.Content.ReadAsStringAsync().Result

jq = JObject.Parse(s3)

jz2 = jq.SelectToken("entities." & s2 & ".claims")

jt = jz2.SelectToken("P225") ' value

parentTaxon = jt.ToList(0)("mainsnak")("datavalue")("value").ToString ' parent qnumber

If isAncestor(ancestor, parentTaxon, 0) Then Return pageID

End If

jt = jz2.SelectToken("P171") ' grandparent

If jt IsNot Nothing Then

s2 = jt.ToList(0)("mainsnak")("datavalue")("value")("id").ToString ' parent qnumber

If s2 <> "" Then

parms = New Dictionary(Of String, String)

parms.Add("action", "wbgetentities")

parms.Add("ids", s2) ' "File:Aeoloplides turnbulli P1490124a.jpg"

parms.Add("props", "claims") ' P815 P2464 = bugguide

parms.Add("languages", "en") ' P815

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(urlWikiData, qcontent).Result

s3 = r1.Content.ReadAsStringAsync().Result

jq = JObject.Parse(s3)

jz2 = jq.SelectToken("entities." & s2 & ".claims")

jt = jz2.SelectToken("P225") ' value

parentTaxon = jt.ToList(0)("mainsnak")("datavalue")("value").ToString ' parent qnumber

If isAncestor(ancestor, parentTaxon, 0) Then Return pageID

End If

End If

End If

End If

Next i1

Return ""

End Function

Function addInitialPeriods(s As String) As String

' puts periods at initials in reference names.

Dim s1 As String

If s Is Nothing OrElse s = "" Then Return ""

s1 = s.Trim

s1 = Regex.Replace(s1, "([^A-Za-z\-\'’]|^)([A-Z])([^A-Za-z\.\-\'’]|$)", "$1$2.$3") ' A '

s1 = Regex.Replace(s1, "([^A-Za-z\-\'’]|^)([A-Z])([^A-Za-z\.\-\'’]|$)", "$1$2.$3") ' A '

s1 = Regex.Replace(s1, "([^A-Za-z\-\'’]|^)([A-Z])([A-Z])([^A-Za-z\.\-\'’]|$)", "$1$2.$3.$4") ' AA '

s1 = Regex.Replace(s1, "([^A-Za-z\-\'’]|^)([A-Z])([A-Z])([^A-Za-z\.\-\'’]|$)", "$1$2.$3.$4") ' AA '

s1 = Regex.Replace(s1, "([^A-Za-z\-\'’]|^)([A-Z])([A-Z])([A-Z])([^A-Za-z\.\-\'’]|$)", "$1$2.$3.$4.$5") 'AAA'

s1 = Regex.Replace(s1, "([^A-Za-z\-\'’]|^)([A-Z])([A-Z])([A-Z])([^A-Za-z\.\-\'’]|$)", "$1$2.$3.$4.$5") 'AAA'

s1 = Regex.Replace(s1, "([^A-Za-z\-\'’]|^)(Jr)([^A-Za-z\.\-\'’]|$)", "$1$2.$3")

s1 = s1.Replace(" |", "|")

Return s1.Trim

End Function

Sub appendPageTitle(pageTitle As String)

' write to qbug.txt

Dim fname As String

Dim sq() As String = Nothing

fname = Path.ChangeExtension(My.Settings.logfile, "txt")

If pageTitle.StartsWith("orphan") Then

sq = pageTitle.Split(vbTab)

For i1 As Integer = 1 To sq.Count - 1

File.AppendAllText(fname, "* " & Format(Now, "yyyy-MM-dd HH:mm:ss") & " orphan, check parent: " & "" & sq(i1) & "" & vbCrLf)

Next i1

ElseIf pageTitle = "" Then

File.AppendAllText(fname, "* " & vbCrLf & "* " & Format(Now, "yyyy-MM-dd HH:mm:ss") & vbCrLf)

Else

File.AppendAllText(fname, "* " & Format(Now, "yyyy-MM-dd HH:mm:ss") & " " & pageTitle & "" & vbCrLf)

End If

End Sub

Sub outLog(s As String)

File.AppendAllText(My.Settings.logfile, Format(Now, "yyyy-MM-dd HH:mm:ss") & vbTab & s & vbCrLf)

End Sub

Function citation(ref As refrec) As String

' returns a citation in {{cite...}} format

Dim afirst() As String

Dim alast() As String = {}

Dim efirst() As String

Dim elast() As String

Dim cit As String = ""

Dim maxAuthors As Integer = 4

Dim s1 As String

Dim sq() As String

If ref.pubtype <> "" Then

cit = "{{Cite " & ref.pubtype.ToLower

ElseIf ref.journal = "" And ref.url <> "" And ref.chapter = "" Then

cit = "{{Cite web"

Else

cit = "{{Cite journal"

End If

If ref.comment <> "" Then cit &= " " & ref.comment

cit &= vbCrLf

If cit.Contains("Cite web") AndAlso ref.urlAccessed <> "" Then cit &= "| accessdate = " & ref.urlAccessed & vbCrLf

If ref.title <> "" Then cit &= "| title = " & ref.title & vbCrLf

If ref.year <> "" Then cit &= "| date = " & ref.year & vbCrLf

If ref.alast <> "" Then

afirst = ref.afirst.Split("|")

alast = ref.alast.Split("|")

For i As Integer = 0 To afirst.Count - 1

If alast(i) <> "" Then cit &= "| last" & i + 1 & " = " & alast(i) & " | first" & i + 1 & " = " & afirst(i) & vbCrLf

Next i

End If

If ref.elast <> "" Then

efirst = ref.efirst.Split("|")

elast = ref.elast.Split("|")

For i As Integer = 0 To efirst.Count - 1

If elast(i) <> "" Then cit &= "| editor-last" & i + 1 & " = " & elast(i) & " | editor-first" & i + 1 & " = " & efirst(i) & vbCrLf

Next i

End If

If alast.Count > maxAuthors Then cit &= "| display-authors = " & maxAuthors & vbCrLf

If ref.journal <> "" Then cit &= "| journal = " & ref.journal & vbCrLf

If ref.publisher <> "" Then cit &= "| publisher = " & ref.publisher & vbCrLf

s1 = ""

If ref.series <> "" Then s1 &= "| series = " & ref.series

If ref.volume <> "" Then s1 &= "| volume = " & ref.volume

If ref.issue <> "" Then s1 &= "| issue = " & ref.issue

If ref.chapter <> "" Then s1 &= "| chapter = " & ref.chapter

If ref.pages <> "" Then

If ref.pages.Contains("-") Or ref.pages <> "–" Or ref.pages = "," Then

s1 &= "| pages = " & ref.pages

Else

s1 &= "| page = " & ref.pages

End If

End If

If s1 <> "" Then cit &= s1 & vbCrLf

If ref.isbn <> "" Then cit &= "| isbn = " & ref.isbn & vbCrLf

If ref.issn <> "" Then cit &= "| issn = " & ref.issn & vbCrLf

If ref.url <> "" Then cit &= "| url = " & ref.url & vbCrLf ' url not necessary with doi? Sometimes only the URL works.

If ref.doi <> "" Then

cit &= "| doi = " & ref.doi

If ref.doiaccess <> "" Then cit &= "| doi-access = " & ref.doiaccess

cit &= vbCrLf

End If

sq = ref.etc.Split("|".ToCharArray, StringSplitOptions.RemoveEmptyEntries)

For Each s2 As String In sq

If s2.Trim <> "" Then cit &= "| " & s2.Trim & vbCrLf

Next s2

cit &= "}}"

Return cit

End Function

Function getTaxAmbig(taxon As String) As String

If taxAmbig.ContainsKey(taxon) Then Return taxAmbig(taxon)

Return taxon

End Function

Function orphanCheck(pageTitle As String) As List(Of String)

' returns the incoming links in mainspace

Dim parms As New Dictionary(Of String, String)

Dim r1 As HttpResponseMessage

Dim qcontent As FormUrlEncodedContent

Dim jq As JObject

Dim s As String

Dim cont As String

Dim pages As List(Of String)

parms = New Dictionary(Of String, String)

parms.Add("action", "query")

parms.Add("titles", pageTitle) ' "File:Aeoloplides turnbulli P1490124a.jpg"

parms.Add("prop", "linkshere")

parms.Add("lhlimit", "500")

parms.Add("lhnamespace", "0")

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(urlWikiPedia, qcontent).Result

s = r1.Content.ReadAsStringAsync().Result

jq = JObject.Parse(s)

pages = New List(Of String)

If jq.SelectToken("query.pages.*.linkshere") IsNot Nothing Then

For i1 As Integer = 0 To jq.SelectToken("query.pages.*.linkshere").Count - 1

s = jq.SelectToken("query.pages.*.linkshere")(i1)("title")

pages.Add(s)

Next i1

End If

cont = jq.SelectToken("continue.lhcontinue")

parms = New Dictionary(Of String, String)

parms.Add("action", "query")

parms.Add("titles", pageTitle) ' "File:Aeoloplides turnbulli P1490124a.jpg"

parms.Add("prop", "linkshere")

parms.Add("lhlimit", "500")

parms.Add("lhnamespace", "0")

parms.Add("lhcontinue", cont)

parms.Add("format", "json")

qcontent = New FormUrlEncodedContent(parms)

r1 = qClient.PostAsync(urlWikiPedia, qcontent).Result

s = r1.Content.ReadAsStringAsync().Result

jq = JObject.Parse(s)

If jq.SelectToken("query.pages.*.linkshere") IsNot Nothing Then

For i1 As Integer = 0 To jq.SelectToken("query.pages.*.linkshere").Count - 1

s = jq.SelectToken("query.pages.*.linkshere")(i1)("title")

pages.Add(s)

Next i1

End If

cont = jq.SelectToken("continue.lhcontinue")

Return pages

End Function

Class references

Dim name As New List(Of String)

Dim reference As New List(Of String)

Dim used As New List(Of Boolean)

Dim k As Integer

Function refExists(rname As String, ref As String) As Integer

' return 2 if reference itself exists, 1 if the ref name exists, 0 if clear

If reference.Contains(ref) Then Return 2

If name.Contains(rname) Then Return 1

Return 0

End Function

Function Ref(rname As String) As String

'

' sets used = true

k = name.IndexOf(rname)

If k >= 0 Then

used(k) = True

Return ""

Else

Return ""

End If

End Function

Function longRef(rname As String) As String

' does not include and

' does not set used = true

k = name.IndexOf(rname)

If k >= 0 Then

Return reference(k)

Else

Return ""

End If

End Function

Sub addref(rname As String, ref As String)

' adds a references, sets used to false

If refExists(rname, ref) = 0 Then

name.Add(rname)

reference.Add(ref)

used.Add(False)

End If

End Sub

Function allRefs() As String

' returns a string of all the used references, with and

Dim s As String = ""

For i As Integer = 0 To name.Count - 1

If used(i) Then

If s <> "" Then s &= vbCrLf ' blank line between references

s &= "" & vbCrLf & reference(i) & "" & vbCrLf

End If

Next i

Return s

End Function

End Class

Function formatchildren(m As taxrec, children As List(Of taxrec), refs As references,

ancestor As List(Of taxrec), showSource As Boolean) As String

' returns a formatted list of children, either in a sentence or a table.

Dim subrank As String

Dim s, s1, s2 As String

Dim ss As New List(Of String)

Dim sq As New List(Of String)

Dim sTaxon As String

Dim childred As New List(Of taxrec)

Dim source As String

Dim sourceUsed As Boolean = False

Dim spiderflag As Boolean

Dim bugref As String

If children.Count <= 1 Then Return ""

sTaxon = m.taxon

If eqstr(m.rank, "species") Or eqstr(m.rank, "genus") Or eqstr(m.rank, "subspecies") Then sTaxon = "" & sTaxon & ""

For i1 As Integer = 0 To children.Count - 1

s1 = getDisambig(children(i1))

If s1 = "" Then

s1 = children(i1).taxon

If (eqstr(children(i1).rank, "species") Or eqstr(children(i1).rank, "subspecies")) And children.Count = 1 Then s1 = abbreviate(s1)

Else

s1 = s1 & "|" & children(i1).taxon ' should not happen for species or subspecies, so abbreviation won't matter

End If

If eqstr(children(i1).rank, "species") Or eqstr(children(i1).rank, "genus") Then

s1 = "" & s1.Trim & ""

ElseIf eqstr(children(i1).rank, "subspecies") Then

s1 = "" & s1.Trim & ""

Else

s1 = "" & s1.Trim & ""

End If

If children(i1).taxon = "Mesagyrtoides" Then Stop

If children(i1).extinct Then s1 = "† " & s1

If m.spiderID > 0 And children(i1).spiderID <= 0 Then

s1 = "* (" & s1 & ")"

spiderflag = True

Else

s1 = "* " & s1

End If

If children(i1).authority IsNot Nothing AndAlso children(i1).authority.Trim <> "" Then

s1 &= " " & children(i1).authority & ""

End If

source = ""

If showSource Then

If children(i1).itistsn > 0 Then source &= " i"

If children(i1).catLifeID IsNot Nothing AndAlso children(i1).catLifeID <> "" Then source &= " c"

If children(i1).gbifID <> "" Then source &= " g"

If LCase(children(i1).link) IsNot Nothing AndAlso LCase(children(i1).link).Contains("bugguide") Then source &= " b"

If children(i1).spiderID > 0 Then source &= " s"

If source <> "" Then

s1 &= "^{" & source & "}"

sourceUsed = True

End If

End If

s2 = firstCommon(children(i1).taxid)

If s2 <> "" Then s1 &= " (" & s2 & ")"

ss.Add(s1)

Next i1

subrank = LCase(children(0).rank)

ss.Sort()

subrank = pluralRank(subrank)

s = "==" & UCase(subrank.Chars(0)) & subrank.Substring(1) & "==" & vbCrLf

If children.Count < 10 Then

s1 = numeral(children.Count)

Else

s1 = children.Count

End If

s &= "These " & s1 & " " & subrank & " belong to the " & LCase(m.rank) & " " & sTaxon & ":" & vbCrLf

If children.Count >= maxColumn Then

If itisRankID(children(0).rank) >= 220 Then

s &= "{{Div col|colwidth=29em}}" & vbCrLf ' species or subspecies

Else

s &= "{{Div col|colwidth=22em}}" & vbCrLf ' single word taxon

End If

End If

spiderflag = False

For i1 As Integer = 0 To children.Count - 1

s &= ss(i1) & vbCrLf

Next i1

If s.EndsWith(vbCrLf) Then s = s.Substring(0, s.Length - 2)

If children.Count >= maxColumn Then s &= vbCrLf & "{{Div col end}}"

If refs.refExists("bugguide", "") > 0 Then ' name exists - use generic bugguide ref

bugref = refs.Ref("bugguide")

Else

bugref = refs.Ref("buglink") ' specific reference

End If

If sourceUsed Then

If isAncestor(ancestor, "Araneae", 0) Then ' spider

s &= "Data sources: i = ITIS," & refs.Ref("itis") & " c = Catalogue of Life," & refs.Ref("catlife") &

" g = GBIF," & refs.Ref("gbif") & " b = BugGuide.net," & bugref &

" s = World Spider Catalog" & refs.Ref("spidercat") & ""

If spiderflag Then s &= vbCrLf & "" & StrConv(m.rank, VbStrConv.ProperCase) & "names in parentheses may no longer be valid."

Else

s &= vbCrLf & "Data sources: i = ITIS," & refs.Ref("itis") & " c = Catalogue of Life," & refs.Ref("catlife") &

" g = GBIF," & refs.Ref("gbif") & " b = BugGuide.net" & bugref & ""

End If

s &= vbCrLf

End If

Return s

End Function

Function firstCommon(taxonID As String) As String

' select the first common name (the best one, lower case) from wiki.

Dim ss() As String

Dim s As String

If taxonID <> "" Then

s = getScalar("select commonnames from oddinfo where taxid = @parm1", taxonID)

Else

s = ""

End If

If s IsNot Nothing Then

ss = s.Split("|")

If ss.Count >= 1 Then Return ss(0)

End If

Return ""

End Function

Function getDisambig(m As taxrec) As String

' get a disambig link for a taxon, if there is one.

' "" (for no change) or a page title, normally the same but sometimes with (genus) or something added

Dim s1 As String

If m.taxid <> "" Then

s1 = getScalar("select ambiglink from oddinfo where taxid = @parm1", m.taxid)

Else

s1 = ""

End If

If s1 = "" Then s1 = getScalar("select ambiglink from oddinfo where name = @parm1", m.taxon)

Return s1

End Function

Sub defineRefs(tmatch As taxrec, ancestor As List(Of taxrec), bugname As String,

refs As references, showSource As Boolean)

' define the "automatic" references (not in wikirefs) in case they're needed later

Dim s, s1 As String

Dim prec As paleorec

s1 = ""

If tmatch.itistsn > 0 Then

s = "https://www.itis.gov/servlet/SingleRpt/SingleRpt?search_topic=TSN&search_value=" & tmatch.itistsn

s = citeweb(s, bugname & " Report", "Integrated Taxonomic Information System")

'If tmatch.itiscomments IsNot Nothing AndAlso tmatch.itiscomments.Count > 0 Then s &= "{{PD-notice}}"

refs.addref("itis", s)

Else

' define a generic itis ref

s = citeweb("https://www.itis.gov/", "ITIS, Integrated Taxonomic Information System", "")

refs.addref("itis", s)

End If

If tmatch.hodges <> "" AndAlso isAncestor(ancestor, "lepidoptera", 0) Then

s = "http://mothphotographersgroup.msstate.edu/species.php?hodges=" & tmatch.hodges

s1 = tmatch.taxon

If eqstr(tmatch.rank, "species") Or eqstr(tmatch.rank, "genus") Or eqstr(tmatch.rank, "subspecies") Then s1 = "" & s1 & ""

s = citeweb(s, "North American Moth Photographers Group, " & s1, "")

refs.addref("mpg", s)

End If

If tmatch.catLifeID <> "" Then

If eqstr(tmatch.rank, "species") Or eqstr(tmatch.rank, "subspecies") Then

s = "http://www.catalogueoflife.org/col/details/species/id/" & tmatch.catLifeID

s = citeweb(s, bugname & " species details", "Catalogue of Life")

refs.addref("catlife", s)

Else

s = "http://www.catalogueoflife.org/col/browse/tree/id/" & tmatch.catLifeID

s = citeweb(s, "Browse " & bugname, "Catalogue of Life")

refs.addref("catlife", s)

End If

ElseIf showSource Then

' define a generic webref

s = citeweb("http://www.catalogueoflife.org/", "Catalogue of Life", "")

refs.addref("catlife", s)

End If

If tmatch.gbifID <> "" Then

s = "https://www.gbif.org/species/" & tmatch.gbifID

s = citeweb(s, bugname, "GBIF")

refs.addref("gbif", s)

ElseIf showSource Then

' define a generic webref

s = citeweb("https://www.gbif.org/", "GBIF", "")

refs.addref("gbif", s)

End If

If tmatch.spiderlink <> "" Then

s = citeweb(tmatch.spiderlink, bugname, "NMBE World Spider Catalog")

refs.addref("spidercat", s)

End If

If tmatch.iucnID <> "" Then

s = "http://oldredlist.iucnredlist.org/details/" & tmatch.iucnID ' http://www.iucnredlist.org/details/42685/0

s = citeweb(s, bugname & " Red List status", "IUCN Red List")

refs.addref("iucn", s)

End If

If tmatch.taxid <> "" Then

s = citeweb("https://xpda.com/bugs/showQuery.aspx?taxon=" & tmatch.taxon.Replace(" ", "%20"),

" Images and collection data for " & bugname, "Pictures from Earth")

refs.addref("xp01", s)

End If

If tmatch.link <> "" Then

If Not LCase(tmatch.link).StartsWith("wsc.") Or tmatch.spiderlink = "" Then ' use the domain

s1 = getUrlDomain(tmatch.link).Trim

If s1 <> "" Then

If s1.Contains("paleobiodb.org") Then

s = citeweb(tmatch.link, "The Paleobiology Database, " & tmatch.rank & " " & bugname, "")

refs.addref("buglink", s)

Else

If s1 = "bugguide.net" Then s1 = "BugGuide.net"

s = citeweb(tmatch.link, bugname & " " & tmatch.rank & " Information", s1)

refs.addref("buglink", s)

End If

End If

If showSource AndAlso Not tmatch.link.ToLower.Contains("bugguide") Then ' add generic bugguide reference, for data source

s = citeweb("https://bugguide.net/", "BugGuide.net", "")

refs.addref("bugguide", s)

End If

End If

End If

If tmatch.extinct AndAlso (Not s1.Contains("paleobiodb")) Then

' add paleo reference

prec = getPaleo(tmatch)

If prec.pID > 0 Then

s = citeweb("https://paleobiodb.org/classic/basicTaxonInfo?taxon_no=" & prec.pID, "The Paleobiology Database, " & tmatch.rank & " " & bugname, "")

refs.addref("paleo", s)

End If

End If

End Sub

Function citeweb(url As String, title As String, site As String) As String

' returns a citation in {{cite web...] format

Dim s As String

' "{{cite web|url=" & text & "|title=" & webtitle & "|website=" & substring text & "|accessdate= format(date, "yyyy-MM-dd") & "}}"

s = "{{Cite web| title=" & title & vbCrLf

s &= "| url=" & url & vbCrLf

If site <> "" Then s &= "| website=" & site & vbCrLf

s &= "| accessdate=" & Format(CDate(Today), "yyyy-MM-dd") & vbCrLf

s &= "}}"

Return s

End Function

Function createTaxTemplate(m As taxrec, parent As String) As String

' create a taxonomy template for taxrec

Dim sb As StringBuilder

'{{Don't edit this line {{{machine code|}}}

'|rank=

'|link={{subst:#titleparts:{{subst:PAGENAME}}|2|2}}

'|parent=

'|refs=

'}}

sb = New StringBuilder

sb.AppendLine("{{Don't edit this line {{{machine code|}}}")

sb.AppendLine("|rank=" & latinRank(m.rank))

If m.ambigLink <> "" Then

sb.AppendLine("|link=" & m.ambigLink & "|" & m.taxon)

Else

sb.AppendLine("|link=" & m.taxon)

End If

sb.AppendLine("|parent=" & parent)

If m.extinct Then sb.AppendLine("|extinct=yes")

If (m.spiderlink <> "") Then

sb.AppendLine("|refs=" & m.spiderlink)

ElseIf m.taxlink <> "" Then

sb.AppendLine("|refs=" & m.taxlink)

ElseIf m.itistsn > 0 Then

sb.AppendLine("|refs=https://www.itis.gov/servlet/SingleRpt/SingleRpt?search_topic=TSN&search_value=" & m.itistsn)

ElseIf (m.gbifID <> "" And m.gbifID <> "0") Then

sb.AppendLine("|refs=" & "https://www.gbif.org/species/" & m.gbifID)

ElseIf m.catLifeID <> "" Then

sb.AppendLine("|refs=" & "http://www.catalogueoflife.org/col/browse/tree/id/" & m.catLifeID)

Else

Return ""

End If

sb.AppendLine("}}")

Return sb.ToString

End Function

Class paleorec

Public pID As Integer = 0

Public name As String = ""

Public rank As String = ""

Public authority As String = ""

Public commonname As String = ""

Public parentID As Integer = 0

Public parentName As String = ""

Public extant As String = ""

Public nOccurences As Integer = 0

Public firstMaxma As String = ""

Public firstMinma As String = ""

Public lastMaxma As String = ""

Public lastMinma As String = ""

Public earlyinterval As String = ""

Public lateinterval As String = ""

Public nDesc As Integer = 0

Public nExtant As Integer = 0

Public phylum As String = ""

Public cclass As String = ""

Public order As String = ""

Public family As String = ""

Public genus As String = ""

Public imageID As Integer = 0

End Class

Function getPaleoRec(dr As DataRow) As paleorec

Dim prec As New paleorec

If IsDBNull(dr("orig_no")) Then prec.pID = "" Else prec.pID = dr("orig_no")

If IsDBNull(dr("taxon_name")) Then prec.name = "" Else prec.name = dr("taxon_name")

If IsDBNull(dr("taxon_rank")) Then prec.rank = "" Else prec.rank = dr("taxon_rank")

If IsDBNull(dr("taxon_attr")) Then prec.authority = "" Else prec.authority = dr("taxon_attr")

prec.authority = prec.authority.Replace(" and ", " & ")

If IsDBNull(dr("common_name")) Then prec.commonname = "" Else prec.commonname = dr("common_name")

If IsDBNull(dr("parent_no")) Then prec.parentID = "" Else prec.parentID = dr("parent_no")

If IsDBNull(dr("parent_name")) Then prec.parentName = "" Else prec.parentName = dr("parent_name")

If IsDBNull(dr("is_extant")) Then prec.extant = "" Else prec.extant = dr("is_extant")

If IsDBNull(dr("n_occs")) Then prec.nOccurences = "" Else prec.nOccurences = dr("n_occs")

If IsDBNull(dr("firstapp_max_ma")) Then prec.firstMaxma = "" Else prec.firstMaxma = dr("firstapp_max_ma")

If IsDBNull(dr("firstapp_min_ma")) Then prec.firstMinma = "" Else prec.firstMinma = dr("firstapp_min_ma")

If IsDBNull(dr("lastapp_max_ma")) Then prec.lastMaxma = "" Else prec.lastMaxma = dr("lastapp_max_ma")

If IsDBNull(dr("lastapp_min_ma")) Then prec.lastMinma = "" Else prec.lastMinma = dr("lastapp_min_ma")

If IsDBNull(dr("early_interval")) Then prec.earlyinterval = "" Else prec.earlyinterval = dr("early_interval")

If IsDBNull(dr("late_interval")) Then prec.lateinterval = "" Else prec.lateinterval = dr("late_interval")

If IsDBNull(dr("taxon_size")) Then prec.nDesc = "" Else prec.nDesc = dr("taxon_size")

If IsDBNull(dr("extant_size")) Then prec.nExtant = "" Else prec.nExtant = dr("extant_size")

If IsDBNull(dr("phylum")) Then prec.phylum = "" Else prec.phylum = dr("phylum")

If IsDBNull(dr("class")) Then prec.cclass = "" Else prec.cclass = dr("class")

If IsDBNull(dr("oorder")) Then prec.order = "" Else prec.order = dr("oorder")

If IsDBNull(dr("family")) Then prec.family = "" Else prec.family = dr("family")

If IsDBNull(dr("genus")) Then prec.genus = "" Else prec.genus = dr("genus")

If IsDBNull(dr("image_no")) Then prec.imageID = "" Else prec.imageID = dr("image_no")

Return prec

End Function

Function getPaleo(m As taxrec) As paleorec

' get a matching paleo orig_no.

Dim ds As DataSet

Dim author, year, mauthor, myear As String

Dim rm As RegularExpressions.Match

Dim anc As List(Of taxrec)

Dim prec As New paleorec

ds = getDS("select * from paleo.tax where taxon_name = @parm1 and taxon_rank = @parm2 and parent_name <> ''", m.taxon, m.rank)

If ds.Tables(0).Rows.Count = 0 Then Return New paleorec

For Each dr As DataRow In ds.Tables(0).Rows

prec = getPaleoRec(dr)

rm = Regex.Match(dr("taxon_attr"), "^.*?([\p{L}\-\.]+?),? ([0-9]{4})\)?$")

If rm.Groups.Count = 3 Then

author = rm.Groups(1).Value

year = rm.Groups(2).Value

Else

author = ""

year = ""

End If

rm = Regex.Match(m.authority, "^.*?([a-zA-Z\-\.]+?),? ([0-9]{4})\)?$")

If rm.Groups.Count = 3 Then

mauthor = rm.Groups(1).Value

myear = rm.Groups(2).Value

Else

mauthor = ""

myear = ""

End If

If year <> "" And year = myear OrElse author <> "" And

String.Compare(mauthor, author, StringComparison.OrdinalIgnoreCase) = 0 Then Return prec

' check ancestor

anc = getancestors(m, 1, False, "kingdom")

If isAncestor(anc, dr("parent_name"), 0) Then Return prec

If dr("family") <> "" Then

If isAncestor(anc, dr("family"), 0) Then Return prec

Else ' family blank

If isAncestor(anc, dr("oorder"), 0) Then Return prec

End If

Next dr

Return New paleorec

End Function

End Module