Added suport for JSON-RPC 2.0 in jsonlib

Public Function JsonRpcCall(url As String, methName As String, args(),
Optional user As String, Optional pwd As String) As Object
    Dim r As Object, cli As MSXML2.XMLHTTP60
    Dim pText As String
    Static reqId As Integer

    reqId = reqId + 1

    Set r = CreateObject("Scripting.Dictionary")
    r("jsonrpc") = "2.0"
    r("method") = methName
    r("params") = args
    r("id") = reqId

    pText = toString(r)

    ''Set cli = CreateObject("MSXML2.XMLHTTP.6.0")
    Set cli = New MSXML2.XMLHTTP60
    If Len(user) > 0 Then   ' If Not IsMissing(user) Then
        cli.Open "POST", url, False, user, pwd
    Else
        cli.Open "POST", url, False
    End If
    cli.setRequestHeader "Content-Type", "application/json"
    cli.Send pText

    If cli.Status <> 200 Then
        Err.Raise vbObjectError + INVALID_RPC_CALL + cli.Status, ,
cli.statusText
    End If

    Set r = parse(cli.responseText)
    Set cli = Nothing

    If r("id") <> reqId Then Err.Raise vbObjectError + INVALID_RPC_CALL, ,
"Bad Response id"

    If r.Exists("error") Or Not r.Exists("result") Then
        Err.Raise vbObjectError + INVALID_RPC_CALL, , "Json-Rpc Response
error: " & r("error")("message")
    End If

    If Not r.Exists("result") Then Err.Raise vbObjectError +
INVALID_RPC_CALL, , "Bad Response, missing result"

    Set JsonRpcCall = r("result")
End Function

Original issue reported on code.google.com by telmo.ca...@gmail.com on 16 Jun 2009 at 11:48

VineGlobal / vba-json

Added suport for JSON-RPC 2.0 in jsonlib #5