用vb编写的聊天机器人代码-星旺坡

管理首页

【原创】用vb实现聊天机器人代码
'COPYRIGHT sc寻
'VER 0.01
'简要说明
'本程序是一个简单的聊天机器人
'使用者提出的问题首先在iqq()中查找有没有包含定义的关键词，如果有>=1 个则随机挑选一句回答
'如果没有则从rnda()中随机挑选一句随机答案回答
'窗体中添加cmdtalk按钮 txtans txtq 文本框 multiline设为true scrollbars设为2
Dim iqa() As String 'iq回答的单个答案
Dim iqq() As String 'iq回答的单个问题
Dim iqnum As Integer 'iq回答的问题、答案个数
Dim rnda() As String ' rnd回答的单个答案
Dim rndansnum As Integer 'rnd回答的答案个数
Dim dat As String '从文件载入的原始数据
Dim username As String '使用者名字
Dim robotname As String '机器人名字
Dim ver As String '数据版本
Dim rndans As String 'rnd回答的所有数据
Dim iqans As String 'iq回答的所有数据

Private Sub cmdtalk_Click()

Dim q As String
Dim a As String
q = txtq.Text
txtans.Text = txtans.Text & username & ":" & vbNewLine
txtans.Text = txtans.Text & q & vbNewLine & vbNewLine
'首先检查iqq

Dim manyiq As Integer

For i = 1 To iqnum
If InStr(q, iqq(i)) <> 0 Then
manyiq = manyiq + 1
End If
Next i

ReDim manyans(manyiq) As String
Dim oneiq As Integer

For i = 1 To iqnum
If InStr(q, iqq(i)) <> 0 Then
oneiq = oneiq + 1
manyans(oneiq) = iqa(i)
End If
Next i

If manyiq <> 0 Then

a = manyans(Int(Rnd * oneiq) + 1)
Else

a = rnda(Int(Rnd * rndansnum) + 1)
End If
txtans.Text = txtans.Text & robotname & ":" & vbNewLine
txtans.Text = txtans.Text & a & vbNewLine & vbNewLine
txtans.SetFocus
txtans.SelStart = Len(txtans.Text)
End Sub

Private Sub Form_Load()
Randomize
datname = "c:\talk.dat"
Open datname For Binary As 1
dat = Space(LOF(1))
Get 1, , dat
Close 1

'获取username robotname ver rndans iqans
username = InputBox("请输入你的名字", "提示")
start = InStr(dat, "<name>")
over = InStr(dat, "</name>")
robotname = Mid(dat, start + 6, over - start - 6)
start = InStr(dat, "<ver>")
over = InStr(dat, "</ver>")
ver = Mid(dat, start + 5, over - start - 5)
start = InStr(dat, "<rndans>")
over = InStr(dat, "</rndans>")
rndans = Mid(dat, start + 8, over - start - 8)
start = InStr(dat, "<iqans>")
over = InStr(dat, "</iqans>")
iqans = Mid(dat, start + 7, over - start - 7)

'rnda(rndansnum)获取

Dim rndanslen As Long 'rnd回答的所有数据长度
rndansnum = 0
rndanslen = Len(rndans)
For i = 1 To rndanslen
If Mid(rndans, i, 1) = "|" Then
rndansnum = rndansnum + 1
End If
Next i

ReDim rnda(rndansnum) As String '定义每一个rnd回答的动态数组
Dim lastl As Integer '上一次|的位置
num = 1 'num是数组中的标号（rndansnum是总数）
For i = 1 To rndanslen
If Mid(rndans, i, 1) = "|" Then
rnda(num) = Mid(rndans, lastl + 1, i - lastl - 1)
num = num + 1
lastl = i
End If
Next i

'iqq(rndansnum) iqa(rndansnum)获取

Dim iqanslen As Long
iqanslen = Len(iqans)
For i = 1 To iqanslen
If Mid(iqans, i, 1) = "|" Then
iqansnum = iqansnum + 1
End If
Next i

ReDim iqa(iqansnum) As String
ReDim iqq(iqansnum) As String

lasta = 0
lastq = 0
num = 1
For i = 1 To iqanslen
If Mid(iqans, i, 1) = "\" Then
iqq(num) = Mid(iqans, lasta + 1, i - lasta - 1)
num = num + 1
lastq = i
ElseIf Mid(iqans, i, 1) = "|" Then
iqa(num - 1) = Mid(iqans, lastq + 1, i - lastq - 1)
lasta = i
End If
Next i

iqnum = iqansnum

'欢迎信息

txtans.Text = txtans.Text & username & ",欢迎使用本软件" _
& vbNewLine & "我叫" & robotname & " 数据库版本 " & ver & vbNewLine
txtans.Text = txtans.Text & "iqnum " & iqnum & vbNewLine
txtans.Text = txtans.Text & "rndansnum " & rndansnum & vbNewLine & vbNewLine
End Sub

