VB 提交 关键字 并显示结果

Question

http://dm.178.com/dtq/zxdtq/ 这个网址里面有个答案搜索 输入关键字 例如 输入 华佗 然后会显示答案我想用VB做个程序 就是输入 关键字 然后显示出来答案 但实在能力有限，往高手帮忙，谢谢！

Answer 1

麻烦！
代码如下：Form1:
Option ExplicitPrivate Sub Command1_Click()
    Dim XML As Object
    Dim ReturnCode$(), Question$, Answer$
    Set XML = CreateObject("microsoft.XMLHTTP")
    XML.Open "GET", "http://118.144.73.152:9201/tools/dmlq/ly.php?s=" & UnicodeToUtf8(SerchName), True
    XML.send
    Do Until XML.ReadyState = 4
        DoEvents
    Loop
    Text1.Text = Encode(XML.ResponseText)
End SubPrivate Sub Form_Load()
    SerchName.Text = "曹操"
End SubFunction RemoveChr(ByVal Source As String) As String
    Source = Replace(Source, "u", "")
    Source = Replace(Source, "qst=[[", "")
    Source = Replace(Source, "]];", "")
    Source = Replace(Source, Chr(34), "")
    Source = Replace(Source, "[", "")
    Source = Replace(Source, "?", "")
    RemoveChr = Source
End Function
 
Function Encode(ByVal Source As String) As String
    If Source <> "qst=[];" Then
        Dim i&, j&, k&, Result$, temp$(), stem$(), tem$()
        temp = Split(Source, "],")
        For i = LBound(temp) To UBound(temp)
            stem = Split(temp(i), ",")
            Result = ""
            For j = LBound(stem) To UBound(stem)
                tem = Split(stem(j), "\")
                For k = LBound(tem) To UBound(tem)
                    tem(k) = RemoveChr(tem(k))
                    If Len(tem(k)) = 4 Then
                        Result = Result & ChrW("&H" & tem(k))
                    End If
                Next k
            Next j
            Encode = Encode & i + 1 & "、" & Trim(Result) & "。" & vbCrLf
        Next i
    Else
        Encode = "没有您所要查询的题目!"
    End If
End Function
Module1.bas:
Option ExplicitPrivate Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Const CP_UTF8 = 65001Public Function UnicodeToUtf8(ByVal sData As String) As String '编码
    Dim aRetn() As Byte, nSize As Long, ReturnStr As String, X As Long
    Dim lLength As Long
    Dim lBufferSize As Long
    Dim lResult As Long
    Dim abUTF8() As Byte
    lLength = Len(sData)
    If lLength = 0 Then Exit Function
    lBufferSize = lLength * 3 + 1
    ReDim aRetn(lBufferSize - 1)
    nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), lLength, aRetn(0), lBufferSize, vbNullString, 0)
    If nSize = 0 Then Exit Function
    ReDim Preserve aRetn(0 To nSize - 1) As Byte
    For X = LBound(aRetn) To UBound(aRetn)
      ReturnStr = ReturnStr & "%" & String(2 - Len(Hex(aRetn(X))), "0") & Hex(aRetn(X))
    Next X
    Erase aRetn
    UnicodeToUtf8 = ReturnStr
End Function

Answer 2

SerchName是一个TextBox。发表了自己还不能更改了！

Answer 3

不好意思，这几天没有时间上网。今天一上班就来看了，非常感谢 vbload 代码测试成功，相信您是花了时间写出来的。代码我还在学习几乎只能看懂1/1000,哈哈，因为太菜了。希望楼上的朋友可以教我一实现原理！我发了短信给您了，请您加一下我，多谢！CSDN果然高手如云，谢谢各位了！