Seductotron
Sub TestMeNow()
----Dim strWord As String
----Dim objBrowse As Object
----Dim strTempString As String
----Dim intIterator As Integer
----
----strTempString = "http://www.slate.com/id/2100915/"
----intIterator = 500
----
----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
Sub Seductotron()
----Dim strWord As String
----Dim objBrowse As Object
----Dim strTempString As String
----Dim intIterator As Integer
----
----strTempString = "http://www.craigslist.org/about/best/sfo/3012712.html"
----intIterator = 500
----
----Set objBrowse = CreateObject("InternetExplorer.Application")
----objBrowse.Visible = True
----intVoid = CraigslistBestOfVocab(objBrowse, strTempString)
----intVoid = True
----Do While intIterator !*! 0
--------intVoid = LearnPOS(objBrowse)
--------intIterator = intIterator - 1
----Loop
----
----intViod = CraigslistBestOfStruct(objBrowse, strTempString)
End Sub
Function SeductoTwo()
----Dim strWord As String
----Dim objBrowse As Object
----Dim strTempString As String
----Dim intIterator As Integer
----
----Set objBrowse = CreateObject("InternetExplorer.Application")
----objBrowse.Visible = True
----intIterator = 500
----Do While intIterator !*! 0
--------intVoid = LearnPOS(objBrowse)
--------intIterator = intIterator - 1
----Loop
----intIterator = 100
----Do While intIterator !*! 0
--------strWord = WriteRandomSentence()
--------strTempString = strTempString & " " & strWord
--------intIterator = intIterator - 1
----Loop
----Selection.Text = strTempString
End Function
Function WriteRandomSentence() As String
----Dim strSentenceGrammar As String
----Dim strSentenceWords As String
----Dim strCurrentGrammeme As String
----Dim strCurrentWord As String
----Dim WordSet As recordset
----Dim strCurrentLetter As String
----Dim intLength As Long
----
----strSentenceGrammar = Trim(GetRandomSentenceStruct())
----intLength = Len(strSentenceGrammar)
' MsgBox (strSentenceGrammar)
----Do While (intLength !*! 0)
--------strCurrentLetter = Mid(strSentenceGrammar, 1, 1)
--------Select Case strCurrentLetter
------------Case "0"
----------------strCurrentGrammeme = strCurrentGrammeme & strCurrentLetter
------------Case "1"
----------------strCurrentGrammeme = strCurrentGrammeme & strCurrentLetter
------------Case Else
----------------If Not (strCurrentGrammeme = "") Then
--------------------Set WordSet = TranslateGrammemeToWord(strCurrentGrammeme)
--------------------strCurrentWord = ChooseWord(WordSet)
--------------------strSentenceWords = strSentenceWords & strCurrentWord & strCurrentLetter
----------------Else
--------------------strSentenceWords = strSentenceWords & strCurrentLetter
----------------End If
----------------strCurrentGrammeme = ""
--------End Select
--------strSentenceGrammar = Mid(strSentenceGrammar, 2, (intLength - 1))
--------intLength = Len(strSentenceGrammar)
----Loop
----strSentenceWords = strSentenceWords & strSentenceGrammar
----WriteRandomSentence = strSentenceWords
End Function
Function ChooseWord(WordSet As recordset) As String
----Dim intTotalRecords As Long
----Dim intTotalFreqVal As Long
----Dim intIterator As Long
----Dim intRandNum As Long
----Dim strRandWord As String
----
----Randomize
----
----intIterator = 0
----WordSet.MoveLast
----intTotalRecords = WordSet.RecordCount
----WordSet.MoveFirst
----Do While intIterator *!* intTotalRecords
--------intTotalFreqVal = intTotalFreqVal + WordSet.Fields(1).Value
--------WordSet.MoveNext
--------intIterator = intIterator + 1
----Loop
----intRandNum = Int(Rnd * intTotalFreqVal) + 1
----WordSet.MoveFirst
----Do While intRandNum *!* intTotalFreqVal
--------intTotalFreqVal = intTotalFreqVal - WordSet.Fields(1).Value
--------WordSet.MoveNext
----Loop
----strRandWord = WordSet.Fields(0).Value
----ChooseWord = strRandWord
End Function
Function ReadForSentences(strEssay As String)
----Dim intLength As Long
----Dim intCurrentLetter As Integer
----
----Dim strWorkToGo As String
----Dim strWorkToDate As String
----Dim strCurrentWord As String
----Dim strCurrentLetter As String
----Dim strGrammarWord As String
----Dim strGrammarSentence As String
----
----strWorkToDate = ""
----strWorkToGo = strEssay
----intLength = Len(strEssay)
----strCurrentWord = ""
----Do While (intLength !*! 0)
--------strCurrentLetter = Mid(strWorkToGo, 1, 1)
--------intCurrentLetter = Asc(strCurrentLetter)
--------'MsgBox (strWorkToDate)
--------Select Case intCurrentLetter
------------Case 1 To 31----'Random ass crappy little characters.
----------------strGrammarSentence = ""
----------------strGrammarWord = ""
----------------strCurrentWord = ""
------------Case 32 'It's a blank space.
----------------'MsgBox ("White Space! Instructions Required! Current Word = " & Chr(34) & strCurrentWord & Chr(34))
----------------If Not (strCurrentWord = "") Then
--------------------strGrammarWord = TranslateWordToGrammar(strCurrentWord)
--------------------strGrammarSentence = strGrammarSentence & strGrammarWord & " "
--------------------'MsgBox (strCurrentWord & Chr(10) & strGrammarWord & Chr(10) & strWorkToDate & Chr(10) & strGrammarSentence)
----------------Else
--------------------strGrammarSentence = strGrammarSentence & " "
----------------End If
----------------strCurrentWord = ""
------------Case 33 'Exclamation point.
'----------------MsgBox ("Exclamation Point!")
----------------strGrammarWord = TranslateWordToGrammar(strCurrentWord)
----------------strGrammarSentence = strGrammarSentence & strGrammarWord & "!"
'------------ MsgBox (strCurrentWord & Chr(10) & strGrammarWord & Chr(10) & Chr(10) & strGrammarSentence)
----------------intVoid = AddNewSentenceStructure(strGrammarSentence)
----------------strGrammarSentence = ""
----------------strGrammarWord = ""
----------------strCurrentWord = ""
------------Case 34 'A quotation mark. Eliminate & Ignore
----------------'MsgBox ("Quotation Mark")
------------Case 35 To 38 'Bail out. #, $, %, &
'----------------MsgBox ("#, $, %, & - Think of something.")
------------Case 39 'Apostrophes. Stop it here.
----------------'MsgBox ("We hit an apostrophe...")
------------Case 40 To 42 'Parentheses. Eliminate but Ignore. No action.
'------------ MsgBox ("A parentheses or... what is Asc(41)? " & Chr(41))
------------Case 43 'A plus sign!
'----------------MsgBox ("Hit a +")
------------Case 44 'A comma.
'------------ MsgBox ("Hit a comma")
'------------ MsgBox (strCurrentWord)
----------------strGrammarWord = TranslateWordToGrammar(strCurrentWord)
----------------strGrammarSentence = strGrammarSentence & strGrammarWord & ","
'------------ MsgBox (strCurrentWord & Chr(10) & strGrammarWord & Chr(10) & Chr(10) & strGrammarSentence)
----------------strCurrentWord = ""
------------Case 45 'Hyphens.
'------------ MsgBox ("Hyphenate!")
----------------strCurrentWord = strCurrentWord & strCurrentLetter
------------Case 46 'A period.
----------------'MsgBox ("Period")
----------------strGrammarWord = TranslateWordToGrammar(strCurrentWord)
----------------strGrammarSentence = strGrammarSentence & strGrammarWord & "."
'------------ MsgBox (strCurrentWord & Chr(10) & strGrammarWord & Chr(10) & Chr(10) & strGrammarSentence)
----------------intVoid = AddNewSentenceStructure(strGrammarSentence)
----------------strGrammarSentence = ""
----------------strGrammarWord = ""
----------------strCurrentWord = ""
------------Case 47 To 57 'There are numbers or a / in this word,
----------------'MsgBox (intCurrentLetter & " - " & strCurrentLetter)
------------Case 58 'A colon
'------------ MsgBox ("Colon:")
----------------strGrammarWord = TranslateWordToGrammar(strCurrentWord)
----------------strGrammarSentence = strGrammarSentence & strGrammarWord & ":"
'------------ MsgBox (strCurrentWord & Chr(10) & strGrammarWord & Chr(10) & Chr(10) & strGrammarSentence)
----------------intVoid = AddNewSentenceStructure(strGrammarSentence)
----------------strGrammarSentence = ""
----------------strGrammarWord = ""
----------------strCurrentWord = ""
------------Case 59 'Semi-Colon
'----------------MsgBox ("Hit a semi-Colon!")
'----------------MsgBox (strCurrentWord)
----------------strGrammarWord = TranslateWordToGrammar(strCurrentWord)
----------------strGrammarSentence = strGrammarSentence & strGrammarWord & ";"
'------------ MsgBox (strCurrentWord & Chr(10) & strGrammarWord & Chr(10) & Chr(10) & strGrammarSentence)
----------------strCurrentWord = ""
------------Case 60 To 62 'There is an equal sign. or HTML brackets *!*!*!
----------------strGrammarSentence = ""
----------------strGrammarWord = ""
----------------strCurrentWord = ""
------------Case 63 'A question mark.
'------------ MsgBox ("Question Mark?")
'------------MsgBox (strCurrentWord & Chr(10) & strGrammarWord & Chr(10) & Chr(10) & strGrammarSentence)
----------------strGrammarWord = TranslateWordToGrammar(strCurrentWord)
----------------strGrammarSentence = strGrammarSentence & strGrammarWord & "?"
'------------ MsgBox (strCurrentWord & Chr(10) & strGrammarWord & Chr(10) & Chr(10) & strGrammarSentence)
----------------intVoid = AddNewSentenceStructure(strGrammarSentence)
----------------strGrammarSentence = ""
----------------strGrammarWord = ""
----------------strCurrentWord = ""
------------Case 64 'An @.
'------------ MsgBox (intCurrentLetter & " - " & strCurrentLetter)
------------Case 65 To 90 'Uppercase letters
----------------strCurrentLetter = LCase(strCurrentLetter)
----------------strCurrentWord = strCurrentWord & strCurrentLetter
------------Case 91 ' Bracket [.
----------------MsgBox (intCurrentLetter & " - " & strCurrentLetter)
------------Case 92 ' A backslash (\).
----------------MsgBox (intCurrentLetter & " - " & strCurrentLetter)
------------Case 93 ' Bracket ]
----------------MsgBox (intCurrentLetter & " - " & strCurrentLetter)
------------Case 94 To 96 'Underscores, carets, and ass-backward apostrophes
'----------------MsgBox (intCurrentLetter & " - " & strCurrentLetter)
------------Case 97 To 122 'Lowercase letters
----------------strCurrentWord = strCurrentWord & strCurrentLetter
------------Case 123----'A curly brace.
----------------MsgBox (intCurrentLetter & " - " & strCurrentLetter)
------------Case 124----'The old pipe symbol.
----------------MsgBox (intCurrentLetter & " - " & strCurrentLetter)
------------Case 125----'Curly brace.
----------------MsgBox (intCurrentLetter & " - " & strCurrentLetter)
------------Case 126 To 145 'Stupid fey little vowel-like things.
----------------MsgBox (intCurrentLetter & " - " & strCurrentLetter)
------------Case 146----'Apostrophes.
----------------'MsgBox (intCurrentLetter & " - " & strCurrentLetter)
------------Case 147 To 148 'Quotation marks.
----------------MsgBox (intCurrentLetter & " - " & strCurrentLetter)
------------Case 150----'Hyphens.
'----------------MsgBox (intCurrentLetter & " - " & strCurrentLetter)
------------Case Else 'Odd.
'----------------MsgBox ("The letter is " & strCurrLetter & Chr(10) & "The value is " & intAsciiValue)
--------End Select
--------strWorkToDate = strWorkToDate & strCurrentLetter
--------intLength = intLength - 1
--------strWorkToGo = Mid(strWorkToGo, 2, intLength)
--------
----Loop
----'MsgBox (strWorkToGo)
End Function
Function AddNewSentenceStructure(strInputSentence 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 tbl02AGrammar WHERE [strGrammar] = " & Chr(34) & strInputSentence & Chr(34))
----Set myRecordSet = myQuery.OpenRecordset
' MsgBox ("It's trying to make me add a new sentence! The sentence is below:" & Chr(10) & strInputSentence & Chr(10) & Chr(10) & "We should probably analyze it for structural integrity FIRST!")
----If InStr(1, strInputSentence, "000000000001000000") *!*!*! 0 Then
--------'Sentence HAS A TYPO!!!
'---- MsgBox ("TYPO! TYPO! TYPO!" & Chr(10) & strInputSentence)
--------Exit Function
----End If
----If InStr(1, strInputSentence, "000000000000000000") *!*!*! 0 Then
--------'Sentence HAS A NO-GO!!!
'---- MsgBox ("TYPO! TYPO! TYPO!" & Chr(10) & strInputSentence)
--------Exit Function
----End If
'----MsgBox ("We passed the smell-test! Sentence shall proceed.")
----If myRecordSet.RecordCount = 0 Then
--------Set myQuery = myDatabase.CreateQueryDef("", "INSERT INTO tbl02AGrammar (strGrammar, intFrequency) VALUES (" & Chr(34) & strInputSentence & Chr(34) & ", 1)")
--------myQuery.Execute
----Else
--------intVoid = PutToDB("tbl02AGrammar", "strGrammar", strInputSentence, "intFrequency", Str(myRecordSet.Fields(1).Value + 1))
----End If
End Function
Function TranslateWordToGrammar(strInputWord As String) As String
----Dim myDatabase As DAO.Database
----Dim myQuery As DAO.QueryDef
----Dim myRecordSet As DAO.recordset
----Dim intValidateTest As Integer
----Dim strGrammeme As String
----
----Set myDatabase = OpenDatabase("F:\Seductotron\seductotron.mdb")
----Set myQuery = myDatabase.CreateQueryDef("", "SELECT * FROM tbl01BPOS WHERE [strWord] = " & Chr(34) & strInputWord & Chr(34))
----Set myRecordSet = myQuery.OpenRecordset
----
----intValidateTest = myRecordSet.RecordCount
----If intValidateTest = 0 Then
--------strGrammeme = "000000000000000000"
----Else
--------strGrammeme = strGrammeme & myRecordSet.Fields(1).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(2).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(3).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(4).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(5).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(6).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(7).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(8).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(9).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(10).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(11).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(12).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(13).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(14).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(15).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(16).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(17).Value
--------strGrammeme = strGrammeme & myRecordSet.Fields(18).Value
----End If
----
----TranslateWordToGrammar = strGrammeme
End Function
Function TranslateGrammemeToWord(strGrammeme As String) As recordset
'At present this function merely returns a word based upon Part-Of-Speech.
'However, it should ultimately return a RECORDSET so that a separate function
'Can further refine the choices based upon topicality...
----Dim myDatabase As DAO.Database
----Dim myQuery As DAO.QueryDef
----Dim myRecordSet As DAO.recordset
----
----Dim intReturns As Long
----Dim intRandNum As Long
----
----Dim intIsNoun As Integer
----Dim intIsVerbTran As Integer
----Dim intIsVerbInTran As Integer
----Dim intIsAdj As Integer
----Dim intIsAdv As Integer
----Dim intIsConj As Integer
----Dim intIsInterj As Integer
----Dim intIsPrep As Integer
----Dim intIsPron As Integer
----Dim intIsArticle As Integer
----Dim intIsAbbreviation As Integer
----Dim intIsTypo As Integer
----Dim intIsGeo As Integer
----Dim intIsBio As Integer
----Dim intIsForm As Integer
----Dim intIsAttributive As Integer
----Dim intIsTrademark As Integer
----Dim intIsAuxiliary As Integer
----
----Dim strSQLCode As String
----Dim strResultWord As String
----
----Randomize
----Set myDatabase = OpenDatabase("F:\Seductotron\seductotron.mdb")
----strSQLCode = "SELECT * FROM tbl01AWord INNER JOIN tbl01BPOS ON tbl01AWord.strWord = tbl01BPOS.strWord WHERE "
--------
----intIsNoun = Mid(strGrammeme, 1, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsNoun] = " & intIsNoun & ") AND "
----intIsVerbTran = Mid(strGrammeme, 2, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsVerbTran] = " & intIsVerbTran & ") AND "
----intIsVerbInTran = Mid(strGrammeme, 3, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsVerbInTran] = " & intIsVerbInTran & ") AND "
----intIsAdj = Mid(strGrammeme, 4, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsAdj] = " & intIsAdj & ") AND "
----intIsAdv = Mid(strGrammeme, 5, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsAdv] = " & intIsAdv & ") AND "
----intIsConj = Mid(strGrammeme, 6, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsConj] = " & intIsConj & ") AND "
----intIsInterj = Mid(strGrammeme, 7, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsInterj] = " & intIsInterj & ") AND "
----intIsPrep = Mid(strGrammeme, 8, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsPrep] = " & intIsPrep & ") AND "
----intIsPron = Mid(strGrammeme, 9, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsPron] = " & intIsPron & ") AND "
----intIsArticle = Mid(strGrammeme, 10, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsArticle] = " & intIsArticle & ") AND "
----intIsAbbreviation = Mid(strGrammeme, 11, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsAbbreviation] = " & intIsAbbreviation & ") AND "
----intIsTypo = Mid(strGrammeme, 12, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsTypo] = " & intIsTypo & ") AND "
----intIsGeo = Mid(strGrammeme, 13, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsGeo] = " & intIsGeo & ") AND "
----intIsBio = Mid(strGrammeme, 14, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsBio] = " & intIsBio & ") AND "
----intIsForm = Mid(strGrammeme, 15, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsForm] = " & intIsForm & ") AND "
----intIsAttributive = Mid(strGrammeme, 16, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsAttributive] = " & intIsAttributive & ") AND "
----intIsTrademark = Mid(strGrammeme, 17, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsTrademark] = " & intIsTrademark & ") AND "
----intIsAuxiliary = Mid(strGrammeme, 18, 1)
----strSQLCode = strSQLCode & "([tbl01BPOS.intIsAuxiliary] = " & intIsAuxiliary & ")"
----
----Set myQuery = myDatabase.CreateQueryDef("", strSQLCode)
'----MsgBox (strSQLCode)
----
----Set myRecordSet = myQuery.OpenRecordset
----If myRecordSet.RecordCount = 0 Then
--------MsgBox ("Uh-oh! You fucked up!")
----Else
----End If
----myRecordSet.MoveFirst
----Set TranslateGrammemeToWord = myRecordSet
End Function
Function CraigslistBestOfStruct(objIE As Object, strURL As String)
Dim strCraigslistURL As String
----Dim strHTMLBuffer As String
----Dim intPostsToRead As Long
----Dim intPostLoc As Long
----Dim strPostID As String
----Dim strLastPostID As String
----Dim strPostURL As String
----Dim strLastPostRead As String
----Dim strPostContent As String
----
----strPostURL = strURL
----
----objIE.Visible = True
----objIE.navigate strPostURL
----intVoid = LoadPage(objIE)
----TimeDelay (2)
----intVoid = ReadForSentences(objIE.Document.body.innerText)
End Function
Function CraigslistBestOfVocab(objIE As Object, strURL As String)
----Dim strCraigslistURL As String
----Dim strHTMLBuffer As String
----Dim intPostsToRead As Long
----Dim intPostLoc As Long
----Dim strPostID As String
----Dim strLastPostID As String
----Dim strPostURL As String
----Dim strLastPostRead As String
----Dim strPostContent As String
----
----strPostURL = strURL
--------
----objIE.Visible = True
----objIE.navigate strPostURL
----intVoid = LoadPage(objIE)
----TimeDelay (2)
----strHTMLBuffer = objIE.Document.body.innerHTML
----strHTMLBuffer = RemoveHTML(strHTMLBuffer)
----intVoid = ReadForNewVocab(strHTMLBuffer)
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)
----'MsgBox (strSQLCode)
----Set queSeducto = objSeductoDB.CreateQueryDef("", strSQLCode)
----queSeducto.Execute
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 RemoveHTML(strInputString As String) As String
----Dim intXspot As Long
----Dim intYspot As Long
----Dim intZspot As Long
----Dim intInputLength As Long
----Dim intSnippetLength As Long
----Dim strSnippet As String
----Dim strFirstPart As String
----Dim strSecondPart As String
----
----intXspot = InStr(1, strInputString, "*!*")
----Do While Not (intXspot = 0)
--------intYspot = InStr(1, strInputString, "!*!")
--------If (intYspot *!* intXspot) Then
------------intXspot = intYspot - 2
--------End If
--------intInputLength = Len(strInputString)
--------strSnippet = Mid(strInputString, (intXspot), (intYspot - intXspot + 1))
--------intZspot = InStr(1, strInputString, strSnippet)
--------intSnippetLength = Len(strSnippet)
--------If (intZspot !*! 1) And Not ((intZspot + intSnippetLength) = intInputLength + 1) Then
------------strFirstPart = Mid(strInputString, 1, intZspot - 1)
------------strSecondPart = Mid(strInputString, (intZspot + intSnippetLength), (intInputLength - intSnippetLength))
------------strInputString = strFirstPart & strSecondPart
--------ElseIf (intZspot = 1) Then
------------strInputString = Mid(strInputString, (intSnippetLength + 1), (intInputLength - intSnippetLength))
--------ElseIf ((intZspot + intSnippetLength) = intInputLength + 1) Then
------------strInputString = Mid(strInputString, 1, (intInputLength - intSnippetLength))
--------End If
--------intXspot = InStr(1, strInputString, "*!*")
----Loop
----
----RemoveHTML = strInputString
End Function
Function ReadForNewVocab(strInputText As String)
----Dim strCurrentWord As String
----Dim intXspot As Integer
----
----intXspot = InStr(1, strInputText, " ")
----Do While (intXspot !*! 0)
--------intXspot = InStr(1, strInputText, " ")
--------If (intXspot *!*!*! 0) Then
------------strCurrentWord = Mid(strInputText, 1, intXspot - 1)
--------Else 'We are at the end of the sentence
------------strCurrentWord = strInputText
--------End If
--------strCurrentWord = ScrubWord(strCurrentWord)
--------AddNewWord strNewWord:=strCurrentWord
--------strInputText = Mid(strInputText, intXspot + 1, Len(strInputText) - intXspot)
----Loop
End Function
Function ScrubWord(strInputWord As String) As String
----Dim intLength As Integer
----Dim intIterator As Integer
----Dim strOutputWord As String
----Dim strCurrLetter As String
----Dim intAsciiValue As Integer
----
----intLength = Len(strInputWord)
----intIterator = 1
----
----Do While (intIterator *!*= intLength)
--------strCurrLetter = Mid(strInputWord, intIterator, 1)
--------intAsciiValue = Asc(strCurrLetter)
--------Select Case intAsciiValue
------------Case 1 To 31----'Random ass crappy little characters. Fuck you! Get out! I banish you from my database!
----------------ScrubWord = ""
----------------Exit Function
------------Case 32 'This should be impossible. It's a blank space.
------------Case 33 'Exclamation point. Stop it here.
----------------ScrubWord = strOutputWord
----------------Exit Function
------------Case 34 'A quotation mark. Eliminate & Ignore
------------Case 35 To 38 'Bail out. #, $, %, &
----------------ScrubWord = ""
----------------Exit Function
------------Case 39 'Apostrophes. Stop it here.
----------------ScrubWord = strOutputWord
----------------Exit Function
------------Case 40 To 42 'Parentheses. Eliminate but Ignore. No action.
------------Case 43 'A plus sign! Begone malodorous word!
----------------ScrubWord = ""
----------------Exit Function
------------Case 44 'A comma. Stop word here.
----------------ScrubWord = strOutputWord
----------------Exit Function
------------Case 45 'Hyphens. Should be retained. Unless at start of word.
----------------If Not (intIterator = 1) Then
--------------------strOutputWord = strOutputWord & strCurrLetter
----------------End If
------------Case 46 'A period. Stop it here.
----------------ScrubWord = strOutputWord
----------------Exit Function
------------Case 47 To 57 'There are numbers or a / in this word. Bail out now!
----------------ScrubWord = ""
----------------Exit Function
------------Case 58 To 59 'A colon or semi-colon. Stop it here.
----------------ScrubWord = strOutputWord
----------------Exit Function
------------Case 60 To 62 'Bail out now! There is an equal sign. or HTML brackets *!*!*!
----------------ScrubWord = ""
----------------Exit Function
------------Case 63 'A question mark. Stop it here.
----------------ScrubWord = strOutputWord
----------------Exit Function
------------Case 64 'An @. I'm gonna' say bail on such a word.
----------------ScrubWord = ""
----------------Exit Function
------------Case 65 To 90 'Uppercase letters
----------------strOutputWord = strOutputWord & strCurrLetter
------------Case 91 ' Bracket [. Eliminate & Ignore.
------------Case 92 ' A backslash (\). BEGONE HEATHEN!
----------------ScrubWord = ""
----------------Exit Function
------------Case 93 ' Bracket ]. Ignore. No action.
------------Case 94 To 96 'Underscores, carets, and ass-backward apostrophes. No way.
----------------ScrubWord = ""
----------------Exit Function
------------Case 97 To 122 'Lowercase letters
----------------strOutputWord = strOutputWord & strCurrLetter
------------Case 123----'A curly brace. Eliminate & ignore.
------------Case 124----'The old pipe symbol. As in "type autoexec.bat|more." Just say no to nostalgia.
----------------ScrubWord = ""
----------------Exit Function
------------Case 125----'Curly brace. Eliminate & ignore.
------------Case 126 To 145 'Stupid fey little vowel-like things.
----------------ScrubWord = ""
----------------Exit Function
------------Case 146----'Apostrophes. Change apostrophe into SQL compatible character.
----------------strOutputWord = strOutputWord & "!"
------------Case 147 To 148 'Quotation marks. Ignore. No action.
------------Case 150----'Hyphens. Should be retained.
----------------If Not (intIterator = 1) Then
--------------------strOutputWord = strOutputWord & strCurrLetter
----------------End If
------------Case Else 'Abort Word
----------------'MsgBox ("The letter is " & strCurrLetter & Chr(10) & "The value is " & intAsciiValue)
----------------ScrubWord = ""
----------------Exit Function
--------End Select
--------intIterator = intIterator + 1
----Loop
----ScrubWord = strOutputWord
End Function
Function AddNewWord(strNewWord As String)
----Dim myDatabase As DAO.Database
----Dim myQuery As DAO.QueryDef
----Dim myRecordSet As DAO.recordset
----
----strNewWord = LCase(strNewWord)
----strNewWord = ScrubWord(strNewWord)
----Set myDatabase = OpenDatabase("F:\Seductotron\seductotron.mdb")
----Set myQuery = myDatabase.CreateQueryDef("", "SELECT * FROM tbl01AWord WHERE [strWord] = " & Chr(34) & strNewWord & Chr(34))
----Set myRecordSet = myQuery.OpenRecordset
----
----If myRecordSet.RecordCount = 0 Then
--------Set myQuery = myDatabase.CreateQueryDef("", "INSERT INTO tbl01AWord (strWord, intHasPOS) VALUES (" & Chr(34) & strNewWord & Chr(34) & ", 0)")
--------myQuery.Execute
----Else
--------intVoid = PutToDB("tbl01AWord", "strWord", strNewWord, "intFrequency", Str(myRecordSet.Fields(2).Value + 1))
----End If
End Function
Function LearnPOS(objBrowse As Object)
----Dim boolHasForm As Boolean
----
----Dim intZspot As Long
----Dim intInflections As Long
----Dim intIterator As Long
----Dim intXspot As Long
----Dim intYspot As Long
----Dim intLastSyllable As Long
----
----Dim strWord As String
----Dim strURL As String
----Dim strDefinition As String
----Dim strDefText As String
----Dim strRootWord As String
----Dim strFormWord As String
----Dim strWordList As String
----Dim boolIsWord As Boolean
----Dim strFunction As String
----Dim strFuncWord As String
----Dim strUsage As String
----Dim strInflection As String
----Dim strWordStem As String
----Dim arrInflections() As String
----Dim strAlternate As String
----Dim strAlternateFunction As String
----Dim boolCanGo As Boolean
----
----strWord = GetUnknownPOS
----If strWord = "ABORT!!!" Then
--------boolCanGo = False
----Else
--------boolCanGo = True
----End If
----intInflections = 0
----boolHasForm = False
----strURL = "http://www.m-w.com/cgi-bin/dictionary?book=Dictionary&va=" & strWord
----objBrowse.navigate strURL
----If (LoadPage(objBrowse) = False) Then Exit Function
----TimeDelay intTimeDelay:=1
----strDefinition = LCase(objBrowse.Document.body.innerHTML)
----intVoid = PutToDB("tbl01AWord", "strWord", strWord, "intHasPOS", "1")
----'Now we begin parsing the definition.
----'Is it a word?
----If (InStr(1, strDefinition, "!-- begin content") = 0) Then
----'If it is not, then please classify it as a typo!
--------boolIsWord = False
--------'MsgBox ("You have entered a word that is not in this dictionary!")
--------AddNewPOS strNewWord:=strWord
--------strFunction = "typo"
--------intVoid = TranslatePOS(strWord, strFunction)
--------Exit Function
----Else: boolIsWord = True
----'We shall proceed!
--------intXspot = InStr(1, strDefinition, "!-- begin content") + 21
--------intYspot = InStr(1, strDefinition, "!-- end content")
--------If (intXspot = 0) Or (intYspot = 0) Then
------------MsgBox ("We got a problem. intXspot or intYspot = 0 but it thinks it's got a definition!")
------------Exit Function
--------End If
----End If
----
----strDefinition = Mid(strDefinition, intXspot, intYspot - intXspot)
----strRootWord = objBrowse.Document.entry.hdwd.Value
----strFormWord = objBrowse.Document.entry.listword.Value
----
----If (strRootWord *!*!*! strFormWord) Then
----'This is a case where one word is a form of another.
' MsgBox ("We're dealing with a form! The real word is " & Chr(34) & strRootWord & Chr(34) & " NOT " & Chr(34) & strFormWord & Chr(34))
--------AddNewWord strNewWord:=strRootWord
--------AddNewPOS strNewWord:=strFormWord
--------intVoid = TranslatePOS(strFormWord, "form")
--------strWord = strRootWord
--------boolHasForm = True
----End If
----AddNewPOS strNewWord:=strWord
----If (InStr(1, strDefinition, "*!*br!*!-") *!*!*! 0) Then
----'This is a case where there are alternate forms with alternate POS at bottom of page
' MsgBox ("Let us begin with the alternates!")
--------intXspot = InStr(1, strDefinition, "*!*br!*!-")
--------Do While (intXspot *!*!*! 0)
------------intXspot = InStr(intXspot, strDefinition, "*!*b!*!") + 3
------------intYspot = InStr(intXspot, strDefinition, "*!*/b!*!")
------------strAlternate = Mid(strDefinition, intXspot, (intYspot - intXspot))
------------Do While (InStr(1, strAlternate, Chr(183)) *!*!*! 0)
----------------intLastSyllable = InStr(1, strAlternate, Chr(183))
----------------strAlternate = Mid(strAlternate, 1, (intLastSyllable - 1)) & Mid(strAlternate, (intLastSyllable + 1), (Len(strAlternate) - intLastSyllable))
------------Loop
------------If (InStr(intXspot, strDefinition, "*!*b!*!:") = 0) Then
----------------intXspot = InStr(intXspot, strDefinition, "*!*i!*!") + 3
----------------intYspot = InStr(intXspot, strDefinition, "*!*/i!*!")
----------------strAlternateFunction = Mid(strDefinition, intXspot, (intYspot - intXspot))
----------------If (InStr(1, strAlternate, "*!*") = 0) And (InStr(1, strAlternateFunction, "*!*") = 0) Then
'------------ MsgBox ("Alternate word form!" & Chr(10) & strAlternate & " - " & strAlternateFunction)
--------------------AddNewWord strNewWord:=strAlternate
--------------------AddNewPOS strNewWord:=strAlternate
--------------------intVoid = TranslatePOS(strAlternate, strAlternateFunction)
----------------Else
--------------------intXspot = Len(strDefinition)
----------------End If
----------------If (strAlternate = strFormWord) Then
----------------'This means that the wordform DOES NOT share a POS with its root!
--------------------boolHasForm = False
----------------End If
------------End If
------------intXspot = InStr(intXspot, strDefinition, "*!*br!*!-")
--------Loop
----End If
----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.")
--------------------intLastSyllable = InStr(1, strDefinition, Chr(183))
--------------------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
----If (InStr(1, strDefinition, "function:") *!*!*! 0) Then 'It's got a function!
--------intXspot = InStr(1, strDefinition, "function:")
--------intXspot = InStr(intXspot, strDefinition, "*!*i!*!") + 3
--------intYspot = InStr(intXspot, strDefinition, "*!*/i!*!")
--------strFunction = Mid(strDefinition, intXspot, intYspot - intXspot)
--------intVoid = TranslatePOS(strWord, strFunction)
--------If (boolHasForm = True) Then
------------intVoid = TranslatePOS(strFormWord, strFunction)
--------End If
--------If intInflections !*! 0 Then
------------intIterator = 0
------------Do While (intIterator *!* intInflections)
----------------intVoid = TranslatePOS(arrInflections(intIterator), strFunction)
----------------intIterator = intIterator + 1
------------Loop
--------End If
----Else 'It doesn't!
' MsgBox ("No function to this word!")
----End If
----If (InStr(1, strDefinition, "usage:") *!*!*! 0) Then 'It's got a function!
--------intXspot = InStr(1, strDefinition, "usage:")
--------intXspot = InStr(intXspot, strDefinition, "*!*i!*!") + 3
--------intYspot = InStr(intXspot, strDefinition, "*!*/i!*!")
--------strFunction = Mid(strDefinition, intXspot, intYspot - intXspot)
--------intVoid = TranslatePOS(strWord, strFunction)
--------If (boolHasForm = True) Then
------------intVoid = TranslatePOS(strFormWord, strFunction)
--------End If
--------If intInflections !*! 0 Then
------------intIterator = 0
------------Do While (intIterator *!* intInflections)
----------------intVoid = TranslatePOS(arrInflections(intIterator), strFunction)
----------------intIterator = intIterator + 1
------------Loop
--------End If
----Else 'It doesn't!
----End If
----If (InStr(1, strDefinition, "*!*option!*!") *!*!*! 0) Then 'We got multi-functions!
--------strWordList = objBrowse.Document.entry.List.Value
' MsgBox (strWordList)
--------intXspot = 1
--------Do While (intXspot *!*!*! 0)
------------intXspot = InStr(1, strWordList, ";")
------------If intXspot *!*!*! 0 Then
----------------strFunction = Mid(strWordList, 1, intXspot - 1)
------------End If
------------If InStr(1, strFunction, "]") *!*!*! 0 Then
----------------strFunction = Mid(strFunction, InStr(1, strFunction, ",") + 1, (InStr(1, strFunction, "]") - InStr(1, strFunction, ",") - 1))
'-------- MsgBox (strFunction)
----------------strFuncWord = Mid(strWordList, 1, InStr(1, strWordList, "[") - 1)
----------------If strFuncWord *!*!*! strWord Then
--------------------If strFuncWord *!*!*! strFormWord Then
'---------------- MsgBox ("It's trying to pull a fast one on me - " & strFuncWord)
------------------------intVoid = AddNewWord(strFuncWord)
--------------------Else
------------------------intVoid = TranslatePOS(strFormWord, strFunction)
--------------------End If
--------------------
----------------Else
--------------------intVoid = TranslatePOS(strWord, strFunction)
----------------End If
------------End If
------------strWordList = Mid(strWordList, intXspot + 1, (Len(strWordList) - intXspot))
--------Loop
----End If
----LearnPOS = boolCanGo
End Function
Function AddNewPOS(strNewWord As String)
----Dim myDatabase As DAO.Database
----Dim myQuery As DAO.QueryDef
----Dim myRecordSet As DAO.recordset
----
----strNewWord = LCase(strNewWord)
----
----Set myDatabase = OpenDatabase("F:\Seductotron\seductotron.mdb")
----Set myQuery = myDatabase.CreateQueryDef("", "SELECT * FROM tbl01BPOS WHERE [strWord] = " & Chr(34) & strNewWord & Chr(34))
----Set myRecordSet = myQuery.OpenRecordset
----
----If myRecordSet.RecordCount = 0 Then
--------Set myQuery = myDatabase.CreateQueryDef("", "INSERT INTO tbl01BPOS (strWord) VALUES (" & Chr(34) & strNewWord & Chr(34) & ")")
--------myQuery.Execute
----End If
End Function
Function TranslatePOS(strWord As String, strFunction As String) As String
----
----If (InStr(1, strFunction, "superlative of") *!*!*! 0) Then
--------intCutOff = InStr(1, strFunction, "superlative of") + 13
--------strFunction = Mid(strFunction, 1, intCutOff)
----End If
----If (InStr(1, strFunction, "comparative of") *!*!*! 0) Then
--------intCutOff = InStr(1, strFunction, "comparative of") + 13
--------strFunction = Mid(strFunction, 1, intCutOff)
----End If
----Select Case strFunction
--------Case "noun"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsNoun", strPutVal:="1"
--------Case "transitive verb"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsVerbTran", strPutVal:="1"
--------Case "intransitive verb"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsVerbInTran", strPutVal:="1"
--------Case "verb"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsVerbInTran", strPutVal:="1"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsVerbTran", strPutVal:="1"
--------Case "definite article"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsArticle", strPutVal:="1"
--------Case "indefinite article"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsArticle", strPutVal:="1"
--------Case "adverb"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAdv", strPutVal:="1"
--------Case "preposition"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsPrep", strPutVal:="1"
--------Case "conjunction"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsConj", strPutVal:="1"
--------Case "pronoun"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsPron", strPutVal:="1"
--------Case "interjection"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsInterj", strPutVal:="1"
--------Case "typo"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsTypo", strPutVal:="1"
--------Case "geographical name"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsGeo", strPutVal:="1"
--------Case "biographical name"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsBio", strPutVal:="1"
--------Case "adjective"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAdj", strPutVal:="1"
--------Case "form"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsForm", strPutVal:="1"
--------Case "often attributive"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAttributive", strPutVal:="1"
--------Case "often capitalized"
------------'There's nothing to be done about this one.
--------Case "slang"
------------'There's nothing to be done here either.
--------Case "abbreviation"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAbbreviation", strPutVal:="1"
--------Case "service mark"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsTrademark", strPutVal:="1"
--------Case "trademark"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsTrademark", strPutVal:="1"
--------Case "verbal auxiliary"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAuxiliary", strPutVal:="1"
--------Case "adjective or noun"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAdj", strPutVal:="1"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsNoun", strPutVal:="1"
--------Case "pronoun, plural in construction"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsPron", strPutVal:="1"
--------Case "pronoun,plural in construction"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsPron", strPutVal:="1"
--------Case "pronoun,singular or plural in construction"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsPron", strPutVal:="1"
--------Case "pronoun, singular or plural in construction"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsPron", strPutVal:="1"
--------Case "pronoun,sometimes plural in construction"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsPron", strPutVal:="1"
--------Case "noun,plural in construction"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsNoun", strPutVal:="1"
--------Case "adjective or adverb"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAdj", strPutVal:="1"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAdv", strPutVal:="1"
--------Case "adverb or adjective"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAdv", strPutVal:="1"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAdj", strPutVal:="1"
--------Case "adjective,superlative of"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAdj", strPutVal:="1"
--------Case "adverb,superlative of"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAdv", strPutVal:="1"
--------Case "adjective,comparative of"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAdj", strPutVal:="1"
--------Case "adverb,comparative of"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsAdv", strPutVal:="1"
--------Case "noun, plural in construction"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsNoun", strPutVal:="1"
--------Case "noun plural but singular or plural in construction"
------------PutToDB strTable:="tbl01BPOS", strCritField:="strWord", strCritVal:=strWord, strPutField:="intIsNoun", strPutVal:="1"
--------Case Else
------------If InStr(1, strFunction, "[") = 0 Then
'----------------MsgBox ("I'm looking at an unkown value here - " & strFunction)
------------End If
----End Select
----TranslatePOS = strReturnVal
End Function
Function GetUnknownPOS() 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 [intHasPOS] = 0")
----Set myRecordSet = myQuery.OpenRecordset
----If myRecordSet.RecordCount = 0 Then
--------GetUnknownPOS = "ABORT!!!"
----Else
--------GetUnknownPOS = myRecordSet.Fields(0).Value
----End If
End Function
Function GetFromDB(strTable As String, strCritField As String, strCritVal As String, strReturnField As String) As String
----Dim myDatabase As DAO.Database
----Dim myQuery As DAO.QueryDef
----Dim myRecordSet As DAO.recordset
----Dim strReturnVal As String
----
----Set myDatabase = OpenDatabase("F:\Seductotron\seductotron.mdb")
----Set myQuery = myDatabase.CreateQueryDef("", "SELECT " & strReturnField & " FROM " & strTable & " WHERE [" & strCritField & "] = " & Chr(34) & strCritVal & Chr(34) & ")")
----Set myRecordSet = myQuery.OpenRecordset
----
----If myRecordSet.RecordCount = 0 Then
--------MsgBox ("Uh-oh! We got a fuckup! Press Ctrl+Brk!")
----Else
--------strReturnVal = myRecordSet.Fields(0).Value
----End If
----GetFromDB = strReturnVal
End Function
Function GetRandomSentenceStruct() As String
----Dim myDatabase As DAO.Database
----Dim myQuery As DAO.QueryDef
----Dim myRecordSet As DAO.recordset
----Dim strReturnVal As String
----Dim intTotalFreqVal As Long
----Dim intTotalRecords As Long
----Dim intIterator As Long
----Dim intRandNum As Long
----Dim intMaxNum As Long
----
----Set myDatabase = OpenDatabase("F:\Seductotron\seductotron.mdb")
----Set myQuery = myDatabase.CreateQueryDef("", "SELECT * FROM tbl02AGrammar")
----Set myRecordSet = myQuery.OpenRecordset
----intIterator = 0
----Randomize
----
----If myRecordSet.RecordCount = 0 Then
--------MsgBox ("Uh-oh! We got a fuckup! Press Ctrl+Brk!")
----Else
--------myRecordSet.MoveLast
--------intTotalRecords = myRecordSet.RecordCount
--------myRecordSet.MoveFirst
--------Do While intIterator *!* intTotalRecords
------------intTotalFreqVal = intTotalFreqVal + myRecordSet.Fields(1).Value
------------myRecordSet.MoveNext
------------intIterator = intIterator + 1
--------Loop
--------intRandNum = Int(Rnd * intTotalFreqVal) + 1
--------myRecordSet.MoveFirst
--------Do While intRandNum *!* intTotalFreqVal
------------intTotalFreqVal = intTotalFreqVal - myRecordSet.Fields(1).Value
------------myRecordSet.MoveNext
--------Loop
----End If
----strReturnVal = myRecordSet.Fields(0).Value
----GetRandomSentenceStruct = strReturnVal
End Function
0 Comments:
Post a Comment
<< Home