classopenmind.cls

这个代码却能真正教会电脑进行像人那样思考

  sqlStr = sqlStr & "(((InStr([Name]," & Chr(34) & Trim(LCase(searchStr)) & Chr(34) & "))>0)) "
  sqlStr = sqlStr & "ORDER BY tblObjects.Name"
  
  lst.Clear
  Call OpenDatabase
  Set rs = db.OpenRecordset(sqlStr, dbOpenSnapshot)
  If (rs.RecordCount > 0) Then
    rs.MoveFirst
    For i = 1 To rs.RecordCount
      lst.AddItem (rs("Name"))
      rs.MoveNext
    Next
  End If
  rs.Close
End Sub



Private Function CountWords(phrase As String) As Integer
'returns the number of words in the phrase
  Dim i As Integer
  Dim c As String
  Dim prev As String
  Dim count As Integer
  
  If (phrase <> "") Then
    count = 1
    i = 0
    prev = ""
    For i = 1 To Len(phrase)
      c = Mid$(phrase, i, 1)
      If (prev = " ") And (c <> " ") And (c <> "#") Then
        count = count + 1
      End If
      prev = c
    Next
    Else
    count = 0
  End If
  
  CountWords = count
End Function



Public Function addObject(ObjectName As String) As Long
  On Error GoTo addObject_err
  
  Dim rs As Recordset
  Dim WordCount As Integer
  
  addObject = 0
  
  If (ObjectName <> "") Then
    Set rs = db.OpenRecordset("tblObjects")
    rs.AddNew
    rs("Name") = Left$(ObjectName, 255)
    WordCount = CountWords(ObjectName)
    If (WordCount < 4) Then
      rs("objectType") = "object"
      Else
      rs("objectType") = "statement"
    End If
    rs("Words") = WordCount
    addObject = rs("ID")
    rs.Update
  End If
  
addObject_exit:
  Exit Function
addObject_err:
  If (Err = 3022) Then 'duplicate
    rs.Close
    Resume addObject_exit
  End If
  
  If (Err = 3001) Then 'invalid argument
    rs.Close
    Resume addObject_exit
  End If
  
  MsgBox "classOpenMind/addObject/" & Err & "/" & Error$(Err)
  Resume addObject_exit
End Function



Public Function addAction(ActionName As String) As Long
  On Error GoTo addAction_err
  
  Dim rs As Recordset
  Dim WordCount As Integer
  
  addAction = 0
  
  If (ActionName <> "") Then
    Set rs = db.OpenRecordset("tblObjects")
    rs.AddNew
    rs("Name") = Left$(ActionName, 255)
    WordCount = CountWords(ActionName)
    rs("objectType") = "action"
    rs("Words") = WordCount
    addAction = rs("ID")
    rs.Update
  End If
  
addAction_exit:
  Exit Function
addAction_err:
  If (Err = 3022) Then 'duplicate
    Resume addAction_exit
  End If
  
  MsgBox "classOpenMind/addAction/" & Err & "/" & Error$(Err)
  Resume addAction_exit
End Function


Public Function addStatement(Statement As String) As Long
  On Error GoTo addStatement_err
  
  Dim rs As Recordset
  Dim WordCount As Integer
  
  addStatement = 0
  
  If (Statement <> "") Then
    Set rs = db.OpenRecordset("tblObjects")
    rs.AddNew
    rs("Name") = Left$(Statement, 255)
    WordCount = CountWords(Statement)
    rs("objectType") = "statement"
    rs("Words") = WordCount
    addStatement = rs("ID")
    rs.Update
  End If
  
addStatement_exit:
  Exit Function
addStatement_err:
  If (Err = 3022) Then 'duplicate
    Resume addStatement_exit
  End If
  
  MsgBox "classOpenMind/addStatement/" & Err & "/" & Error$(Err)
  Resume addStatement_exit
End Function



Public Function addQuestion(Question As String) As Long
  On Error GoTo addQuestion_err
  
  Dim rs As Recordset
  Dim WordCount As Integer
  
  addQuestion = 0
  
  If (Question <> "") Then
    Set rs = db.OpenRecordset("tblObjects")
    rs.AddNew
    rs("Name") = Left$(Question, 255)
    WordCount = CountWords(Question)
    rs("objectType") = "question"
    rs("Words") = WordCount
    addQuestion = rs("ID")
    rs.Update
  End If
  
addQuestion_exit:
  Exit Function
