水一篇，VB+python实现智能聊天机器人案例

1.分工

理论上单python也能写，但是做gui开发，python要用到thinter库/qt库，稍微麻烦一点。这个案例是python做json截取，VB做gui开发+截取json字符。

2.准备工作

编写生成file_controlv2.dll并注册，编写speaker.vbs,准备python环境，并通过pip安装pyinstaller和request 通过pyinstaller -F get_page.py生成新的exe供VB使用，get_page.py、file_controlv2.dll 和 speaker.vbs参考以下代码

get_page.py

import requests
import sys
 
 
def get_page(msg):
    page=requests.get('http://api.qingyunke.com/api.php?key=free&appid=0&msg='+msg)
    print( page.text)
    f = open("pageinfo", "a")
    f.write(page.text)
    f.close()
 
if __name__ == '__main__':
     print (sys.argv[1])
     get_page(sys.argv[1])

file_controlv2.dll

speaker.vbs

Set objArgs = WScript. Arguments
CreateObject("SAPI.SpVoice").speak objArgs(0)

file_controlv2.dll

Public Function file_controldll() As Boolean
    file_controldll = True
End Function
Public Sub set_text(filepath As String, mode As Integer, txt As String) 'mode是模式，txt是写入内容,filepath是写入的文件路径
    Select Case mode
        Case 1
            Open filepath For Output As #1
        Case 3
            Open filepath For Append As #1
    End Select
            Print #1, systemout + txt & vbCrLf;
    Close #1
End Sub
 
Public Function get_text(filepath As String)
    Dim lines As String
    If filepath <> "" Then
    Open filepath For Input As #1
        Do While Not EOF(1)
            DoEvents
            Line Input #1, NextLine
            lines = lines & NextLine & vbCrLf   'vbcrif是换行的意
        Loop
    Close #1
    get_text = lines + Chr(13)
    End If
End Function
 
Public Function get_lines(filepath As String)
Dim lines As Integer
    Open filepath For Input As #1
       Do While Not EOF(1)
           Line Input #1, Str1
           lines = lines + 1
       Loop
    Close #1
    get_lines = lines
End Function
Public Function get_linetext(filepath As String, lines As Integer)
     Open filepath For Binary As #1
        a = StrConv(InputB(LOF(1), 1), vbUnicode)
    Close #1
    b = Split(a, vbCrLf)
    get_linetext = b(lines - 1)
End Function
 

要将Instancing的值设置为6，生成dll文件，并在创建新工程后引用，主程序工程名不能与dll工程名一样，否则会报错

3.摆放布局和编写主程序代码

具体布局如图所示

 具体代码:

''''''''''''''''
'智能ai系统demo
'PYTHON+VB混合编程 && 简单api获取实例(实际就是做字符串的切割) && 微软自带语音包
'API青客云
'用到的库:file_controlv2.dll 源码:GITHUB，另一个仓库
'power by wh
''''''''''''''''
Sub speak(str)
    DoEvents
    'CreateObject("SAPI.SpVoice").speak str
    Shell "cscript speaker.vbs" & Chr(32) & str '''降低卡顿'''
End Sub
 
 
 
Private Sub close_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then End
End Sub
 
Private Sub Command1_Click()
    If Text1.Text = "" Or Text1.Text = "请输入信息,并点击发送" Then Exit Sub
    inputstr = Text1.Text
    Text1.Text = ""
    If Dir(App.Path + "\pageinfo") <> "" Then Kill App.Path + "\pageinfo"
    dialog.AddItem CStr(Time) + ":" + Chr(32) + "你:" & inputstr
    wait_for_run App.Path + "\get_page.exe" & Chr(32) & inputstr
    recevieinfo
End Sub
 
