classopenmind.cls

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

  Dim phrase As String
  Dim ObjectName As String
  Dim action 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, action)
        If (ObjectName <> "") Then
          Call RemovePrefix(ObjectName)
          If (ObjectName <> action) Then
            Call ConnectObjectToAction(ObjectName, action, 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 ReadThoughtTreasure(filename As String, ObjectType As String, DefaultConnectionType As String)
'reads a thought treasure file

  Dim fileNumber As Integer
  Dim c As String
  Dim phrase As String
  Dim nested As Integer
  Dim nest(100) As String
  Dim ConnectionType As String
  Dim initialChars As Boolean
  
  nested = 0
  initialChars = True
  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
    
      'interpret the gobbledegook!
      phrase = InterpretThoughtTreasureLine(phrase)
    
      'read the phrase
      If (phrase <> "") And (nested > 0) Then
      
        'decide what type of connection to use
        ConnectionType = DefaultConnectionType
        
        If (Left$(phrase, 8) = "part of ") Then
          phrase = Right$(phrase, Len(phrase) - 8)
        End If
      
        If (Left$(phrase, 5) = "attr ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
      
        If (Left$(phrase, 5) = "aasn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 5) = "rusn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 6) = "bafgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "bamgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "aamgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "aafgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "usfgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "usmgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 5) = "frsn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 6) = "frmgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "frfgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 5) = "ausn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 6) = "aumgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "aufgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 5) = "chsn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 5) = "dusn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 5) = "gesn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 5) = "husn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 5) = "insn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 5) = "irsn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 5) = "irsn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 5) = "itsn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 5) = "jasn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 5) = "scsn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 5) = "spsn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 5) = "wesn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 5) = "otsn ") Then
          phrase = Right$(phrase, Len(phrase) - 5)
        End If
        
        If (Left$(phrase, 6) = "dumgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "dufgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "gemgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "gefgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
      
        If (Left$(phrase, 6) = "humgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "hufgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "grmgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "grfgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
      
        If (Left$(phrase, 6) = "inmgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "infgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "itmgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "itfgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
      
        If (Left$(phrase, 6) = "jamgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "jafgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
      
        If (Left$(phrase, 6) = "lamgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "lafgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
      
        If (Left$(phrase, 6) = "pomgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "pofgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
      
        If (Left$(phrase, 6) = "rumgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "rufgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "scmgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "scfgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "spmgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "spfgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
      
        If (Left$(phrase, 6) = "wemgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "wefgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "otmgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "otfgn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "otugn ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "usdog ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "frdog ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 6) = "frcat ") Then
          phrase = Right$(phrase, Len(phrase) - 6)
        End If
        
        If (Left$(phrase, 9) = "usanimal ") Then
          phrase = Right$(phrase, Len(phrase) - 9)
        End If
        
        If (Left$(phrase, 9) = "franimal ") Then
          phrase = Right$(phrase, Len(phrase) - 9)
        End If
      
        nest(nested) = phrase
        If (nested > 1) Then
        
          If (nest(nested - 1) <> "") And (nest(nested - 1) <> "invalid") And (nest(nested) <> nest(nested - 1)) Then
            'MsgBox nest(nested) & " is a type of " & nest(nested - 1)
            
            Select Case ObjectType
              Case "object"
                Call ConnectObjects(nest(nested), nest(nested - 1), ConnectionType, "")
              Case "action"
                Call ConnectActions(nest(nested), nest(nested - 1), ConnectionType, "")
            End Select
          End If
        End If
      End If
    
      phrase = ""
      nested = 0
      initialChars = True
      Else
      
      If (c = "=") And (initialChars) Then
        nested = nested + 1
        Else
        initialChars = False
        phrase = phrase & c
      End If
    End If
  Wend
  Close #fileNumber
  
End Sub


Public Function InterpretThoughtTreasureLine(phrase As String) As String
'makes some sense of a Thought Treasure line (it's pretty cryptic)
  Dim i As Integer
  Dim returnStr As String
  Dim c As String
  Dim prev_c As String
  Dim finished As Boolean
  Dim waitForSpace As Boolean
  
  prev_c = ""
  finished = False
  waitForSpace = False
  returnStr = ""
  
  If (Left$(phrase, 1) <> "-") Then
    
    If (Left$(phrase, 1) <> ";") Then
  
      i = 1
      While (i <= Len(phrase)) And (Not finished)
        c = Mid$(phrase, i, 1)
        If (c = "#") Then
          waitForSpace = True
        End If
        If (c = " ") And (waitForSpace) Then
          waitForSpace = False
        End If
      
        If (c <> ".") And (c <> "/") Then
          If (Not waitForSpace) Then
            If ((Asc(c) > 64) And (Asc(c) < 91)) Or ((Asc(c) > 96) And (Asc(c) < 123)) Then
              c = c
              Else
              c = " "
            End If
            If (Not ((c = " ") And (prev_c) = " ")) Then
              returnStr = returnStr & c
            End If
            prev_c = c
          End If
          Else
          finished = True
        End If
      
        i = i + 1
      Wend
      
      returnStr = Trim(returnStr)
      
      If (i > 1) Then
        If (Right$(returnStr, 2) = " A") Then
          returnStr = Left$(returnStr, Len(returnStr) - 2)
        End If
      End If
      
    End If
    Else
    returnStr = "invalid"
  End If
  
  InterpretThoughtTreasureLine = returnStr
End Function



Public Sub ReadTwoObjects(filename As String, dividingWords As String, ConnectionType As String)
'reads two related objects
'<first object> <dividing words> <second object>

  Dim fileNumber As Integer
  Dim c As String
  Dim phrase As String
  Dim firstObject As String
  Dim secondObject 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, firstObject, secondObject)
        If (firstObject <> "") Then
          Call RemovePrefix(firstObject)
          Call RemovePrefix(secondObject)
          Call ConnectObjects(firstObject, secondObject, ConnectionType, "")
        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 ReadFoundTogether(filename As String)
'reads two related objects
'<first object> <dividing words> <second object>

  Dim fileNumber As Integer
  Dim c As String
  Dim phrase As String
  Dim pos As Integer
  Dim i As Integer
  Dim j As Integer
  Dim readObject As Boolean
  Dim ObjectStr As String
  Dim NoOfObjects As Integer
  Dim obj(100) As String