addQuestion_err:
  If (Err = 3022) Then 'duplicate
    Resume addQuestion_exit
  End If
  
  MsgBox "classOpenMind/addQuestion/" & Err & "/" & Error$(Err)
  Resume addQuestion_exit
End Function



Public Sub ConnectObjects(FromObjectName As String, ToObjectName As String, ConnectionType As String, Relationship As String)
'connects two objects together with some relationship
  On Error GoTo ConnectObjects_err
  
  Dim rs As Recordset
  Dim fromID As Long
  Dim ToID As Long
  
  Set rs = db.OpenRecordset("SELECT * FROM tblObjects WHERE [Name]=" & Chr(34) & FromObjectName & Chr(34))
  If (rs.RecordCount = 0) Then
    rs.Close
    fromID = addObject(FromObjectName)
    Else
    fromID = rs("ID")
    rs.Close
  End If
  
  Set rs = db.OpenRecordset("SELECT * FROM tblObjects WHERE [Name]=" & Chr(34) & ToObjectName & Chr(34))
  If (rs.RecordCount = 0) Then
    rs.Close
    ToID = addObject(ToObjectName)
    Else
    ToID = rs("ID")
    rs.Close
  End If
  
  Set rs = db.OpenRecordset("tblConnections")
  rs.AddNew
  rs("FromObjectID") = fromID
  rs("ToObjectID") = ToID
  rs("ConnectionType") = ConnectionType
  rs("Relationship") = Relationship
  rs.Update
  rs.Close
  
ConnectObjects_exit:
  Exit Sub
ConnectObjects_err:
  If (Err = 3022) Then 'duplicate detected
    rs.Close
    Resume ConnectObjects_exit
  End If
  
  If (Err = 3001) Then 'invalid argument
    rs.Close
    Resume ConnectObjects_exit
  End If

  MsgBox "classOpenMind/ConnectObjects/" & Err & "/" & Error$(Err)
  Resume ConnectObjects_exit
End Sub



Public Sub ConnectObjectToAction(ObjectName As String, ActionName As String, ConnectionType As String, Relationship As String)
'connects an object to an action
  On Error GoTo connectObjectToAction_err
  
  Dim rs As Recordset
  Dim fromID As Long
  Dim ToID As Long
  
  Set rs = db.OpenRecordset("SELECT * FROM tblObjects WHERE [Name]=" & Chr(34) & ObjectName & Chr(34))
  If (rs.RecordCount = 0) Then
    rs.Close
    fromID = addObject(ObjectName)
    Else
    fromID = rs("ID")
    rs.Close
  End If
  
  Set rs = db.OpenRecordset("SELECT * FROM tblObjects WHERE [Name]=" & Chr(34) & ActionName & Chr(34))
  If (rs.RecordCount = 0) Then
    rs.Close
    ToID = addAction(ActionName)
    Else
    ToID = rs("ID")
    rs.Close
  End If
  
  Set rs = db.OpenRecordset("tblConnections")
  rs.AddNew
  rs("FromObjectID") = fromID
  rs("ToObjectID") = ToID
  rs("ConnectionType") = ConnectionType
  rs("Relationship") = Relationship
  rs.Update
  rs.Close
  
connectObjectToAction_exit:
  Exit Sub
connectObjectToAction_err:
  If (Err = 3022) Then 'duplicate detected
    Resume connectObjectToAction_exit
  End If

  MsgBox "classOpenMind/connectObjectToAction/" & Err & "/" & Error$(Err)
  Resume connectObjectToAction_exit
End Sub



Public Sub ConnectActions(firstAction As String, secondAction As String, ConnectionType As String, Relationship As String)
'connects two actions together
  On Error GoTo connectActions_err
  
  Dim rs As Recordset
  Dim fromID As Long
  Dim ToID As Long
  
  Set rs = db.OpenRecordset("SELECT * FROM tblObjects WHERE [Name]=" & Chr(34) & firstAction & Chr(34))
  If (rs.RecordCount = 0) Then
    rs.Close
    fromID = addAction(firstAction)
    Else
    fromID = rs("ID")
    rs.Close
  End If
  
  Set rs = db.OpenRecordset("SELECT * FROM tblObjects WHERE [Name]=" & Chr(34) & secondAction & Chr(34))
  If (rs.RecordCount = 0) Then
    rs.Close
    ToID = addAction(secondAction)
    Else
    ToID = rs("ID")
    rs.Close
  End If
  
  Set rs = db.OpenRecordset("tblConnections")
  rs.AddNew
  rs("FromObjectID") = fromID
  rs("ToObjectID") = ToID
  rs("ConnectionType") = ConnectionType
  rs("Relationship") = Relationship
  rs.Update
  rs.Close
  
