VB調用VB腳本VBS向Http請求的三種方式

 VB代碼

第一步，創建腳本對象，讀出 VBStest.txt 文件

Private myScript As Object

Private Sub Form_Load()
    Call m_Initialize
End Sub

Public Sub m_Initialize()
Dim strScriptFile As String
Dim strScript As String
Dim intFile As Integer
intFile = FreeFile

strScriptFile = App.Path & "\Script\VBStest.txt"

If Dir(App.Path & "\Script\VBStest.txt") <> "" Then

    Open strScriptFile For Binary As #intFile
    strScript = Input(LOF(intFile), intFile)
    Close intFile

   Set myScript = CreateObject("ScriptControl")
   myScript.Language = "VBScript"
   'myScript.timeout = 1000
   myScript.AddCode strScript

End If
    
End Sub

第二步  腳本調用的方法

Public Function m_FCustom1(ByVal str調用名稱 As String, ByVal str服務器參數 As String, ByRef str返回值 As String) As Boolean
On Error GoTo ErrTrap
Dim strA As String
 
    str返回值 = myScript.Run(str調用名稱, str服務器參數)
    'm_FCustom1 = True

Exit Function
ErrTrap:
    MsgBox ("出錯！" & CStr(Err) & " " & Error(Err))
        
On Error GoTo 0
End Function

第一種 Post方式

Private Sub Command3_Click()
Dim strA As String
    Call m_FCustom1("m_Post", "m_Post 11111111", strA)
    MsgBox ("返回值！" & strA)
 
End Sub

第二種  Get 方式

Private Sub Command4_Click()
    Dim strA As String
    Call m_FCustom1("m_Get", "m_Get  222222222", strA)
    MsgBox ("返回值！" & strA)
End Sub

第三種  Json 方式

Private Sub Command1_Click()
Dim strA As String
    Call m_FCustom1("m_PostTest", "m_Post  接口調試", strA)
    MsgBox ("返回值！" & strA)
End Sub

VB腳本代碼 VBStest.txt

Function m_Get(strTelNumber)
Dim strA 
Dim http
Dim strUrl

    strUrl="http://localhost/callcenter2/VBStest.php?AAAA=1111"
    
     Set http = CreateObject("Msxml2.ServerXMLHTTP")
    'strA = http.open("GET", "http://www.baidu.com", False)
        strA = http.open("GET", strUrl, False)
    http.send

    MsgBox http.Status
    MsgBox http.responsetext


    m_Get = http.responsetext

    
End Function

Function m_Post(strTelNumber)
Dim strA 
Dim http
Dim strUrl

    strUrl="http://localhost/callcenter2/VBStest.php"
    
     set Http=createobject("MSXML2.XMLHTTP")
    'strA = http.open("POST", "http://www.baidu.com", False)     
    strA = http.open("POST", strUrl, False)     
    http.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
    http.Send "Text1=1AA&Text2=2BBBBB"
    
    MsgBox http.Status
    MsgBox http.responsetext


    m_Post = http.responsetext
    
End Function

'Jost方式
Function m_PostTest(strTelNumber)
Dim strA 
Dim http
Dim strUrl

    strUrl="http://211.140.196.159:9979/hlbr/api/callcenter/advisory"
    
     set Http=createobject("MSXML2.XMLHTTP")
    'strA = http.open("POST", "http://www.baidu.com", False)     
    strA = http.open("POST", strUrl, False)     
    http.setRequestHeader "CONTENT-TYPE","application/json"
    http.Send "{'id':'1'}"
    
    MsgBox http.Status
    MsgBox http.responsetext

    m_Post = http.responsetext
    
End Function