作者： sc寻 2007-7-1 11:42 　回复此发言

--------------------------------------------------------------------------------

2 回复：【原创】用vb实现聊天机器人代码
以下是简单的数据当然你可以自由发挥让他更完美
保存为c:\talk.dat
<name>s1</name>
<ver>0.01</ver>
<rndans>呵呵|你真有趣|哈哈|嗯|说说你吧|嘿嘿|这样啊|是啊|怎么啦|喂，

说清楚点|是这样啊|你真好玩|晕|狂晕|晕死了|真的吗|说说你自己吧|逗你玩

|哦|当然|废话|也许吧……
|我想我还没有完全理解。
|不知道|啊?|是吗?|你是认真的吗|我不知道怎样回答|我不同意你所说的每一

个字,但我誓死捍卫你说话的权力|说说别的吧|很高兴见到你|你说呢

|</rndans>
<iqans>vb\我就是用vb写成|快乐\世界上总有一半人不理解另一半人的快乐|

爱情\每个人的爱情都不会一样|失恋\失恋啦？旧的不去，新的不来嘛，说不

定下一个会更好|几岁\我2007年6月30日出生|多大\我2007年6月30日出生|主

人\嘿嘿,我的主人是--sc寻|诞生\我2007年6月30

日出生|年龄\我2007年6月30日出生|生日\我2007年6月30日出生|机器人\嘿嘿

,我就是机器人啦|程序\我就是一段程序啦|青羊实验\嘿嘿,那是著名的学校|

上学\我不喜欢上学|考试\我不用考试|你是谁\嘿嘿,我就是机器人啦|哈哈\别

这样笑。要笑不露齿!|大哥缘分啊\你是范伟啊|你叫什么\我叫s1|你的名字\

我叫s1|你好\嗨，你好，真高兴你能和我说话|呵呵\你笑什么啊|友情\其实有

时友情很脆弱的，但是真正的友情经得住考验。|你真有趣\谢谢|你真幽默\谢

谢|好玩\注意我可不是玩具~~~~呵呵|好耍\注意我可不是玩具~~~~呵呵|知

道?\当然知道|真的吗\当然是真的|真的吗\非常严肃认真|真的吗\当然是真的

，我啥时候骗过你|谢谢\不必客气|晕\别啊！~我扶不动你的啊|智商低\请不

要侮辱机器人|弱智\请不要侮辱机器人|傻瓜\请不要侮辱机器人|瓜儿\请不要

侮辱机器人|瓜娃子\请不要侮辱机器人|白痴\请不要侮辱机器人|二百五\请不

要侮辱机器人|疯子\请不要侮辱机器人|性别\我当然是男的|男的女的\废话我

当然是男的|也许吧\为什么用这种不确定的口气？|不确定\除了5要素外，一

切都是不确定的。
|你是谁\我可能只是存在于电脑内存中的一堆1和0
|认识\认识分两种：感性认识，和理性认识。感觉到的，和推理出的。|生命\

\我没怎么研究科学|笑一下\哈哈|狂晕\这么脆弱啊？你也太差劲了呀。|你说

话太\啊?是吗?|政治\我不谈政治|共产\我不谈政治|台独\我不谈政治|笑话\

吗\知道|s1\你在说我吗|图灵\图灵是伟大的数学家。在数学、计算机、人工

智能等领域做出了卓越的贡献。
|洛伯纳奖\那是我永远奋斗的目标|为什么\世界充满了未知|物理\我没怎么研

究物理|化学\我对化学很感兴趣|痛苦\痛苦就是被迫离开原地|自由\理性能使

人自由|理性\理性能使人自由|思考\我思故我在|怀疑\可以怀疑一切，但却不

能怀疑正在怀疑一切|群众\群众永远生活在无知的洞穴之中|无知\群众永远生

人的本性就是追求个人利益|幸福\幸福不过是欲望的暂时停止|忘记\人最容易

忘记的是自己|知识\知识就是力量|存在\存在就是合理,合理的也都要存在|说

谎\我正在说谎|地狱\他人就是地狱|他人\他人就是地狱|无限\无限不是实在

的实体。无限是潜在于思维中的一个连续不断的过程。|因果\因果关系是由人

的习惯性联想原则所决定的|因为\因果关系是由人的习惯性联想原则所决定的

|所以\因果关系是由人的习惯性联想原则所决定的|信仰\信仰是人生的力量|

坏人\坏人因畏惧而服从，好人因爱而服从|好人\坏人因畏惧而服从，好人因

爱而服从|约束\能约束自己的人，最有威信|威信\能约束自己的人，最有威信

|平庸\平庸的人最大的缺点是常常觉得自己比别人高明|英雄\一个人不能永远