Sub recevieinfo() '''获取信息'''
   'JSON样例  {"result":0,"content":"“111”是啥意思？"}
   '处理思路:直接截取:"content"后的文本，替换""和}为空就完事了
    recevice = get_text(App.Path + "\pageinfo")
    format_text = "{" & Chr(34) & "result" & Chr(34) & ":0,content" & Chr(34) & ":"
    '''让}和""为空
    ai_text = _
    Replace(Replace(Mid(recevice, Len(format_text) + 2), Chr(34), ""), "}", "")
    speak ai_text
    dialog.AddItem CStr(Time) + Chr(32) + "智能AI:" & ai_text
End Sub
 
 
 
Private Sub Form_Load()
    If Not isadmin Then MsgBox "权限不足", vbInformation, "提示": End
    If Not isnetworking Then MsgBox "网络未连接", vbInformation, "提示": End
End Sub
 
Private Sub imagebutt_Click(Index As Integer)
      Shell "cmd /c start http://www.baidu.com"
End Sub
 
 
 
'''''无窗体移动
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call movewindows(Me.hwnd, X, Y)
End Sub
 
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call movewindows(Me.hwnd, X, Y)
End Sub
'''
 
'''类似安卓hint
Private Sub Text1_GotFocus()
    If Text1.Text = "请输入信息,并点击发送" Then Text1.ForeColor = vbBlack: Text1.Text = ""
End Sub
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Command1_Click
End Sub
 
Private Sub Text1_LostFocus()
    If Text1.Text = "" Then Text1.ForeColor = &H808080: Text1.Text = "请输入信息,并点击发送"
End Sub
'''
 

SystemAPImoduel.bas

'''''''''''''
'
'系统api模块(包括topmost，无窗体边框移动)
'power by wh
'updata:2022 12 6
'
'''''''''''''
'''声明
Private Declare Function ReleaseCapture Lib "user32" () As Long '无窗体解锁
'''无边框窗体移动'''
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'''等待程序运行结束'''
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
 
'''延迟,mathv3的yc函数就是调用的这个api'''
Private Declare Sub Sleep Lib "kernel32.DLL" (ByVal dwMilliseconds As Long)
 
'''常量声明'''
Private Const SWP_NOMOVE = &H2 '不移动窗体
Private Const SWP_NOSIZE = &H1 '不改变窗体尺寸
Private Const Flag = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1 '窗体总在最前面
Private Const HWND_NOTOPMOST = -2 '窗体不在最前面
 
 
 
Function isnetworking() As Boolean
     '''测试网络连接模块，vb6太特殊写不出不加winsock/其他dll的代码'''
     If Dir(Environ("temp") + "\isnetworking.dll") <> "" Then Kill (Environ("temp") + "\isnetworking.dll") '生成临时文件,只要pc环境变量没问题这里就不会有问题
     Shell "cmd /c ping /n 1 www.baidu.com  && echo %errorlevel% > %temp%\isnetworking.dll"
     Sleep 1000 '1000毫秒,1秒
     If Not Dir(Environ("temp") + "\isnetworking.dll") <> "" Then isnetworking = False: Exit Function '这种情况属于特殊情况，网络没有连接可能出现，我也不知道为什么，还有就是权限不够
     If Val(get_text(Environ("temp") + "\isnetworking.dll")) = 0 Then isnetworking = True Else isnetworking = False '获取cmd传出的errorlevel值
End Function
 
 
Function isadmin() As Boolean
    On Error GoTo noadmin
    set_text Environ("windir") + "\admin.dll", 1, "test" '写入一个文件到windows安装目录，如果存在代表有管理员权限，否则就没有，win7以下系统不用考虑这个问题
    If Dir(Environ("windir") + "\admin.dll") <> "" Then Kill Environ("windir") + "\admin.dll": isadmin = True: Exit Function
noadmin:
    isadmin = True
End Function
 
 
Sub topmost(istopmost As Boolean, formhwnd As Long) ''遇到全屏被底部任务栏遮挡，可以考虑用这个''
    Select Case istopmost
        Case True
            SetWindowPos formhwnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
        Case False
            SetWindowPos formhwnd, HWND_NOTOPMOST, 0, 0, 0, 0, Flag
    End Select
End Sub
 
 
Sub movewindows(formhwnd As Long, X As Single, Y As Single)
    ReleaseCapture 'api实现拖动窗体移动,无边框窗体本来不可移动，加上这句就可以了
    SendMessage formhwnd, &HA1, 2, 0&
End Sub
 
Sub wait_for_run(exe As String) '不可用于bat！
'''''''''''''''''''
'运行程序模块，逻辑是等待程序运行
'''''''''''''''''''
    i = Shell(exe) 'i为pid
    p = OpenProcess(&H100000, False, i) '字面意思打开进程句柄
    DoEvents
    r = WaitForSingleObject(p, -1)
    r = CloseHandle(p) '关闭句柄
End Sub