从今天起铁了心的准备研究MSN机器人。先研究基本实现与DotMSN.

做一个智能的聊天机器人并不容易,我这里只是实现了一个很简易的聊天机器人。
   当你和这个机器人聊天的时候,每次机器人会根据你说的话的关键词找到回答的语句。如果找不到就随机的说一句默认语言。数据存储格式是xml。
   以下是xml的原文件:

 1<?xml version="1.0" encoding="UTF-8"?>
 2<chat>
 3  <!--默认的聊天语句-->
 4  <default>
 5    <content>你在哪里?</content>
 6    <content>你还是学生吗?</content>
 7   
 8 </default>
 9 <!--回答指定关键词的语句序列-->
10<answer>
11    <content key=""> 不怪</content>
12    <content key="">是啊,慢</content>
13    <content key="">什么事?</content>
14    <content key="88">再见</content>
15    <content key="">没什么好谢的</content>
16    <content key="">我不会滚,我会走</content>
17<answer>
18</chat>

 1Dim xmlFile As String = "./robot.xml"
 2    Dim chatList As New ArrayList
 3    Dim answerList As New Hashtable
 4    Dim random As New System.Random
 5    Private Sub readxml()
 6        Try
 7            Dim doc As XmlDocument = New XmlDocument
 8            doc.Load(xmlFile)
 9            Dim nodeList As XmlNodeList
10            Dim root As XmlElement = doc.DocumentElement
11            '--默认的聊天语句--
12            nodeList = root.SelectNodes("/chat/default/content")
13            Dim node As XmlNode
14            For Each node In nodeList
15                chatList.Add(node.InnerText)
16            Next
17            '回答指定关键词的语句序列--
18            nodeList = root.SelectNodes("/chat/answer/content")
19            For Each node In nodeList
20                answerList.Add(node.Attributes("key").Value, node.InnerText)
21            Next
22        Catch ex As Exception
23            MsgBox(ex.Message)
24        End Try
25    End Sub
26
27    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
28        'RichTextBox1.SelectionBullet = True
29        Dim Content$ = TextBox1.Text.Trim
30        If (Content = "") Then
31            RichTextBox1.AppendText("请不要欺骗我的感情,谢谢!" + ControlChars.Lf)
32            Exit Sub
33        End If
34        If (Content.IndexOf(":"<> -1) Then
35            If learnNewWord(Content) Then
36                RichTextBox1.AppendText("我又学会了新的东西,谢谢!" + ControlChars.Lf)
37            End If
38            Exit Sub
39        End If
40        RichTextBox1.AppendText(Content + ControlChars.Lf)
41        Dim aStr$ = getSimilarContent(Content)
42        If (aStr = Nothing) Then
43            Dim i% = random.Next(1, chatList.Count)
44            aStr = chatList.Item(i)
45        End If
46        RichTextBox1.AppendText(aStr.Trim + ControlChars.Lf)
47        RichTextBox1.Refresh()
48    End Sub
49    '得到相似的字符串
50    Function getSimilarContent(ByVal content As String) As String
51        Dim keys As System.Collections.ICollection = answerList.Keys
52        Dim enumR As System.Collections.IEnumerator = keys.GetEnumerator
53        While (enumR.MoveNext)
54            Dim str$ = enumR.Current
55            If content.Equals(str) Then
56                Return answerList(str)
57            End If
58        End While
59        enumR.Reset()
60        While (enumR.MoveNext)
61            Dim str$ = enumR.Current
62            If (content.IndexOf(str) <> -1) Or (str.IndexOf(content) <> -1) Then
63                Return answerList(str)
64            End If
65        End While
66        Return Nothing
67    End Function
68    '添加新的语句
69    Function learnNewWord(ByVal content As String) As Boolean
70        Try
71            Dim doc As XmlDocument = New XmlDocument
72            Dim i% = content.IndexOf(":")
73            Dim str1$ = content.Substring(0, i)
74            Dim str2$ = content.Substring(i + 1)
75            doc.Load(xmlFile)
76            Dim elem As XmlElement = doc.CreateElement("content")
77            Dim attr As XmlAttribute = doc.CreateAttribute("key")
78            attr.Value = str1
79            elem.InnerText = str2
80            elem.Attributes.Append(attr)
81            '添加新的语句--
82            Dim root As XmlElement = doc.DocumentElement
83            Dim xmlNode As XmlNode = root.SelectSingleNode("/chat/answer")
84            xmlNode.AppendChild(elem)
85            answerList.Add(str1, str2)
86            doc.Save(xmlFile)
87            Return True
88        Catch ex As Exception
89            MsgBox(ex.Message)
90            Return False
91        End Try
92    End Function
93    Private Sub TextBox1_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles TextBox1.KeyPress
94        If e.KeyChar.Equals(ControlChars.Cr) Then
95            Button1_Click(Nothing, Nothing)
96        End If
97    End Sub
98

posted @ 2006-12-18 17:01  楚广明  阅读(117)  评论(0)    收藏  举报