做一个英雄，但一个人能永远做一个人|敌人\对敌人的仁慈就是对敌人最大的

残忍|灵魂\磁石有灵魂，因为它有灵魂|世界\世界是包括一切的整体，它不是

由任何神或任何人所创造的，它过去、现在和将来都是按规律燃烧着，按规律

熄灭着的永恒的活火|运动\阿基里斯永远追不上乌龟|知识\知识就是存在的映

象|自然\要命令自然都必须服从自然|静止\全宇宙中并没有真正静止的点|批

判\批判的武器当然不能代替武器的批判|物质\物质力量只能用物质力量来摧

毁|理解\理解是一种视界融合|南柯一梦\物质决定意识|庖丁解牛\掌握规律，

得心应手|我有点困\我永远不知疲倦|疲倦\我永远不知疲倦|再见\bye-

bye|bye-bye\再见|88\再见|做人要厚道\机器人比人厚道|汗\需要毛巾吗|寒\

度很好用|博客\你有博客吗？|感动\感动是一种养分|你要\不要了，行行好吧

～|身高\我不告诉你|体重\我不告诉你|流行\流行就是硬道理|同性恋\李宇春

还是《断臂山》|笑\开心就要尽情地笑啊|你应不应该\听你的，你叫我干啥我

谢支持|你懂吗\我以为我略知一二|</iqans>


作者： sc寻  2007-7-1 11:46 　回复此发言

--------------------------------------------------------------------------------

3 回复：【原创】用vb实现聊天机器人代码
好东西能不能把聊天数据库发上来


作者： 58.48.90.*  2007-7-1 11:47 　回复此发言

--------------------------------------------------------------------------------

4 回复：【原创】用vb实现聊天机器人代码
说明一下<iqans>中\前面的是关键词后面的是回单


作者： sc寻  2007-7-1 11:55 　回复此发言

--------------------------------------------------------------------------------

5 回复：【原创】用vb实现聊天机器人代码
很有意思，支持LZ！！


作者： xjsoftware   2007-7-1 19:01 　回复此发言

--------------------------------------------------------------------------------

6 回复：【原创】用vb实现聊天机器人代码
sc寻同志，不知道是怎么搞的，我直接复制你的聊天数据可以正常进行聊天，即我发送一句不论是否为空格，电脑就会立刻返回一句内容，而我把文本改动一下后（添加了一点内容，还去掉了一些字符间的空格）发送空内容可以返回随机定义的内容，但如果发送一个数据中（<iqans>）不存在的内容时，返回的便是空内容了，不知道是什么原因？
谢谢！


作者： 222.184.241.*  2007-7-2 04:28 　回复此发言

--------------------------------------------------------------------------------

7 回复：【原创】用vb实现聊天机器人代码
肯定是你改的东西格式不对先是关键词\回答| 不要把符号弄掉或弄错
另外现在我加了一点判断是否输入为空的代码还增加重复提问提醒和问题过长提示功能代码如下
'COPYRIGHT sc寻
'VER 0.02
'简要说明
'本程序是一个简单的聊天机器人
'使用者提出的问题首先在iqq()中查找有没有包含定义的关键词，如果有>=1 个则随机挑选一句回答
'如果没有则从rnda()中随机挑选一句随机答案回答
'窗体中添加cmdtalk按钮 txtans txtq 文本框 multiline设为true scrollbars设为2
Dim iqa() As String 'iq回答的单个答案
Dim iqq() As String 'iq回答的单个问题
Dim iqnum As Integer 'iq回答的问题、答案个数
Dim rnda() As String ' rnd回答的单个答案
Dim rndansnum As Integer 'rnd回答的答案个数
Dim dat As String '从文件载入的原始数据
Dim username As String '使用者名字
Dim robotname As String '机器人名字
Dim ver As String '数据版本
Dim rndans As String 'rnd回答的所有数据
Dim iqans As String 'iq回答的所有数据
Dim cfa() As String ' cf回答的单个答案
Dim cfansnum As Integer 'cf回答的答案个数
Dim longa() As String ' long回答的单个答案
Dim longansnum As Integer 'long回答的答案个数
Dim lastq As String 'user的上一个问题
Dim cftimes As Integer 'user 的重复次数
Private Sub cmdtalk_Click()

Dim q As String
Dim a As String
q = txtq.Text
txtans.Text = txtans.Text & username & ":" & vbNewLine
txtans.Text = txtans.Text & q & vbNewLine & vbNewLine

'首先检查longa
If Len(txtq) > 50 Then
a = longa(Int(Rnd * longansnum) + 1)
GoTo getans
ElseIf Len(txtq) = 0 Then
MsgBox "发送内容不能为空"
Exit Sub
End If

