reply.bas

非常著名的人工智能程序bob,想学人工智能的可以参考下.

Attribute VB_Name = "Reply"
Option Explicit
'///////////////////////////////////////////////////////
' Last Answer information
Public LastReply As String
Public LastResponse As Response
Public LastKeyword As Keyword

'Current Answer Information
Public CurrentReply As String
Public CurrentResponse As Response
Public CurrentKeyword As Keyword

Public Type SimpleResponse
    sReply  As String
    sAction As String
    sQuestion As Boolean
End Type

Public Function GetResponseForPreset(sFilepath As String, sFileReference As String) As String
    Dim sKey As Keyword
    sKey.KeywordFile = sFilepath
    sKey.KeywordNo = sFileReference
    GetResponseForPreset = GetRandomReply(sKey).ResponseText
End Function

Public Function GetKeywordReply(sSentence As String) As SimpleResponse
    Dim sResponse As Response
    Dim sKeyword As Keyword
    Dim Cont As Boolean
    
    Cont = True
    If ExtraSearch <> "" Then
        sKeyword = KeywordSearchFile(sSentence, App.Path & "\data\" & Trim(ExtraSearch))
        If sKeyword.KeywordNo <> "" Then
            Cont = False
        End If

        ExtraSearch = ""

    End If
    
    If Cont = True Then
        sKeyword = KeywordSearch(sSentence & " ")
        If sKeyword.KeywordText = LastKeyword.KeywordText Then
            sKeyword = KeywordSearchExclude(sSentence)
        End If
    End If
    
    
    If sKeyword.KeywordText <> "" Then
        sResponse = GetRandomReply(sKeyword)
    Else
        sKeyword.KeywordFile = "Preset4.txt"
        sKeyword.KeywordNo = "0001"
        sResponse = GetRandomReply(sKeyword)
    End If
    
    'Remove Not Not error
    sSentence = Replace(LCase(sSentence), " not not ", " ")
    
    
    GetKeywordReply.sReply = sResponse.ResponseText
    GetKeywordReply.sAction = sResponse.ResponseAction
    GetKeywordReply.sQuestion = sResponse.Question
    

    
    LastKeyword = sKeyword
    LastResponse = sResponse
End Function


Public Function KeywordSearchExclude(sSentence As String) As Keyword
'Searches keyword file and checks each entry against the sentence
On Error GoTo KeywordError
Dim Path As String
Dim InputBuffer As String
Dim KeywordFound As Boolean
Dim CurrentFile As String
Dim Temp As String
Dim Continue As Boolean
Dim Fn As Byte
Dim CurrentNumber As String
Dim Searchword As String

    Path = App.Path & "\data\" & KeywordFile
    Fn = FreeFile
    KeywordSearchExclude.KeywordOrigin = sSentence
    
    Open Path For Input As #Fn
        Do Until EOF(Fn) = True Or KeywordFound = True
            Continue = True
            Line Input #Fn, InputBuffer
            If InputBuffer = "" Then
                'Blank Line
                Continue = False
            Else
                If Chr(Asc(InputBuffer)) = "/" Then
                    'Comment Line
                    Continue = False
                    '///////////////////////////////////////////
                    'Debug.Print "Comment Line -->" & InputBuffer
                    '///////////////////////////////////////////
                Else
            
                    If Chr(Asc(InputBuffer)) = "[" Then
                        Continue = False
                        Temp = Left(InputBuffer, Len(InputBuffer) - 1)
                        Temp = Right(Temp, Len(Temp) - 1)
                        CurrentFile = Temp
                        '///////////////////////////////////////////
                        'Debug.Print "Current File -->" & Temp
                        '///////////////////////////////////////////
                    End If
                End If
            End If
            If Continue = True Then
                CurrentNumber = Left(InputBuffer, 4)
                Searchword = LCase(Right(InputBuffer, Len(InputBuffer) - 5))
                
                If InStr(1, LCase(sSentence), Searchword) <> 0 Then
                    If Searchword = Reply.LastKeyword.KeywordText Then
                        'Ignore keyword
                    Else
                    '///////////////////////////////////////////
                    'Debug.Print "Keyword Found - " & Searchword
                    '///////////////////////////////////////////
                    KeywordSearchExclude.KeywordText = Searchword
                    KeywordSearchExclude.KeywordNo = CurrentNumber
                    KeywordSearchExclude.KeywordFile = CurrentFile
                    KeywordFound = True
                    End If
                End If
            End If
        Loop
    Close #Fn
        
Exit Function
KeywordError:
    Dim A As LogEntry
    A.sName = "File Access Problem"
    A.sGenerated = "KeywordSearchExclude Function"
    A.sDescription = "Error Number " & Err.Number & "( " & Err.Description & ")" & "(" & Err.Source & ")"
    AddtoErrorLog A
    MsgBox "There has been an internal Error, Please Contact System Administrator"
    ContinueToAnswer = False
End Function