Visual Basic code listings from the WTalk.mdb database

These are listings from the code modules of the Access 2003 version of the database.

Form_ToksEditor.cls

During runtime, WTalk.cpp allows the user to task-switch to the ToksEditor form to correct its parsing of the user's previous sentence. As the form closes, this routine updates database tables to reflect what it has learned from the user.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_ToksEditor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database   'Use database order for string comparisons

Private Sub Form_Close()

'9/9/01
'Makes use of info (possibly user-revised) in TOKS table to update other db tables.
'this fn needs a lot of thought and work.

'----------------------
'THIS unbound CONTROL ON THE FORM allows user to abandon all changes made
If [UpdateOnClose] = False Then Exit Sub

DoCmd.SetWarnings False

'----------------------
'THIS TRIES TO EXTRACT ALL INFO THAT CAN BE INFERRED FROM THE DATA IN TOKS.
'USER HAS GONE TO A LOT OF TROUBLE TO EDIT; TRY TO GET EVERYTHING YOU CAN.

Dim mydb As Database, TK As Recordset, DF As Recordset
Dim LASTP As Integer    'PREVIOUS PHRASE TYPE
Dim PHR As String       'MULTI-WORD TEXT (THE PHRASE)
Dim ABC As String       'LIST OF THE WORD TYPES OF THE CONSECUTIVE WORDS IN PHR
Dim ALPID As Long
Dim TOKEN As String
Dim SQLquery As String
Dim INFODEF As Long, BLANKDEF As Long, FINALDEF As Long
Dim ITYPE As Integer

