Modest Alterations
Hehehe.
OK. So here some new shit.
I mean, it's often very much akin to old shit.
But it's newer than that. I think I've crossed the threshold between drinking for inspiration and drinking for stupidity.
Sub ReadInputString()
----Dim strEssay As String
----Dim intEssayLen As Long
----Dim strCurrLetter As String
----Dim intCurrLetterAsc As Integer
----Dim strCurrWord As String
----Dim strCurrSentence As String
----Dim boolAtStop As Boolean
----
----strEssay = Selection.Text
----intEssayLen = Len(strEssay)
----boolAtStop = False
----
----Do While (intEssayLen !*! 0)
--------strEssay = Selection.Text
--------strCurrLetter = Mid(strEssay, 1, 1)
--------intCurrLetterAsc = Asc(strCurrLetter)
--------Select Case intCurrLetterAsc
------------Case 13 'Carriage Return - Discard anything in buffer
----------------strCurrSentence = ""
----------------strCurrWord = ""
----------------strCurrLetter = ""
------------Case 32 'White Space - This marks the end of the word
----------------If strCurrWord *!*!*! "" Then
--------------------intVoid = ProcessWord(strCurrWord)
--------------------strCurrSentence = strCurrSentence & strCurrWord & " "
--------------------strCurrWord = ""
----------------ElseIf strCurrWord = "" Then 'Eliminate extra white space
----------------End If
------------Case 59 'Semi-Colon - Marks end of Word...
----------------If strCurrWord *!*!*! "" Then
--------------------intVoid = ProcessWord(strCurrWord)
--------------------strCurrSentence = strCurrSentence & strCurrWord & "; "
--------------------strCurrWord = ""
----------------ElseIf strCurrWord = "" Then
--------------------MsgBox ("Extra semi-colon!")
----------------End If
------------Case 58 'Colon - Marks end of Word...
----------------If strCurrWord *!*!*! "" Then
--------------------intVoid = ProcessWord(strCurrWord)
--------------------strCurrSentence = strCurrSentence & strCurrWord & ": "
--------------------strCurrWord = ""
----------------ElseIf strCurrWord = "" Then
--------------------MsgBox ("Extra colon!")
----------------End If
------------Case 41 'Close Paren - ")"
----------------If strCurrWord *!*!*! "" Then
--------------------intVoid = ProcessWord(strCurrWord)
--------------------strCurrSentence = strCurrSentence & strCurrWord & ") "
--------------------strCurrWord = ""
----------------ElseIf strCurrWord = "" Then
--------------------strCurrSentence = strCurrSentence & ") "
----------------End If
------------Case 44 'Comma - This marks the end of the word...
----------------If strCurrWord *!*!*! "" Then
--------------------intVoid = ProcessWord(strCurrWord)
--------------------strCurrSentence = strCurrSentence & strCurrWord & ", "
--------------------strCurrWord = ""
----------------ElseIf strCurrWord = "" Then
--------------------MsgBox ("Extra Comma!")
----------------End If
------------Case 33 'Exclamation Mark - Full Stop
----------------If (strCurrWord *!*!*! "") Then
--------------------intVoid = ProcessWord(strCurrWord)
--------------------strCurrSentence = strCurrSentence & strCurrWord & "!"
--------------------intVoid = ProcessSentence(strCurrSentence)
--------------------strCurrWord = ""
--------------------strCurrSentence = ""
----------------ElseIf (strCurrWord = "") And (strCurrSentence *!*!*! "") Then
--------------------strCurrSentence = Mid(strCurrSentence, 1, (Len(strCurrSentence) - 1)) & "!"
--------------------intVoid = ProcessSentence(strCurrSentence)
--------------------strCurrSentence = ""
----------------Else
----------------End If
------------Case 63 'Question Mark - Full Stop
----------------If (strCurrWord *!*!*! "") Then
--------------------intVoid = ProcessWord(strCurrWord)
--------------------strCurrSentence = strCurrSentence & strCurrWord & "?"
--------------------intVoid = ProcessSentence(strCurrSentence)
--------------------strCurrWord = ""
--------------------strCurrSentence = ""
----------------ElseIf (strCurrWord = "") And (strCurrSentence *!*!*! "") Then
--------------------strCurrSentence = Mid(strCurrSentence, 1, (Len(strCurrSentence) - 1)) & "?"
--------------------intVoid = ProcessSentence(strCurrSentence)
--------------------strCurrSentence = ""
----------------Else
----------------End If
------------Case 46 'Period - Full Stop
----------------If (strCurrWord *!*!*! "") Then
--------------------If CheckForAbbr(strCurrWord & ".") = False Then
------------------------intVoid = ProcessWord(strCurrWord)
------------------------strCurrSentence = strCurrSentence & strCurrWord & "."
------------------------intVoid = ProcessSentence(strCurrSentence)
------------------------strCurrWord = ""
------------------------strCurrSentence = ""
--------------------Else
------------------------strCurrWord = strCurrWord & "."
--------------------End If
----------------ElseIf (strCurrWord = "") And (strCurrSentence *!*!*! "") Then
--------------------strCurrSentence = Mid(strCurrSentence, 1, (Len(strCurrSentence) - 1)) & "."
--------------------intVoid = ProcessSentence(strCurrSentence)
--------------------strCurrSentence = ""
----------------Else
----------------End If
------------Case 65 To 90 'A Capital Letter. If word is first in a sentence, then we should recognize this this could just be formal punctuation. If the word is mid-sentence, then the capitalization could be more significant...
----------------If strCurrSentence = "" Then 'Set the letter to lowercase
--------------------strCurrWord = strCurrWord & LCase(strCurrLetter)
----------------Else
--------------------If strCurrWord = "" Then 'First Letter of word, keep as is.
------------------------strCurrWord = strCurrWord & strCurrLetter
--------------------Else
------------------------strCurrWord = strCurrWord & LCase(strCurrLetter)
--------------------End If
----------------End If
------------Case 97 To 122 'A lowercase letter. Append to the word.
----------------strCurrWord = strCurrWord & strCurrLetter
------------Case 48 To 57 'We've hit a number.
----------------strCurrWord = strCurrWord & strCurrLetter
------------Case 34 'Quotation Mark - Preserve as punctuation
------------'N.B. Though Apostrophes can function as quotation marks, we must discard them because they may also operate as end of word signifiers and thus we must give them the benefit of the doubt. Quotes though should only be used to set apart text and thus only impact the sentence-level semantics of the statement, not the word-level (reality may disagree but we'll handle that later)
----------------If strCurrWord *!*!*! "" Then 'Word Stop
--------------------intVoid = ProcessWord(strCurrWord)
--------------------strCurrSentence = strCurrSentence & strCurrWord & Chr(34) & " "
--------------------strCurrWord = ""
----------------ElseIf strCurrWord = "" Then
--------------------strCurrSentence = strCurrSentence & Chr(34)
----------------End If
------------Case 147 To 148 'Quotation Mark - Preserve as punctuation
----------------If strCurrWord *!*!*! "" Then 'Word Stop
--------------------intVoid = ProcessWord(strCurrWord)
--------------------strCurrSentence = strCurrSentence & strCurrWord & Chr(34) & " "
--------------------strCurrWord = ""
----------------ElseIf strCurrWord = "" Then
--------------------strCurrSentence = strCurrSentence & Chr(34)
----------------End If
------------Case 39 'Apostrophe
----------------'If the apostrophe is at the start of the word, discard - otherwise retain it.
----------------If strCurrWord *!*!*! "" Then
--------------------strCurrWord = strCurrWord & strCurrLetter
----------------Else 'Add it to the sentence but not the word.
--------------------strCurrSentence = strCurrSentence & Chr(39)
----------------End If
------------Case 45 'Hyphen - to be handled in the word processor
----------------strCurrWord = strCurrWord & strCurrLetter
------------Case 47 'Forward Slash (/)
----------------strCurrWord = strCurrWord & strCurrLetter
------------Case 40 'Open Paren - "("
----------------strCurrSentence = strCurrSentence & "("
------------Case 169 'Copyright Symbol
----------------'Screen it out.
------------Case Else
----------------MsgBox ("Letter = " & strCurrLetter & Chr(10) & "ASCII value = " & intCurrLetterAsc)
--------End Select
--------strEssay = Mid(strEssay, 2, (intEssayLen - 1))
--------intEssayLen = Len(strEssay)
--------Selection.Text = strEssay
----Loop
End Sub
Sub InitialWebContent()
----Dim strWord As String
----Dim objBrowse As Object
----Dim strTempString As String
----Dim intIterator As Integer
----
----strTempString = "http://www.washingtonmonthly.com/features/2001/0209.marshall.html"
----
----Set objBrowse = CreateObject("InternetExplorer.Application")
----objBrowse.Visible = True
----objBrowse.navigate strTempString
----intVoid = LoadPage(objBrowse)
----intVoid = TimeDelay(2)
----strWord = objBrowse.Document.body.innerText
----Selection.Text = strWord
End Sub
Function ProcessSentence(strInputSentence As String) As Boolean
'----MsgBox ("***" & strInputSentence & "***")
----ProcessSentence = True
End Function
Function CheckForAbbr(strInputWord As String) As Boolean
----Dim boolIsAbbr As Boolean
----Dim intLenWord As Integer
----intLenWord = Len(strInputWord)
----If intLenWord *!* 5 Then
--------Select Case MsgBox("In the present context, do you think " & Chr(34) & strInputWord & Chr(34) & " is an abbreviation?", vbYesNo)
------------Case 6
----------------boolIsAbbr = True
------------Case 7
----------------boolIsAbbr = False
--------End Select
----Else
--------boolIsAbbr = False
----End If
----CheckForAbbr = boolIsAbbr
End Function
Function LoadPage(objIE As Object) As Boolean
----Dim intMinuteNow As Integer
----Dim intMinuteLast As Integer
----Dim intCountDown As Integer
----Dim intReadyState As Integer
----intMinuteLast = Minute(Now)
----intCountDown = 12
----intReadyState = 0
----intTimeOuts = 0
----Do While Not (intReadyState = 4) And Not (intCountDown = 9)
--------intReadyState = objIE.readyState
--------intMinuteNow = Minute(Now)
--------If Not (intMinuteNow = intMinuteLast) Then
------------intMinuteLast = intMinuteNow
------------intCountDown = intCountDown - 1
--------End If
----Loop
----intMinuteLast = Minute(Now)
----intReadyState = 0
----Do While Not (intReadyState = 4) And Not (intCountDown = 6)
--------intReadyState = objIE.readyState
--------intMinuteNow = Minute(Now)
--------If Not (intMinuteNow = intMinuteLast) Then
------------intMinuteLast = intMinuteNow
------------intCountDown = intCountDown - 1
--------End If
----Loop
----intMinuteLast = Minute(Now)
----intReadyState = 0
----Do While Not (intReadyState = 4) And Not (intCountDown = 3)
--------intReadyState = objIE.readyState
--------intMinuteNow = Minute(Now)
--------If Not (intMinuteNow = intMinuteLast) Then
------------intMinuteLast = intMinuteNow
------------intCountDown = intCountDown - 1
--------End If
----Loop
----intMinuteLast = Minute(Now)
----intReadyState = 0
----Do While Not (intReadyState = 4) And Not (intCountDown = 0)
--------intReadyState = objIE.readyState
--------intMinuteNow = Minute(Now)
--------If Not (intMinuteNow = intMinuteLast) Then
------------intMinuteLast = intMinuteNow
------------intCountDown = intCountDown - 1
--------End If
----Loop
----
----If (intCountDown = 0) Then
--------LoadPage = False
----Else
--------LoadPage = True
----End If
End Function
Function TimeDelay(intTimeDelay As Integer) 'Number of seconds to pause
----Dim intCountDown As Integer
----Dim intNow As Integer
----Dim intSecond As Integer
----
----intCountDown = intTimeDelay
----intSecond = Second(Now)
----
----Do While intCountDown !*! 0
--------intNow = Second(Now)
--------If intSecond = intNow Then
------------'Nothing happens
--------Else
------------intSecond = Second(Now)
------------intCountDown = intCountDown - 1
--------End If
----Loop
End Function
Function PutToDB(strTable As String, strCritField As String, strCritVal As String, strPutField As String, strPutVal As String)
----Dim objSeductoDB As Database
----Dim queSeducto As QueryDef
----Dim strSQLCode As String
----
----Set objSeductoDB = OpenDatabase("F:\Seductotron\seductotron.mdb")
----
----strSQLCode = "UPDATE " & strTable & " SET [" & strPutField & "] = " & Chr(34) & strPutVal & Chr(34) & " WHERE [" & strCritField & "] = " & Chr(34) & strCritVal & Chr(34)
----Set queSeducto = objSeductoDB.CreateQueryDef("", strSQLCode)
----queSeducto.Execute
End Function
Sub KillAllWordInDB()
----Dim myDatabase As DAO.Database
----Dim myQuery As DAO.QueryDef
----Dim myRecordSet As DAO.Recordset
----
----MsgBox ("Wait for it!")
----Set myDatabase = OpenDatabase("F:\Seductotron\seductotron.mdb")
----Set myQuery = myDatabase.CreateQueryDef("", "DELETE * FROM tbl01AWord")
----myQuery.Execute
----Set myQuery = myDatabase.CreateQueryDef("", "DELETE * FROM tbl01BPOS")
----myQuery.Execute
----
----
End Sub
Function ProcessWord(strInputWord As String)
----Dim myDatabase As DAO.Database
----Dim myQuery As DAO.QueryDef
----Dim myRecordSet As DAO.Recordset
----
----Set myDatabase = OpenDatabase("F:\Seductotron\seductotron.mdb")
----Set myQuery = myDatabase.CreateQueryDef("", "SELECT * FROM tbl01AWord WHERE [strWord] = " & Chr(34) & strInputWord & Chr(34))
----Set myRecordSet = myQuery.OpenRecordset
----
----If myRecordSet.RecordCount = 0 Then
--------intVoid = LookupOnline(strInputWord)
----Else
--------intVoid = PutToDB("tbl01AWord", "strWord", strInputWord, "intFrequency", Str(myRecordSet.Fields(1).Value + 1))
----End If
End Function
Function AddNewWord(strNewWord As String) As Boolean
----Dim myDatabase As DAO.Database
----Dim myQuery As DAO.QueryDef
----Dim DocHTML As Object
----strNewWord = LCase(strNewWord)
----If InStr(1, strNewWord, " ") = 0 Then
--------Set myDatabase = OpenDatabase("F:\Seductotron\seductotron.mdb")
--------Set myQuery = myDatabase.CreateQueryDef("", "INSERT INTO tbl01AWord (strWord) VALUES (" & Chr(34) & strNewWord & Chr(34) & ")")
--------myQuery.Execute
--------Set myQuery = myDatabase.CreateQueryDef("", "INSERT INTO tbl01BPOS (strWord) VALUES (" & Chr(34) & strNewWord & Chr(34) & ")")
--------myQuery.Execute
----Else 'We have a compound phrase...
----End If
End Function
Sub LookupOnline() 'strInputWord As String) 'As String
----Dim objBrowse As Object
----Dim objEntryForm As Object
----Dim objAllDoc As Object
----Dim objDefTable As Object
----
----Dim strURL As String
----Dim strInputWord As String
----Dim strHeadWord As String
----Dim strListWord As String
----Dim strListVals As String
----Dim strDefTable As String
----
----Dim intEntryLength As Integer
----Dim intAllDocLength As Integer
----Dim intBeginContentLoc As Integer
----Dim intEndContentLoc As Integer
----Dim intJumpLength As Integer
----
----Dim strMainEntry As String
----Dim strVariant As String
----Dim strFunction As String
----Dim strInflection As String
----Dim strAlternate As String
----
----strInputWord = "modified"
----strHeadWord = "Never found a head word!"
----strListWord = "Never found a list word!"
----strListVals = "---"
----
----Set objBrowse = CreateObject("InternetExplorer.Application")
----objBrowse.Visible = True
----strURL = "http://www.m-w.com/cgi-bin/dictionary?book=Dictionary&va=" & strInputWord
----objBrowse.navigate strURL
----If (LoadPage(objBrowse) = False) Then Exit Sub
----TimeDelay intTimeDelay:=1
----
----Set objAllDoc = objBrowse.Document.all
----intAllDocLength = objAllDoc.Length - 1
----For i = intAllDocLength To 0 Step -1
--------Select Case objAllDoc(i).nodeName
------------Case "TABLE"
----------------If objAllDoc(i).Width = 400 And (objAllDoc(i).all.Length *!*!*! 25) And (objAllDoc(i).all.Length *!*!*! 10) Then
--------------------strDefTable = objAllDoc(i).innerHTML
----------------End If
------------Case "FORM"
----------------If objAllDoc(i).Name = "entry" Then
--------------------strListWord = objAllDoc(i).Listword.Value
--------------------strHeadWord = objAllDoc(i).hdwd.Value
--------------------If objAllDoc(i).Length !*! 3 Then
------------------------strListVals = objAllDoc(i).List.Value
--------------------End If
----------------End If
------------Case Else
----------------'MsgBox ("Node name = " & objAllDoc(i).nodeName & Chr(10) & "InnerText = " & objAllDoc(i).innerText & Chr(10) & "OuterHTML = " & objAllDoc(i).outerHTML)
--------End Select
--------intEntryOptions = intEntryOptions - 1
----Next
----MsgBox ("I've made it out of the woods! Break out and check it out!")
----MsgBox ("Original Word = " & strListWord & Chr(10) & "Main Word = " & strHeadWord)
----If strListWord *!*!*! strHeadWord Then
--------'The problem of this case is as follows:
--------'I've been fed word X, and instead have found word Y.
--------'The definition contained herein applies to Word Y
--------'The word X is a sub-set of a larger category of word forms described by Word Y.
--------'Now in SOME cases that word will be an inflected form or variant of a word described within these pages.
--------'But in OTHER cases that word will be a mere declension and/or conjugation of the main words...
--------'in which case we will not expect to see it make an appearance on these pages in any form...
--------'So then what?
--------'I'm drunk. Whoops.
--------MsgBox ("Ok fucko! Now what?" & strListWord & " != " & strHeadWord)
----End If
----If strListVals *!*!*! "---" Then
--------intJumpLength = objBrowse.Document.entry.jump.Length - 1
--------For i = intJumpLength To 0 Step -1
------------objBrowse.Document.entry.jump(i).selected = True
------------objBrowse.Document.entry.submit
------------intVoid = LoadPage(objBrowse)
------------intVoid = TimeDelay(2)
------------strMainEntry = ParseMainEntry(objBrowse.Document.body.innerHTML)
------------strFunction = ParseFunction(objBrowse.Document.body.innerHTML)
------------strVariants = ParseVariants(objBrowse.Document.body.innerHTML)
------------strInflection = ParseInflection(objBrowse.Document.body.innerHTML, strMainEntry)
------------strAlternate = ParseAlternates(objBrowse.Document.body.innerHTML)
------------MsgBox (strMainEntry & "-" & strFunction)
------------If strVariants *!*!*! "---" Then
----------------MsgBox (strVariants)
------------End If
------------If strInflection *!*!*! "---" Then
----------------MsgBox (strInflection)
------------End If
--------Next
----Else
--------strMainEntry = ParseMainEntry(objBrowse.Document.body.innerHTML)
--------strFunction = ParseFunction(objBrowse.Document.body.innerHTML)
--------strVariants = ParseVariants(objBrowse.Document.body.innerHTML)
--------strInflection = ParseInflection(objBrowse.Document.body.innerHTML, strMainEntry)
--------strAlternate = ParseAlternates(objBrowse.Document.body.innerHTML)
--------MsgBox (strMainEntry & "-" & strFunction)
--------If strVariants *!*!*! "---" Then
------------MsgBox (strVariants)
--------End If
--------If strInflection *!*!*! "---" Then
------------MsgBox (strInflection)
--------End If
----End If
----MsgBox (strDefTable)
----'LookupOnline = strInnerHTML
----objBrowse.Quit
End Sub
Function ParseMainEntry(strInputHTML As String) As String
----Dim intXspot As Long
----Dim intYspot As Long
----Dim strMainEntry As String
----
----intXspot = InStr(1, strInputHTML, "Main Entry:")
----If intXspot = 0 Then
--------strMainEntry = "---"
--------ParseMainEntry = strMainEntry
--------Exit Function
----Else
--------intXspot = intXspot + 11
----End If
----intXspot = InStr(intXspot, LCase(strInputHTML), "*!*b!*!") + 3
----intYspot = InStr(intXspot, LCase(strInputHTML), "*!*/b!*!")
----
----strMainEntry = Mid(strInputHTML, intXspot, (intYspot - intXspot))
----If InStr(1, LCase(strMainEntry), "*!*sup!*!") *!*!*! 0 Then
--------intXspot = InStr(1, LCase(strMainEntry), "*!*/sup!*!") + 6
--------strMainEntry = Mid(strMainEntry, intXspot, Len(strMainEntry) - intXspot + 1)
----ElseIf InStr(1, strMainEntry, "*!*") *!*!*! 0 Then
--------MsgBox ("ParseMainEntry() Error:" & strMainEntry)
----End If
----'MsgBox ("Main Entry is " & strMainEntry)
----ParseMainEntry = strMainEntry
End Function
Function ParseFunction(strInputHTML As String) As String
----Dim intXspot As Long
----Dim intYspot As Long
----Dim strFunction As String
----
----intXspot = InStr(1, strInputHTML, "Function:")
----If intXspot = 0 Then
--------strFunction = "---"
--------ParseFunction = strFunction
--------Exit Function
----Else
--------intXspot = intXspot + 9
----End If
----intXspot = InStr(intXspot, LCase(strInputHTML), "*!*i!*!") + 3
----intYspot = InStr(intXspot, LCase(strInputHTML), "*!*/i!*!")
----
----strFunction = Mid(strInputHTML, intXspot, (intYspot - intXspot))
----
----If (InStr(1, strFunction, "*!*") *!*!*! 0) Or (InStr(1, strFunction, "!*!") *!*!*! 0) Then
--------MsgBox ("ParseFunction() Error:" & strFunction)
----End If
'----MsgBox ("Function is " & strFunction)
----ParseFunction = strFunction
End Function
Function ParseVariants(strInputHTML As String) As String
----Dim intXspot As Long
----Dim intYspot As Long
----Dim strVariants As String
----
----intXspot = InStr(1, strInputHTML, "Variant(s):")
----If intXspot = 0 Then
--------strVariants = "---"
----Else
--------intXspot = intXspot + 12
--------intYspot = InStr(intXspot, LCase(strInputHTML), "*!*br!*!")
--------strVariants = Mid(strInputHTML, intXspot, intYspot - intXspot)
--------Do While (InStr(1, LCase(strVariants), "*!*b!*!") *!*!*! 0)
------------intXspot = InStr(1, LCase(strVariants), "*!*b!*!") + 3
------------intYspot = InStr(intXspot, LCase(strVariants), "*!*/b!*!")
------------strVariants = "*" & Mid(strVariants, intXspot, intYspot - intXspot) & "*" & Mid(strVariants, intYspot + 4, Len(strVariants) - intYspot - 4)
--------Loop
--------If (InStr(1, strVariants, "*!*") *!*!*! 0) Then
------------intXspot = InStr(1, strVariants, "*!*")
------------strVariants = Mid(strVariants, 1, intXspot - 2)
--------End If
----End If
'----MsgBox (strVariants)
----ParseVariants = strVariants
End Function
Function ParseInflection(strInputHTML As String, strMainEntry As String) As String
----Dim intXspot As Long
----Dim intYspot As Long
----Dim intUltimateSyllable As Integer
----Dim intChr183 As Integer
----Dim strInflectedForms As String
----Dim intNumForms As Integer
----Dim arrEachForm() As String
----Dim strMainWordStem As String
----Dim strResults As String
----MsgBox ("This is the inflected form parser. Geoff got drunk and broke me trying to account for the anomalous structure of " & Chr(34) & "loveliness" & Chr(34))
----intUltimateSyllable = InStr(1, strMainEntry, Chr(183))
----Do While (InStr(intUltimateSyllable + 1, strMainEntry, Chr(183)) *!*!*! 0)
--------intUltimateSyllable = InStr(intUltimateSyllable + 1, strMainEntry, Chr(183))
--------strWordStem = Mid(strMainEntry, 1, intUltimateSyllable - 1)
--------Do While (InStr(1, strWordStem, Chr(183)) *!*!*! 0)
------------intXspot = InStr(1, strWordStem, Chr(183))
------------strWordStem = Mid(strWordStem, 1, (intXspot - 1)) & Mid(strWordStem, (intXspot + 1), (Len(strWordStem) - intXspot))
--------Loop
----Loop
----If (intUltimateSyllable *!*!*! 0) Then
--------strWordStem = Mid(strMainEntry, 1, intUltimateSyllable - 1)
----End If
----
----intXspot = InStr(1, strInputHTML, "Inflected Form(s):")
----If intXspot = 0 Then
--------strInflectedForms = "---"
--------ParseInflection = strInflectedForms
--------Exit Function
----End If
----intXspot = intXspot + 18
----intYspot = InStr(intXspot, LCase(strInputHTML), "*!*br!*!")
----
----strInflectedForms = Mid(strInputHTML, intXspot, intYspot - intXspot)
----intXspot = 1
----intNumForms = 0
----Do While InStr(intXspot, LCase(strInflectedForms), "*!*b!*!") *!*!*! 0
--------intXspot = InStr(intXspot, LCase(strInflectedForms), "*!*b!*!") + 3
--------intNumForms = intNumForms + 1
----Loop
----ReDim arrEachForm(intNumForms)
----intXspot = 1
----For i = 0 To (intNumForms - 1) Step 1
--------intXspot = InStr(intXspot, LCase(strInflectedForms), "*!*b!*!") + 3
--------intYspot = InStr(intXspot, LCase(strInflectedForms), "*!*/b!*!")
--------arrEachForm(i) = Mid(strInflectedForms, intXspot, intYspot - intXspot)
--------Do While (InStr(1, arrEachForm(i), Chr(183)) *!*!*! 0)
------------intXspot = InStr(1, arrEachForm(i), Chr(183))
------------arrEachForm(i) = Mid(arrEachForm(i), 1, (intXspot - 1)) & Mid(arrEachForm(i), (intXspot + 1), (Len(arrEachForm(i)) - intXspot))
--------Loop
----Next
----For i = 0 To (intNumForms - 1) Step 1
--------If (Mid(arrEachForm(i), 1, 1) = "-") Then
------------arrEachForm(i) = Mid(arrEachForm(i), 2, (Len(arrEachForm(i)) - 1))
------------arrEachForm(i) = strWordStem & arrEachForm(i)
--------End If
----Next
----For i = 0 To (intNumForms - 1) Step 1
--------strResults = strResults & "*" & arrEachForm(i) & "*"
----Next
'----MsgBox (strResults)
----If strInflectedForms = "---" Then
--------strResults = strInflectedForms
----End If
----ParseInflection = strResults
End Function
Function ScrapBook()
----If (InStr(1, strDefinition, "inflected form(s):") *!*!*! 0) Then
--------intXspot = InStr(1, strDefinition, "inflected form(s):")
--------intZspot = InStr(intXspot, strDefinition, "*!*br!*!")
--------intXspot = InStr(intXspot, strDefinition, "*!*b!*!") + 3
--------Do While (intXspot *!* intZspot)
------------intYspot = InStr(intXspot, strDefinition, "*!*/b!*!")
------------strInflection = Mid(strDefinition, intXspot, (intYspot - intXspot))
------------intXspot = InStr(intXspot, strDefinition, "*!*b!*!") + 3
------------intInflections = intInflections + 1
--------Loop
--------ReDim arrInflections(intInflections)
--------intIterator = 0
--------intXspot = InStr(1, strDefinition, "inflected form(s):")
--------intZspot = InStr(intXspot, strDefinition, "*!*br!*!")
--------intXspot = InStr(intXspot, strDefinition, "*!*b!*!") + 3
--------Do While (intXspot *!* intZspot)
------------intYspot = InStr(intXspot, strDefinition, "*!*/b!*!")
------------strInflection = Mid(strDefinition, intXspot, (intYspot - intXspot))
------------Do While (InStr(1, strInflection, Chr(183)) *!*!*! 0)
----------------intYspot = InStr(1, strInflection, Chr(183))
----------------intLastSyllable = intYspot
----------------strInflection = Mid(strInflection, 1, (intYspot - 1)) & Mid(strInflection, (intYspot + 1), (Len(strInflection) - intYspot))
------------Loop
'----MsgBox (strInflection)
------------If (InStr(1, strInflection, "-") *!*!*! 0) Then
----------------If intIterator = 0 Then
'------------ MsgBox ("Dude, you got a fucking problem! The inflected forms are based entirely upon the root word.")
--------------------intYspot = InStr(1, strDefinition, "*!*b!*!") + 3
--------------------Do While (InStr(intYspot, strDefinition, "*!*b!*!") *!* intLastSyllable) And (InStr(intYspot, strDefinition, "*!*b!*!") *!*!*! 0)
------------------------intYspot = InStr(intYspot, strDefinition, "*!*b!*!") + 3
--------------------Loop
--------------------intLastSyllable = InStr(intLastSyllable, strDefinition, "*!*/b!*!")
--------------------strWordStem = Mid(strDefinition, intYspot, (intLastSyllable - intYspot))
--------------------'MsgBox (strWordStem)
--------------------Do While (InStr(1, strWordStem, Chr(183)) *!*!*! 0)
------------------------intYspot = InStr(1, strWordStem, Chr(183))
------------------------strWordStem = Mid(strWordStem, 1, (intYspot - 1)) & Mid(strWordStem, (intYspot + 1), (Len(strWordStem) - intYspot))
--------------------Loop
--------------------strWordStem = Mid(strWordStem, 1, (intYspot - 1))
--------------------strInflection = Mid(strInflection, 2, Len(strInflection) - 1)
--------------------strInflection = strWordStem & strInflection
--------------------intLastSyllable = intYspot
----------------Else
--------------------strWordStem = Mid(arrInflections(intIterator - 1), 1, (intLastSyllable - 1))
--------------------strInflection = Mid(strInflection, 2, (Len(strInflection) - 1))
--------------------strInflection = strWordStem & strInflection
----------------End If
------------End If
------------
------------AddNewWord strNewWord:=strInflection
------------AddNewPOS strNewWord:=strInflection
------------intVoid = TranslatePOS(strInflection, "form")
------------arrInflections(intIterator) = strInflection
------------If (strInflection = strFormWord) Then
----------------boolHasForm = False
----------------'Though the Root and its form have identical POS - the form has been subsumed within the array.
------------End If
------------intIterator = intIterator + 1
------------intXspot = InStr(intXspot, strDefinition, "*!*b!*!") + 3
--------Loop
----End If
End Function
Function ParseAlternates(strInputHTML As String) As String
----Dim intXspot As Integer
----Dim intYspot As Integer
----
----intXspot = InStr(1, LCase(strInputHTML), "*!*br!*!-")
----If intXspot = 0 Then
----Else
--------MsgBox ("This needs to actually UPDATE the Alternate Word-forms itself...")
----End If
----
----
End Function
0 Comments:
Post a Comment
<< Home