使用vbXMLRPC组件访问xmlrpc接口

这是最简单的一个helloworld的调用。xmlrpc服务器端的代码在前一个blog中。用perl写的。主要是为了测试不同语言的兼容性。

Private Sub Command1_Click()
    Dim linsRequest As New XMLRPCRequest
    Dim linsResponse As XMLRPCResponse
    Dim linsUtility As New XMLRPCUtility
    Dim linsValue As XMLRPCValue
    Dim linsMember As XMLRPCMember
    Dim llngChanId As Long
    Dim lstrChanTitle As String
   
    Me.MousePointer = vbHourglass
   
    linsRequest.HostName = "202.195.160.145"
    linsRequest.HostPort = 80
    linsRequest.HostURI = "/webmin-rpc/xmlrpc.cgi"

    linsRequest.MethodName = "World.HelloWorld"

    Set linsResponse = linsRequest.Submit
   

Select Case linsResponse.Status
    Case XMLRPC_PARAMSRETURNED
        If linsResponse.Params.Count = 1 Then
            If linsResponse.Params(1).ValueType = XMLRPC_STRING Then
                Label1.Caption = linsResponse.Params(1).StringValue
            Else
                BugOut "Expecting a datetime to be returned instead received a '" & linsUtility.GetXMLRPCType(linsResponse.Params(1).ValueType) & "'."
            End If
        Else
            BugOut "Expecting one return parameter, received '" & linsResponse.Params.Count & "'."
        End If
    Case XMLRPC_FAULTRETURNED
        BugOut "Server returned a fault. Code is '" & linsResponse.Fault.faultCode & "', description is '" & linsResponse.Fault.faultString & "'."
    Case XMLRPC_HTTPERROR
        BugOut "HTTP error encountered. Code is '" & linsResponse.HTTPStatusCode & "', description is '" & linsUtility.GetHTTPError(linsResponse.HTTPStatusCode) & "'."
    Case XMLRPC_XMLPARSERERROR
        BugOut "XML Parsing Error encountered '" & linsResponse.XMLParseError & "'."
    Case XMLRPC_NOTINITIALISED
        BugOut "Weird, the response claims not to be initialised !!!"
    Case Else
        BugOut "Double Weird, unknown response status '" & linsResponse.Status & "'."
    End Select
    
    Me.MousePointer = vbDefault

End Sub

Private Sub BugOut(ByVal vstrError As String)
    MsgBox vstrError, vbOKOnly + vbCritical, App.Title
End Sub

Trackback: http://tb.blog.csdn.net/TrackBack.aspx?PostId=477823