frmvalidkeyword.frm

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

Public sQuestions As Long
Public Rfound As Long
Public RefFound As Long

Private Sub cmdStart_Click()
    Dim Path As String
    Dim Fn As Byte
    Dim InputBuffer As String
    Dim Continue As Boolean
    Dim CurrentFile As String
    Dim Temp As String
    Dim CurrentNumber As String
    Dim Searchword As String
    Dim Key As Keyword
    TxtReport.Text = ""
    LineCounter = 0
    sComments = 0
    sBlanks = 0
    sWorkingWords = 0
    sErrors = 0
    sProcessed = 0
    sMissingFiles = 0
    sMissingReferences = 0
    sStatements = 0
    sQuestions = 0
    Path = App.Path & "\data\keywords.txt"
    Fn = FreeFile
    
    Open Path For Input As #Fn
        Do Until EOF(Fn)
            Line Input #Fn, InputBuffer
            Continue = True
            LineCounter = LineCounter + 1
                If InputBuffer = "" Then
                    'Blank Line
                    sBlanks = sBlanks + 1
                    LblBlank.Caption = sBlanks
                    Continue = False
                Else
                    If Chr(Asc(InputBuffer)) = "/" Then
                        'Comment Line
                        sComments = sComments + 1
                        LblComments.Caption = sComments
                        Continue = False
                    Else
                        If Chr(Asc(InputBuffer)) = "[" Then
                            Continue = False
                            Temp = Left(InputBuffer, Len(InputBuffer) - 1)
                            Temp = Right(Temp, Len(Temp) - 1)
                            CurrentFile = Temp
                            RefFound = RefFound + 1
                            If Dir(App.Path & "\data\" & CurrentFile) = "" Then
                                sMissingFiles = sMissingFiles + 1
                                sErrors = sErrors + 1
                                lblmissing = sMissingFiles
                                
                                TxtReport = TxtReport & Chr(13) & Chr(10) & "Line " & LineCounter & " - Response file not found (" & CurrentFile & ")"
                                TxtReport.SelStart = Len(TxtReport)
                            End If
                        End If
                        
                    End If
                End If
                
                If Continue = True Then
                    sWorkingWords = sWorkingWords + 1
                    lblKeywords.Caption = sWorkingWords
                    CurrentNumber = Left(InputBuffer, 4)
                    Searchword = LCase(Right(InputBuffer, Len(InputBuffer) - 5))
                                    
                    Key.KeywordFile = CurrentFile
                    Key.KeywordNo = CurrentNumber
                    Key.KeywordText = Searchword
                    'TxtReport = TxtReport & Chr(13) & Chr(10) & "Checking Keyword: " & Searchword & "(Line: " & LineCounter & " Number: " & CurrentNumber & ")"
                    TxtReport.SelStart = Len(TxtReport)
                    If CheckReply(Key).ResponseText <> "" Then
                        'TxtReport = TxtReport & " - Found " & Rfound & " Reponses"
                        'TxtReport.SelStart = Len(TxtReport)
                    Else
                        sMissingReferences = sMissingReferences + 1
                        sErrors = sErrors + 1
                        lblMissingRef.Caption = sMissingReferences
                        TxtReport = TxtReport & Chr(13) & Chr(10) & "Checking Keyword: " & Searchword & "(Line: " & LineCounter & " Number: " & CurrentNumber & ")"
                        TxtReport = TxtReport & Chr(13) & Chr(10) & "!!!! --- Responses Not Found --- !!!! " & Extra
                        TxtReport.SelStart = Len(TxtReport)
                        
                    End If
                End If
                
                
                lblProcess.Caption = LineCounter
                lblErrors.Caption = sErrors
                DoEvents
        Loop
    Close #Fn
    
    TxtReport.Text = TxtReport.Text & Chr(13) & Chr(10) & "Validation Report Log"
    TxtReport.Text = TxtReport.Text & Chr(13) & Chr(10) & sWorkingWords & " Keywords + " & sComments & " Comments Lines + " & sBlanks & " Blank Lines + " & RefFound & " References = " & LineCounter & " Lines"
    TxtReport.Text = TxtReport.Text & Chr(13) & Chr(10) & "No. Errors - " & sErrors
    TxtReport.Text = TxtReport.Text & Chr(13) & Chr(10) & "     No. of Missing References: " & sMissingReferences
    TxtReport.Text = TxtReport.Text & Chr(13) & Chr(10) & "     No. of Missing Files: " & sMissingFiles
    If sErrors = 0 Then
        TxtReport.Text = TxtReport.Text & Chr(13) & Chr(10) & "The Operation was completed Successfully"
    Else
        TxtReport.Text = TxtReport.Text & Chr(13) & Chr(10) & "The Operation was completed but errors were encountered"
    End If
End Sub

Private Function CheckReply(sKeyword As Keyword, Optional ReplyTypes As ResponseType = 3) As Response
    Dim Path As String
    Dim Fn As Byte
    Dim Continue As Boolean
    Dim ResponseFound As Boolean
    Dim Ignore As Boolean
    Dim InputBuffer As String
    Dim ReferenceFound As Boolean
    Dim AnswerCollection As New Collection
    Dim CurrentSubject As String
    Dim A As Integer
    Dim B As Integer
    Dim CurrentString As String
    Dim S As Long
    Dim Q As Long
    Path = App.Path & "\data\" & sKeyword.KeywordFile
    Fn = FreeFile
    ResponseFound = False
    ReferenceFound = False
    
    Open Path For Input As #Fn
        Do Until EOF(Fn) = True Or ResponseFound = 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
                    '///////////////////////////////////////////
                End If
                
                If Chr(Asc(InputBuffer)) = "*" Then
                    'Reference Marker
                    If Trim(InputBuffer) = Trim("*" & sKeyword.KeywordNo) Then
                        '/////////////////////////////////////////
                        'Debug.Print "Keyword Marker Found..."
                        '/////////////////////////////////////////
                        ReferenceFound = True
                        Ignore = True
                    End If
                End If
                
                If ReferenceFound = True Then
                    If Chr(Asc(InputBuffer)) = "*" Then
                        If Ignore = True Then
                            Ignore = False
                        Else
                            ReferenceFound = False
                            GoTo EndPos
                        End If
                    End If
                    If Chr(Asc(InputBuffer)) = "#" Then
                        'statement
                        If ReplyTypes = Statement Or ReplyTypes = Either Then
                            AnswerCollection.Add Right(InputBuffer, Len(InputBuffer) - 1)
                            sStatements = sStatements + 1
                            S = S + 1
                            lblStatements.Caption = sStatements
                            '//////////////////////////////////////////////
                            'Debug.Print Right(InputBuffer, Len(InputBuffer) - 1)
                            '//////////////////////////////////////////////
                        End If
                    End If
                    If Chr(Asc(InputBuffer)) = "$" Then
                        'statement
                        If ReplyTypes = Question Or ReplyTypes = Either Then
                            AnswerCollection.Add InputBuffer
                            sQuestions = sQuestions + 1
                            Q = Q + 1
                            LblQuestions.Caption = sQuestions
                            '//////////////////////////////////////////////
                            'Debug.Print Right(InputBuffer, Len(InputBuffer) - 1)
                            '//////////////////////////////////////////////
                        End If
                    End If
                    If Chr(Asc(InputBuffer)) = "@" Then
                        'Subject/Sibling Change
                        CurrentSubject = Right(InputBuffer, Len(InputBuffer) - 9)
                        '/////////////////////////////////////////////////////////
                        'Debug.Print CurrentSubject
                        '/////////////////////////////////////////////////////////
                    End If
                End If
            End If
EndPos:
        Loop
        
        CheckReply.ResponseSubject = CurrentSubject
        B = AnswerCollection.Count - 1
        If B < 0 Then Exit Function
        Randomize Timer
        A = Int((B - 0 + 1) * Rnd + 1)
        CurrentString = AnswerCollection.Item(A)
        CurrentString = LCase(CurrentString)
        If Left(CurrentString, 1) = "$" Then
            'Question
            CheckReply.Question = True
        End If
        'Remove Type key from beginning
        If CurrentString = "" Then CurrentString = AnswerCollection.Item(AnswerCollection.Count - 1)
        CurrentString = Right(CurrentString, Len(CurrentString) - 1)
        'Extract Detail at the end
        If InStr(1, CurrentString, "{") <> 0 Then
            CheckReply.ResponseAction = Right(CurrentString, Len(CurrentString) - InStr(1, CurrentString, "{") + 1)
            CurrentString = Trim(Left(CurrentString, InStr(1, CurrentString, "{") - 1))
            '-----------------------------------------
            'Debug.Print GetRandomReply.ResponseAction
            '-----------------------------------------
        End If
 
        Rfound = S + Q
        CheckReply.ResponseText = CurrentString
    Close #Fn
End Function