'然后检查cfa
If lastq = q Then
cftimes = cftimes + 1
Else
cftimes = 0
End If
If cftimes > 1 Then
a = cfa(Int(Rnd * cfansnum) + 1)
GoTo getans:
End If

'接着检查iqq

Dim manyiq As Integer

For i = 1 To iqnum
If InStr(q, iqq(i)) <> 0 Then
manyiq = manyiq + 1
End If
Next i

ReDim manyans(manyiq) As String
Dim oneiq As Integer

For i = 1 To iqnum
If InStr(q, iqq(i)) <> 0 Then
oneiq = oneiq + 1
manyans(oneiq) = iqa(i)
End If
Next i

If manyiq <> 0 Then

a = manyans(Int(Rnd * oneiq) + 1)
Else

a = rnda(Int(Rnd * rndansnum) + 1)
End If

getans:
lastq = q
txtans.Text = txtans.Text & robotname & ":" & vbNewLine
txtans.Text = txtans.Text & a & vbNewLine & vbNewLine
txtans.SetFocus
txtans.SelStart = Len(txtans.Text)
txtq.Text = ""
txtq.SetFocus
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Form_Load()
Dim datname As String
Randomize
datname = App.Path & "\talk.dat"

If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"
cmdtalk.Enabled = False
Exit Sub

Else
cmdtalk.Enabled = True
End If

Open datname For Binary As 1
dat = Space(LOF(1))
Get 1, , dat
Close 1

'获取username robotname ver rndans iqans cfans longans
username = InputBox("请输入你的名字", "提示")
start = InStr(dat, "<name>")
over = InStr(dat, "</name>")
robotname = Mid(dat, start + 6, over - start - 6)
start = InStr(dat, "<ver>")
over = InStr(dat, "</ver>")
ver = Mid(dat, start + 5, over - start - 5)
start = InStr(dat, "<rndans>")
over = InStr(dat, "</rndans>")
rndans = Mid(dat, start + 8, over - start - 8)
start = InStr(dat, "<iqans>")


作者： 211.137.100.*  2007-7-2 09:21 　回复此发言

--------------------------------------------------------------------------------

8 回复：【原创】用vb实现聊天机器人代码
over = InStr(dat, "</iqans>")
iqans = Mid(dat, start + 7, over - start - 7)
start = InStr(dat, "<cfans>")
over = InStr(dat, "</cfans>")
cfans = Mid(dat, start + 7, over - start - 7)
start = InStr(dat, "<longans>")
over = InStr(dat, "</longans>")
longans = Mid(dat, start + 9, over - start - 9)

'rnda(rndansnum)获取

Dim rndanslen As Long 'rnd回答的所有数据长度
rndansnum = 0
rndanslen = Len(rndans)
For i = 1 To rndanslen
If Mid(rndans, i, 1) = "|" Then
rndansnum = rndansnum + 1
End If
Next i

'iqq(rndansnum) iqa(rndansnum)获取

Dim iqanslen As Long
iqanslen = Len(iqans)
For i = 1 To iqanslen
If Mid(iqans, i, 1) = "|" Then
iqansnum = iqansnum + 1
End If
Next i

ReDim iqa(iqansnum) As String
ReDim iqq(iqansnum) As String

iqnum = iqansnum

'cfa(cfansnum)获取

Dim cfanslen As Long 'cf回答的所有数据长度
cfansnum = 0
cfanslen = Len(cfans)
For i = 1 To cfanslen
If Mid(cfans, i, 1) = "|" Then
cfansnum = cfansnum + 1
End If
Next i

ReDim cfa(cfansnum) As String '定义每一个cf回答的动态数组
Dim cflastl As Integer '上一次|的位置
num = 1 'num是数组中的标号（cfansnum是总数）
For i = 1 To cfanslen
If Mid(cfans, i, 1) = "|" Then
cfa(num) = Mid(cfans, cflastl + 1, i - cflastl - 1)
num = num + 1
cflastl = i
End If
Next i

'longa(longansnum)获取

Dim longanslen As Long 'long回答的所有数据长度
longansnum = 0
longanslen = Len(longans)
For i = 1 To longanslen
If Mid(longans, i, 1) = "|" Then
longansnum = longansnum + 1
End If
Next i

ReDim longa(longansnum) As String '定义每一个long回答的动态数组
Dim longlastl As Integer '上一次|的位置
num = 1 'num是数组中的标号（longansnum是总数）
For i = 1 To longanslen
If Mid(longans, i, 1) = "|" Then
longa(num) = Mid(longans, longlastl + 1, i - longlastl - 1)
num = num + 1
longlastl = i
End If
Next i

'欢迎信息

txtans.Text = txtans.Text & username & ",欢迎使用本软件" _
& vbNewLine & "我叫" & robotname & " 数据库版本 " & ver & vbNewLine & vbNewLine