connectActions_exit:
  Exit Sub
connectActions_err:
  If (Err = 3022) Then 'duplicate detected
    Resume connectActions_exit
  End If

  MsgBox "classOpenMind/connectActions/" & Err & "/" & Error$(Err)
  Resume connectActions_exit
End Sub



Public Sub ConnectStatements(firstStatement As String, secondStatement As String, ConnectionType As String, Relationship As String)
'connects two actions together
  On Error GoTo connectStatements_err
  
  Dim rs As Recordset
  Dim fromID As Long
  Dim ToID As Long
  
  Set rs = db.OpenRecordset("SELECT * FROM tblObjects WHERE [Name]=" & Chr(34) & firstStatement & Chr(34))
  If (rs.RecordCount = 0) Then
    rs.Close
    fromID = addStatement(firstStatement)
    Else
    fromID = rs("ID")
    rs.Close
  End If
  
  Set rs = db.OpenRecordset("SELECT * FROM tblObjects WHERE [Name]=" & Chr(34) & secondStatement & Chr(34))
  If (rs.RecordCount = 0) Then
    rs.Close
    ToID = addStatement(secondStatement)
    Else
    ToID = rs("ID")
    rs.Close
  End If
  
  Set rs = db.OpenRecordset("tblConnections")
  rs.AddNew
  rs("FromObjectID") = fromID
  rs("ToObjectID") = ToID
  rs("ConnectionType") = ConnectionType
  rs("Relationship") = Relationship
  rs.Update
  rs.Close
  
connectStatements_exit:
  Exit Sub
connectStatements_err:
  If (Err = 3022) Then 'duplicate detected
    Resume connectStatements_exit
  End If

  MsgBox "classOpenMind/connectStatements/" & Err & "/" & Error$(Err)
  Resume connectStatements_exit
End Sub





Public Sub SplitPhrase(phrase As String, dividingWord As String, ByRef firstpart As String, ByRef secondpart As String)
'splits the given phrase up into two parts
  Dim pos As Integer
  
  pos = InStr(phrase, dividingWord)
  If (pos > 0) Then
    firstpart = Trim(Left$(phrase, pos - 1))
    secondpart = Trim(Right$(phrase, Len(phrase) - pos - Len(dividingWord) + 1))
    Else
    firstpart = ""
    secondpart = phrase
  End If
End Sub


Private Sub RemovePrefix(ByRef phrase As String)
'removes common prefixes from an object name
  Dim txt As String
  Dim firstpart As String
  Dim secondpart As String
  
  txt = phrase
  
  Call SplitPhrase(txt, "a ", firstpart, secondpart)
  txt = secondpart
  
  Call SplitPhrase(txt, "an ", firstpart, secondpart)
  txt = secondpart
  
  Call SplitPhrase(txt, "some ", firstpart, secondpart)
  txt = secondpart
  
  Call SplitPhrase(txt, "the ", firstpart, secondpart)
  txt = secondpart
  
  phrase = txt
End Sub



Public Sub ReadObjectProperties(filename As String, dividingWords As String, ConnectionType As String)
'reads from the differences file

  Dim fileNumber As Integer
  Dim c As String
  Dim phrase As String
  Dim ObjectName As String
  Dim purpose As String
  
  Call OpenDatabase
  fileNumber = FreeFile
  Open filename For Input As fileNumber
  While (Not EOF(fileNumber))
    c = Input(1, #fileNumber)
    If (Asc(c) = 10) Or (Asc(c) = 13) Then
    
      'read the phrase
      If (phrase <> "") Then
        Call SplitPhrase(phrase, dividingWords, ObjectName, purpose)
        If (ObjectName <> "") Then
          Call RemovePrefix(ObjectName)
          If (ObjectName <> purpose) Then
            Call ConnectObjects(ObjectName, purpose, ConnectionType, "")
          End If
        End If
      End If
    
      phrase = ""
      Else
      If (c <> "(") And (c <> ")") And (c <> "'") And (c <> Chr(34)) Then
        phrase = phrase & c
      End If
    End If
  Wend
  Close #fileNumber
  
End Sub




Public Sub ReadObjectAction(filename As String, dividingWords As String, ConnectionType As String)
'reads a sentance of the form:
'<object> <dividing words> <action>

  Dim fileNumber As Integer
  Dim c As String