Set mydb = DBEngine.Workspaces(0).Databases(0)
Set TK = mydb.OpenRecordset("TOKS", DB_OPEN_TABLE)
LASTP = -1                                          'starts with ILLEGAL VALUE
Do Until TK.EOF
    '----------------------
    'PROCESS THE INDIVIDUAL WORD (TOKEN).
    'BECAUSE WE KNOW WHICH WORDTYPE IS CORRECT FOR THIS WORD AS USED HERE, UPDATE USECOUNT
    'AND LASTUSED FOR THE *DEF* THAT ALSO HAS THE INFOTYPE THAT OURS HAS.
    'ALLOWS YOU, IN .CPP, TO ASSIGN A WORD ITS MOST COMMON TYPE and def FIRST.
    '(remember that .CPP ALREADY HANDLES UPDATING OF USECOUNT AND LASTUSED IN THE PHRASES TABLE)

    'FOR THESE INFO AND PHRASETYPES, THE TOKEN HAS NOTHING USEFUL TO ADD TO MDB ANYWAY.
    If (TK!InfoType <> 0) And (TK!InfoType <> 6) And (TK!InfoType <> 8) And (TK!PhraseType <> 8) Then
        'FIND ALL THE WORD'S DEFS AS THIS TYPE, ALL INFOTYPES COMINGLED.
        SQLquery = "SELECT DISTINCTROW Defs.* FROM Defs WHERE ((Defs.AlphaID=" & TK!ALPHAID & ") AND (Defs.Type=" & TK!Type & "));"
        Set DF = mydb.OpenRecordset(SQLquery)
        INFODEF = 0: BLANKDEF = 0: FINALDEF = 0
        
        'TRAVERSE ALL RECORDS TO SEE WHAT YOU FIND
        Do Until DF.EOF
            If (DF!InfoType = TK!InfoType) Then
                INFODEF = DF!DefID
                Exit Do             'ONCE WE GET ONE OF THESE, NO MORE ARE NEEDED
            End If
            If (BLANKDEF = 0) And (DF!InfoType = 0) Then
                BLANKDEF = DF!DefID
            End If
            DF.MoveNext
        Loop
        DF.Close
        'in order OF PREFERENCE:
        'IF WE FOUND AN EXISTING DEF WITH THE DESIRED INFOTYPE, UPDATE IT, ELSE IF THERE WAS
        'A DEF WITH A BLANK INFOTYPE, GIVE IT THE NEW INFOTYPE, ELSE CREATE AN ENTIRELY NEW DEF.
        'ALSO OVERWRITING THE INFOTYPE FIELD to FILL IT IN IF IT WAS BLANK.
        '#error doing this for all words is creating lots of defs for common little words
        'that don't really have any infotype ("a", "the").  may be ok, though.

        If INFODEF <> 0 Then FINALDEF = INFODEF Else If BLANKDEF <> 0 Then FINALDEF = BLANKDEF
        If FINALDEF <> 0 Then
            DoCmd.RunSQL "UPDATE DISTINCTROW Defs SET Defs.UseCount = [Defs].[UseCount]+1, Defs.LastUsed = Now(), Defs.InfoType = " & TK!InfoType & " WHERE ((Defs.DEFID=" & FINALDEF & "));"
        Else
            DoCmd.RunSQL "INSERT INTO Defs([AlphaID],[Type],[SEQ],[INFOTYPE],[PHRASETYPE]) VALUES(" & TK!ALPHAID & "," & TK!Type & ",""" & Chr$(TK!Type + 64) & """," & TK!InfoType & "," & TK!PhraseType & ");"
        End If
    End If

    '----------------------
    'IF THIS TOK STARTS A NEW PHRASE, POST AND TABULATE THE PHRASE JUST ENDED, IF APPROPRIATE
    If TK!PhraseType <> LASTP Then
        'IF THE JUST-BUILT PHRASE IS LEGAL, UPDATE VARIOUS TABLES WITH IT.
        If LASTP > 0 And Len(PHR) > 0 Then
            '----------------------
            'ADD THE WORD-TYPE SEQUENCE TO THE LIBRARY OF KNOWN-LEGAL PHRASES.
            'in case THE SEQ IS ALREADY IN THE TABLE, UPDATE its UseCount and LastUsed
            DoCmd.RunSQL "UPDATE DISTINCTROW LegalPhrases SET LegalPhrases.UseCount = [LegalPhrases].[UseCount]+1, LegalPhrases.LastUsed = Now() WHERE ((LegalPhrases.Seq=""" & ABC & """));"
            'in case it's not in table, unconditionally add it, except
            'you must exclude strings of prep phrases because they look like ONE big PREPPHR.
            If (LASTP <> 5) Or (InStr(ABC, "AF") = 0) Then
                DoCmd.RunSQL "insert into LEGALPHRASES (PHRASETYPE, SEQ) VALUES (" & LASTP & ",""" & ABC & """);"
            End If

            '----------------------
            'IF THE PHRASE DOESN'T ALREADY HAVE A DEFS ENTRY FOR THE GIVEN TYPE, GIVE IT ONE.
            'FOR DEFS, YOU MUST ENTER A *WORDTYPE*, BUT WHAT WE HAVE IS A PHRASETYPE.
            'FOR 1,2,3,4 THE WORDTYPES AND PHRASETYPES HAVE THE SAME NUMERIC VALUES *AND*
            'ARE INTERCHANGEABLE:  E.G. YOU CAN USE A NOUNPHRASE *AS* A STANDALONE NOUN.
            'THUS, ONLY FOR THESE, YOU CAN ENTER THE PHRASETYPE *AS* THE WORDTYPE.
            'DON'T TRY TO HANDLE PREPPHR.  THE NUMERIC TYPES AREN'T THE SAME (5 vs. 6)

            If LASTP >= 1 And LASTP <= 4 Then
                'BECAUSE THIS ENTIRE PHRASE HAS BEEN MARKED AS A SPECIFIC TYPE, IT CAN PROBABLY
                'BE A MULTI-WORD SINGLE TOKEN IN THE FUTURE. ADD IT TO PHRASES AND GET ALPHAID.
                ALPID = LookupAlphaID(PHR)
                
                'IF PHRASE ALREADY HAS A DEF, UPDATE IT, ELSE CREATE A NEW ONE.
                'THIS IS AN ALTERNATIVE TO THE UPDATE QUERY METHOD USED ABOVE FOR LEGALPHRASES.
                SQLquery = "SELECT DISTINCTROW Defs.* FROM Defs WHERE ((Defs.AlphaID=" & ALPID & ") AND (Defs.Type=" & LASTP & "));"
                Set DF = mydb.OpenRecordset(SQLquery)
                
                'for infotype, this uses that of the last word in the phrase,
                'and then overrides it with 0 if it's a useless one.
                If ITYPE = 6 Or ITYPE = 8 Then ITYPE = 0
                
                FINALDEF = 0                                'USED AS SUCCESS FLAG
                Do Until DF.EOF
                    FINALDEF = DF!DefID
                    DF.Edit
                    DF!USECOUNT = DF!USECOUNT + 1
                    DF!LASTUSED = Now
                    'OVERWRITES ANY PREVIOUS, so subject can become object, etc, and
                    'you can look up most recent long-phrase subject, for example, to
                    'see who or what is the current subject of discussion?
                    If ITYPE <> 0 Then DF!InfoType = ITYPE
                    DF!seq = ABC        'FIX OLD MDB ENTRIES THAT HAVE BLANK SEQS
                    DF.Update
                    DF.MoveNext
                Loop
                DF.Close
                If FINALDEF = 0 Then DoCmd.RunSQL "INSERT INTO Defs([AlphaID],[Type],[PhraseType],[InfoType],[Seq]) VALUES(" & ALPID & "," & LASTP & "," & LASTP & "," & ITYPE & ",""" & ABC & """);"
            End If
        End If
        
        'EVEN IF LAST PHRASE WASN'T LEGAL, REINITIALIZE TO START A NEW ONE
        ABC = "": PHR = ""

    End If

    '----------------------
    'EVERY PASS THRU LOOP...
    LASTP = TK!PhraseType
    ITYPE = TK!InfoType
    ABC = ABC + Chr$(TK!Type + 64)
    TOKEN = DLookup("[Phrases]![Alpha]", "Phrases", "[Phrases]![AlphaID] = " & TK!ALPHAID)
    If Len(PHR) > 0 And Len(TOKEN) > 0 Then PHR = PHR + " "
    PHR = PHR + TOKEN
    TK.MoveNext

Loop
TK.Close

DoCmd.SetWarnings True

End Sub

ListsAndTrees.bas

One of the functions of the database is to accumulate knowledge about the world. A large amount of knowledge can be encoded in the simple fact that most things are subsets of other things and that therefore most attributes of a superset can be cascaded (applied) to all things that are subsets of it:

A lion is a large cat native to Africa. Cats are felines. Felines are mammals. Mammals are animals. Each of these supersets can store all the general attributes that characterize it. Each subset only needs to store those attributes that distinguish it from the larger class (superset) because it can inherit all the rest from its chain of supersets. Thus in this case, "lion" only needs to store that it is large and native to Africa, along with whatever other unique attributes apply.

The database is structured to facilitate the encoding of knowledge in this hierarchical manner, which, not by accident!, is the same way that a dictionary stores it. The only additions that a dictionary would need to conform to this model is hyperlinks at every location where a superset is mentioned. In some of this program's documentation, this database is referred to as its hierarchical world knowledge (HWK) database.

There is very little of this type of world knowledge currently encoded in the database, but at least the structure and some of the methods now exist, and have proven themselves workable and promising.

The routines in this module start with a single definition of a word, and build lists of its synonyms and supersets for use by the Wtalk.cpp program. These routines are prototypes, and the program currently does not make use of them.

Attribute VB_Name = "ListsAndTrees"
Option Compare Database   'Use database order for string comparisons

Function BuildSupersetListForDefID(DefID As Long) As Long

'USES THE PERMANENT TABLE DEFSYNS TO BUILD A LIST OF ENTIRE SUPERSET CHAIN FOR DEFID.
'EACH SEARCH SEARCHES FOR IMMEDIATE SYNONYMS OF EVERY EXISTING ENTRY IN THE TABLE,
'THEN SEARCHES FOR IMMEDIATE SUPERSETS, AND ADDS ANY NEW ONES TO THE TABLE.
'This cannot be a macro because of the Do loop.
'Returns the number of ITEMS in the table it built.
'RESULT table contains the original entry, even though it is not a superset of itself.
'2/16/01

DoCmd.SetWarnings False

'delete all existing entries in the table and post the provided one as the first
DoCmd.RunSQL "DELETE * FROM DefSyns;"
DoCmd.RunSQL "INSERT INTO DefSyns([DefID]) VALUES (" & DefID & ");"

'SEARCH FOR SUPERSETS AND THEIR SYNONYMS UNTIL A PASS GENERATES NO NEW ENTRIES
Dim SupersetCount As Long, L As Long
Do
    SupersetCount = DCount("*", "DefSyns")
    
    'FIRST ADD TO THE LIST ALL SYNONYMS OF THE EXISTING ENTRIES
    L = BuildSynListForDefID(-1)
    
    'NOW SEARCH FOR AND ADD ALL SUPERSETS OF ALL ENTRIES
    DoCmd.OpenQuery "ImmediateSupersetsForward"
    DoCmd.OpenQuery "ImmediateSupersetsBackward"

Loop Until DCount("*", "DefSyns") = SupersetCount
BuildSupersetListForDefID = SupersetCount

'VIEW RESULT FOR DEBUGGING
'DoCmd OpenQuery "Synonyms"

End Function

Function BuildSynListForDefID(defidno As Long) As Long

'If you have already put 1 or more DefIDs into DefSyns table, pass -1 as defidno
'to prevent emptying the table.

'THE PERMANENT TABLE DEFSYNS IS WHERE WE STORE ALL SYNONYMOUS DEFID FOR A SINGLE SEARCH
'RESULT. EACH SEARCH SEARCHES FOR IMMEDIATE SYNONYMS OF EVERY EXISTING ENTRY IN THE TABLE,
'AND ADDS ANY NEW ONES TO THE TABLE.
'This cannot be a macro because of the Do loop.
'Returns the number of synonyms in the table it built.
'2/16/01

DoCmd.SetWarnings False

If defidno <> -1 Then
    'delete all existing entries in the table and post the provided one as the first
    DoCmd.RunSQL "DELETE * FROM DefSyns;"
    DoCmd.RunSQL "INSERT INTO DefSyns([DefID]) VALUES (" & defidno & ");"
End If

'SEARCH FOR SYNONYMS UNTIL A PASS GENERATES NO NEW ENTRIES
Dim SynCount As Long
Do
    SynCount = DCount("*", "DefSyns")
    'SYNONYMS CAN BE LINKED IN EITHER OR BOTH DIRECTIONS.  MUST CHECK BOTH.
    DoCmd.OpenQuery "ImmediateSynonymsForward"
    DoCmd.OpenQuery "ImmediateSynonymsBackward"
Loop Until DCount("*", "DefSyns") = SynCount
BuildSynListForDefID = SynCount

'VIEW RESULT FOR DEBUGGING
'DoCmd OpenQuery "Synonyms"

End Function

Function BuildSynListForString(phrase As String) As Long

'2/16/01
'VERSION FOR A GIVEN STRING.  RESULT IS VALID ONLY IF GIVEN phrase HAS ONLY 1 DEFID
'(OFTEN THE CASE).  IN OTHER CASES RESULT MAY BE HUMOROUS, also desirable.
'SEE DEFID VERSION FOR NOTES.
'7/27/06 It doesn't look like this version was ever used.

DoCmd.SetWarnings False

'delete all existing entries in the table
DoCmd.RunSQL "DELETE * FROM DefSyns;"

'BEGIN THE SEARCH LIST WITH *ALL* DEFINITIONS OF THE GIVEN PHRASE
DoCmd.RunSQL "INSERT INTO DefSyns ( DefID ) SELECT DISTINCTROW Defs.DefID FROM Phrases LEFT JOIN Defs ON Phrases.AlphaID = Defs.AlphaID WHERE (Phrases.Alpha=" & Chr$(34) & phrase & Chr$(34) & ");"

'SEARCH FOR SYNONYMS UNTIL A PASS GENERATES NO NEW ENTRIES
Dim SynCount As Long
Do
    SynCount = DCount("*", "DefSyns")
    'SYNONYMS CAN BE LINKED IN EITHER OR BOTH DIRECTIONS.  MUST CHECK BOTH.
    DoCmd.OpenQuery "ImmediateSynonymsForward"
    DoCmd.OpenQuery "ImmediateSynonymsBackward"
Loop Until DCount("*", "DefSyns") = SynCount
BuildSynListForString = SynCount

'VIEW RESULT FOR DEBUGGING
'DoCmd OpenQuery "Synonyms"

End Function

SentenceConstruction.bas

One of the features added to this program for amusement was the ability to generate random sentences using known-good grammatical constructions. That's what these routines do.

Attribute VB_Name = "SentenceConstruction"
Option Compare Database   'Use database order for string comparisons

Function CreateRandomSentence() As String

'9/16/01
'returns a randomly generated grammatically correct (at least in theory!)
'sentence of randomly chosen words and phrases. But the result is usually poor.

Dim subjseq As String, verbseq As String, objseq As String, sentence As String
Dim w As String, i As Integer
Randomize

subjseq = GetRandomWordtypeSeq(1)
verbseq = GetRandomWordtypeSeq(2)
objseq = GetRandomWordtypeSeq(1)

For i = 1 To Len(subjseq)
    w = GetRandomWord(Asc(Mid(subjseq, i, 1)) - 64)
    If Len(sentence) > 0 And w <> "," Then sentence = sentence + " "
    sentence = sentence + w
Next i
For i = 1 To Len(verbseq)
    w = GetRandomWord(Asc(Mid(verbseq, i, 1)) - 64)
    If Len(sentence) > 0 And w <> "," Then sentence = sentence + " "
    sentence = sentence + w
Next i
For i = 1 To Len(objseq)
    w = GetRandomWord(Asc(Mid(objseq, i, 1)) - 64)
    If Len(sentence) > 0 And w <> "," Then sentence = sentence + " "
    sentence = sentence + w
Next i

sentence = sentence + "."

'This option to continue if the terminator wasn't a terminating one
'creates random output that is much too long, just nonsense.
'w = GetRandomWord(11)
'sentence = sentence + w
'If w = ":" Or w = ";" Then sentence = sentence + " " + CreateRandomSentence()

CreateRandomSentence = sentence

End Function

Function GetRandomWord(wordtype As Integer) As String

'8/27/01
'returns a randomly chosen word of the requested type

If wordtype = 10 Then
    GetRandomWord = ","
    Exit Function
End If
Randomize

'this occasionally IS returned, probably due to wordtype = 12 (currently there are none)
GetRandomWord = "*NOWORD*"

Dim mydb As Database, RS As Recordset, SQLquery As String
Dim rscount As Long

Set mydb = DBEngine.Workspaces(0).Databases(0)

'minor mods can weight entries differently
SQLquery = "SELECT DISTINCT Phrases.Alpha FROM Phrases INNER JOIN Defs ON Phrases.AlphaID = Defs.AlphaID WHERE ((Defs.Type=" & wordtype & "));"
Set RS = mydb.OpenRecordset(SQLquery)
If Not RS.EOF Then
    RS.MoveLast
    rscount = RS.RecordCount
    
    RS.MoveFirst
    RS.Move Int(Rnd * rscount)      'truncates
    GetRandomWord = RS!Alpha
End If
RS.Close
End Function

Function GetRandomWordtypeSeq(ptype As Integer) As String

'8/27/01
'returns a randomly chosen wordtype Sequence of the requested phrase type

Dim mydb As Database, RS As Recordset, SQLquery As String
Dim rscount As Long

GetRandomWordtypeSeq = ""
Randomize

Set mydb = DBEngine.Workspaces(0).Databases(0)

'minor mods can weight entries differently
SQLquery = "SELECT DISTINCTROW LegalPhrases.Seq FROM LegalPhrases WHERE ((LegalPhrases.PhraseType=" & ptype & "));"
Set RS = mydb.OpenRecordset(SQLquery)
If Not RS.EOF Then
    RS.MoveLast
    rscount = RS.RecordCount
    
    RS.MoveFirst
    RS.Move Int(Rnd * rscount)          'truncates
    GetRandomWordtypeSeq = RS!seq
End If
RS.Close

End Function

Function PostRandomSentence() As String

'9/16/01
'posts a random sentence to the DDETransfers table

Dim A As String, b As Integer

A = CreateRandomSentence()
b = PostVar("RandomSentence", A)
PostRandomSentence = A

End Function

MyUtils.bas

Assorted utility routines, some of them called remotely by Wtalk.cpp using Dynamic Data Exchange (DDE).

Attribute VB_Name = "MyUtils"
Option Compare Database   'Use database order for string comparisons

Function GetVar(VarName As String) As Variant

'8/2/01
'looks up and returns the value of the named variable from the ddetransfers table,
'which serves as a central location where fns, subs, and apps can share the data.

GetVar = DLookup("[DDETRANSFERS]![VALUE]", "DDETRANSFERS", "[DDETRANSFERS]![VARNAME] = '" & VarName & "'")

End Function

Function LookupAlphaID(s As String) As Long

'7/24/01
'UTILITY FN RECEIVES TEXT, ADDS IT IF NECESSARY, RETURNS ITS ALPHAID.
'FOR USE BY OTHER FNS, SUBS, AND FORMS.
'COULD MODIFY TO ALWAYS CREATE RESULT, SO REMOTE USER CAN RETRIEVE IT.

'QUOTE AND VERTICAL BAR (" AND |) PRODUCE ERRORS
If InStr(1, s, Chr$(34)) <> 0 Or InStr(1, s, "|") <> 0 Then
    LookupAlphaID = 0
    Exit Function
End If

'TRY TO ADD (S) TO THE PHRASES TABLE.  NO HARM DONE IF IT FAILS.
'THIS AND OTHER SQL COMMANDS SHOULD HAVE NO PROBLEM WITH APOSTROPHES
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO Phrases([Alpha]) VALUES (""" & s & """);"
'DoCmd SetWarnings True

'get the phrase ID of S, special handling if it contains an embedded apostrophe
If InStr(1, s, "'") = 0 Then
    LookupAlphaID = DLookup("[Phrases]![AlphaID]", "Phrases", "[Phrases]![Alpha] = '" & s & "'")
Else
    DoCmd.SetWarnings False
    DoCmd.RunSQL "SELECT DISTINCTROW Phrases.AlphaID INTO result FROM Phrases WHERE (Phrases.Alpha=""" & s & """);"
    'DoCmd SetWarnings True
    LookupAlphaID = DLookup("[RESULT]![AlphaID]", "RESULT")
End If

End Function

Function PostVar(VarName As String, Value As Variant) As Integer

'8/28/01
'posts the provided value of the named variable to the ddetransfers table,
'which serves as a central location where fns, subs, and apps can share the data.

DoCmd.RunSQL "DELETE DISTINCTROW DDETransfers.VarName FROM DDETransfers WHERE ((DDETransfers.VarName=""" & VarName & """));"
DoCmd.RunSQL "INSERT INTO DDETransfers( [Varname], [value] ) VALUES (""" & VarName & """,""" & Value & """);"
PostVar = True
End Function

Function RunTransferSQL() As Integer

'8/2/01
'RETRIEVES AND RUNS THE SQLTEXT ITEM IN THE DDETRANSFER TABLE.
'to use, first POST THE DESIRED COMMAND TO THE TABLE, THEN USE THIS TO RUN IT.
'THIS METHOD ALSO ALLOWS SQL COMMANDS LONGER THAN 255 CHARS.
'must be a fn because it is called by a macro, which can only call a fn.

A$ = GetVar("SQLTEXT")
DoCmd.RunSQL A$

RunTransferSQL = True

End Function

Sub SetTestControl(s As String)

'7-23-01
'EXPERIMENTS AT setting the value of a control.
'it works, but I can't find a way to run it from outside Access!
'(or ANY way to set the value of the control)
'TRIED from Winword:
'direct command (forms![]= etc)
'SetValue forms![] etc.
'RunCode settestcontrol(),
'didn't try GoToControl() then SendKeys (too risky)

'i think the brackets are only required if embedded spaces
Forms![Form1]![Test] = s
Exit Sub

'this method DOES work: when you open the form, the correct value appears.
'sets a field in the underlying table upon which the form is based.

Exit Sub

'DO NOT RUN: THIS TABLE DOESN'T EXIST NOW.
'DoCmd RunSQL "DELETE * FROM Transferdata;"
'DoCmd RunSQL "INSERT INTO TRANSFERDATA([DATA]) VALUES (""" & s & """);"

'except this line needs work: must close the form if open, then re-open
'but what a time-waster!

'forms![Form2]![Data].Requery

End Sub

Sub Test()

'7/27/06 Looks like this is expendable and can be used to test anything.

DoCmd.RunSQL "INSERT INTO Phrases([Alpha]) VALUES (""voodoo"");"

End Sub

Sub TestSQLInsertInto()

'7/30/01
'Within MSAccess (Basic and macro) is the only place that multi-field
'INSERT INTO works properly.

A$ = Chr$(34) & "437" & Chr$(34)
b$ = Chr$(34) & "12" & Chr$(34)
C = 437
d = 12

'for numbers, doesn't seem to care whether quoted or not

DoCmd.RunSQL "INSERT INTO Defs ([AlphaID],[Type]) VALUES (" & A$ & "," & b$ & ");"
'DoCmd RunSQL "INSERT INTO Defs ([AlphaID],[Type]) VALUES (""437"",""12"");"

End Sub

Function TypeIsLegal(T As Integer) As Integer

'7/20/01
'WHETHER THE GIVEN TYPE IS LEGAL FOR A WORD TO HAVE
'it must be in the table, and have Legal = TRUE

i = DCount("[WORDTYPES]![TYPE]", "WORDTYPES", "[WORDTYPES]![type] = " & T & " and [WORDTYPES]![legal] = true")
TypeIsLegal = (i <> 0)

End Function

CPIQuestionManagement.bas

The program has a special set of stock questions that can be asked of the user, with facilities for retaining the user's yes or no answers to them. None of the questions have been created (they all just say "This is stock question #nnn."). This function selects a question that has not yet been asked, and marks it to be next. WTalk.cpp could easily retrieve the stored answers to these questions in order to tailor its interaction with the user, but those routines have not yet been created.

Attribute VB_Name = "CPIQuestionManagement"
Option Compare Database   'Use database order for string comparisons

Function MarkRandomCPIQuestion() As Integer

'8/8/01
'Marks 1 as-yet-unasked cpiquestion, selected at random, for retrieval by WTalk via query.
'This fn is called by the macro of the same name.
'#error endless loop will result in unlikely event that all questions get asked

Randomize
Dim r As Integer

DoCmd.RunSQL "UPDATE DISTINCTROW CPIQuestions SET CPIQuestions.Marked = No;"

'loop until you hit a question not already answered
'(the legal values in Answer are T, F, or U (unknown/unasked))
Do
    r = Rnd * 480 + 1
Loop Until DLookup("[Answer]", "CPIQuestions", "[No] = " & r) = "U"

'mark the question for retrieval
DoCmd.RunSQL "UPDATE DISTINCTROW CPIQuestions SET CPIQuestions.Marked = Yes WHERE ((CPIQuestions.[No]=" & r & "));"

MarkRandomCPIQuestion = r

End Function

ExternalFileManagement.bas

This is legacy code from a one-time import into the database from a prior version.

Attribute VB_Name = "ExternalFileManagement"
Option Compare Database   'Use database order for string comparisons

Sub ImportAllDICFiles()

'7/24/01
'READS THE A-Z.DIC FILES AND IMPORTS ALPHA AND TYPES DATA INTO THE PHRASES AND DEFS TABLES
'Procedure takes about 3 minutes.
'7/24/06 This is legacy code from a one-time import into the database from a prior version.

Dim L As Integer, C As Integer, ID As Long, b As Integer, nullvals As Long
Dim F As String, A As String

nullvals = 0
For L = Asc("A") To Asc("Z")
    F = Chr$(L) + ".DIC"
    Open F For Input As #1
    While Not EOF(1)
        Line Input #1, A
        Open "D:\TEMP\T.TXT" For Output As #2
        Print #2, A
        Close #2
        Open "D:\TEMP\T.TXT" For Input As #2
        Input #2, A
        'ID WILL FAIL IF A CONTAINS " OR | (problematic chars)
        ID = LookupAlphaID(A)
        If ID = Null Then
            nullvals = nullvals + 1
        Else
            While Not EOF(2)
                Input #2, b
                If (TypeIsLegal(b)) Then
                    DoCmd.SetWarnings False
                    DoCmd.RunSQL "INSERT INTO Defs([AlphaID],[Type]) VALUES(" & ID & "," & b & ");"
                    DoCmd.SetWarnings True
                End If
            Wend
        End If
        Close #2
    Wend
    Close #1
Next L
DoCmd.SetWarnings True
MsgBox "There were " + Str$(nullvals) + " lookup failures."

End Sub

Test.bas

This module is for holding assorted functions and subs during testing.

Attribute VB_Name = "Test"
Option Compare Database   'Use database order for string comparisons

Function RandomInteger(topval As Integer) As Integer

Randomize
RandomInteger = Int(Rnd * topval)

End Function

Function VLstring() As String
'9/19/01
'creates an over-long string for dde testing

A$ = String$(100, "A")
A$ = A$ + String$(100, "B")
A$ = A$ + String$(100, "C")
A$ = A$ + String$(100, "D")

'a$ = Chr$(34) + a$ + Chr$(34)  'didn't help

VLstring = A$

End Function

Web this Site News

Copyright ©2008 Steven Whitney. Last modified 10/07/2008.