cJson 示例代码集

本文档包含各种实际使用场景的详细示例代码。

目录

1. 基础示例
2. HTTP API 交互
3. 文件操作
4. 复杂数据结构
5. 实际业务场景

---

基础示例

示例 1：创建用户信息对象

Private Sub CreateUserInfo()
    With New VBMANLIB.cJson
        .Item("username") = "admin"
        .Item("password") = "123456"
        .Item("age") = 40
        .Item("name") = "邓伟"

        '格式化输出，显示中文
        Debug.Print .Encode(, 2, True)
    End With
End Sub

输出：

{
  "username": "admin",
  "password": "123456",
  "age": 40,
  "name": "邓伟"
}

示例 2：创建带数组的简单 JSON

Private Sub CreateWithArray()
    With New VBMANLIB.cJson
        .Item("code") = 200
        .Item("msg") = "操作成功"

        '创建普通值数组
        With .NewItems("hobbies")
            .Items(0) = "阅读"
            .Items(0) = "游泳"
            .Items(0) = "编程"
        End With

        Debug.Print .Encode(, 2, True)
    End With
End Sub

输出：

{
  "code": 200,
  "msg": "操作成功",
  "hobbies": ["阅读", "游泳", "编程"]
}

示例 3：解析并读取 JSON

Private Sub ParseAndRead()
    Dim JsonText As String
    JsonText = "{""servicesn"":""0001"",""userid"":""admin"",""token"":"""",""argcounts"":2}"

    With New VBMANLIB.cJson
        .Decode JsonText

        '使用 Root 读取各个字段（推荐方式）
        Debug.Print "Service SN: " & .Root("servicesn")
        Debug.Print "User ID: " & .Root("userid")
        Debug.Print "Token: " & .Root("token")
        Debug.Print "Arg Counts: " & .Root("argcounts")
    End With
End Sub

---

HTTP API 交互

示例 4：构造 POST 请求体

方式一：使用独立的 cJson 实例（推荐用于复杂结构）

Private Sub BuildPostBody()
    Dim Body As String

    '创建独立的 JSON 对象
    With New cJson
        .Item("sysStuffCode") = "TEST001"
        .Item("quantity") = 2

        '构造数组
        With .NewItems("detailList")
            Dim i As Long
            For i = 0 To 3
                With .NewItem()
                    .Item("test") = 123
                    .Item("time") = Now()
                End With
            Next
        End With

        Body = .Encode()
    End With

    '发送请求
    With New cHttpClient
        .RequestHeaders.Add "Content-Type", "application/json")
        .Fetch ReqPost, "https://api.example.com/submit", Body
        Debug.Print .ReturnText()
    End With
End Sub

方式二：使用 HttpClient 内置的 RequestDataJson 对象（简洁写法）

Private Sub BuildPostBodySimple()
    With VBMAN.HttpClient
        '使用内置 RequestDataJson 对象构造请求体
        With .RequestDataJson
            .Clear  '清空之前的数据
            .Item("sysStuffCode") = "TEST001"
            .Item("quantity") = 2

            With .NewItems("detailList")
                Dim i As Long
                For i = 0 To 3
                    With .NewItem()
                        .Item("test") = 123
                        .Item("time") = Now()
                    End With
                Next
            End With
        End With

        '设置请求类型并发送（ContentType=Json 时会自动使用 RequestDataJson）
        .SetRequestContentType JsonString
        .SendPost "https://api.example.com/submit"  'Body 参数可省略，自动使用 RequestDataJson

        Debug.Print .ReturnText()
    End With
End Sub

示例 5：处理 API 响应

Private Sub HandleApiResponse()
    Const API_BASE As String = "https://api.example.com"
    Const API_PULL_WAYBILL As String = API_BASE & "/api/pullWaybill"

    '构造请求数据
    Dim Body As String
    With New cJson
        .Item("wayBillId") = "46349936"
        .Item("clientId") = "CLIENT001"
        .Item("token") = "cbe84888-9f48-4c00-aae6-3170bf5951cd"
        Body = .Encode()
    End With

    '发送请求并处理响应
    On Error GoTo ErrorHandler

    With VBMAN.HttpClient
        .SetRequestContentType JsonString
        .SendPost API_PULL_WAYBILL, Body

        With .ReturnJson()
            '显示完整返回
            Text2.Text = .Encode(, 2, True)

            '判断业务状态
            If .Root("success") = True Then
                MsgBox "货物名称: " & .Root("data")("cargoName"), , "运单号: " & .Root("data")("wayBillId")
            Else
                MsgBox .Root("message"), , "请求失败"
            End If
        End With
    End With

    Exit Sub

ErrorHandler:
    Debug.Print VBMAN.HttpClient.DebugInfo.Encode(, 2, True)
End Sub

示例 6：使用查询参数获取数据

Private Sub FetchWithQuery()
    Const API_BASE As String = "https://api.example.com"
    Const API_SALE_PLAN As String = API_BASE & "/api/salePlan/selectByVehicleNo"

    On Error Resume Next

    '使用内置查询构造器（自动 URL 编码）
    VBMAN.HttpClient.RequestDataQuery.Add "vehicleNo", "鲁B70AP0"

    With VBMAN.HttpClient.Fetch(ReqGet, API_SALE_PLAN).ReturnJson()
        '显示格式化结果
        Text1.Text = .Encode(, 2, True)

        '判断返回状态（使用 Root 访问）
        If .Root("code") = 200 Then
            '循环遍历数组
            Dim x As Variant
            For Each x In .Root("data")
                List1.AddItem x("planCode")
                List1.AddItem x("warehouseName")
            Next

            '直接取指定数组对象（使用 Root 链式访问）
            With .Root("data")(1)
                List1.AddItem .Root("planCode")
                List1.AddItem .Root("warehouseName")
            End With
        Else
            MsgBox .Root("message")
        End If
    End With
End Sub

---

文件操作

示例 7：保存配置到 JSON 文件

Private Sub SaveConfig()
    With VBMAN.Json
        '清空之前的数据
        .Clear

        .Item("appName") = "MyApplication"
        .Item("version") = "1.0.0"
        .Item("debug") = True

        '嵌套配置对象
        With .NewItem("database")
            .Item("host") = "localhost"
            .Item("port") = 3306
            .Item("username") = "root"
            .Item("password") = "secret"
        End With

        '保存到文件
        .SaveTo App.Path & "\config.json", "UTF-8", 2, True
        MsgBox "配置已保存"
    End With
End Sub

示例 8：从 JSON 文件加载配置

Private Sub LoadConfig()
    Dim ConfigPath As String
    ConfigPath = App.Path & "\config.json"

    '检查文件是否存在
    If Dir(ConfigPath) = "" Then
        MsgBox "配置文件不存在"
        Exit Sub
    End If

    With New VBMANLIB.cJson
        .LoadFrom ConfigPath

        '读取配置
        Dim AppName As String
        Dim DbHost As String
        Dim DbPort As Long

        AppName = .Root("appName")
        DbHost = .Root("database")("host")
        DbPort = .Root("database")("port")

        MsgBox "应用: " & AppName & vbCrLf & _
               "数据库: " & DbHost & ":" & DbPort
    End With
End Sub

示例 9：从文件加载并修改

Private Sub ModifyJsonFile()
    Dim FilePath As String
    FilePath = "C:\tmp\data.json"

    With New VBMANLIB.cJson
        .LoadFrom FilePath

        '修改数据
        .Item("name") = "新名称"
        .Item("updated") = Now()

        '保存回文件
        .SaveTo FilePath, "UTF-8", 2, True
    End With
End Sub

---

复杂数据结构

示例 10：无限层级嵌套

Private Sub NestedStructure()
    With New VBMANLIB.cJson
        .Item("a") = 1
        .Item("b") = "dengwei"

        With .NewItems("c")
            Dim i As Long
            For i = 0 To 3
                With .NewItem()
                    .Item("d") = Now()
                    .Item("e") = 34 + i
                    .Item("f") = "数据: " & i

                    '创建更深的嵌套
                    With .NewItem("g")
                        .Item("g1") = 123
                        .Item("g2") = 456
                    End With

                    With .NewItems("h")
                        .Items(0) = "数组元素1"
                        .Items(0) = "数组元素2"
                    End With
                End With
            Next
        End With

        '保存并显示
        .SaveTo "C:\tmp\nested.json", , 2, True
        Text1.Text = .Encode(, 2, True)
    End With
End Sub

示例 11：混合数组（对象和普通值）

Private Sub MixedArray()
    With New VBMANLIB.cJson
        '对象数组
        With .NewItems("users")
            With .NewItem()
                .Item("name") = "张三"
                .Item("age") = 25
            End With
            With .NewItem()
                .Item("name") = "李四"
                .Item("age") = 30
            End With
        End With

        '普通值数组
        With .NewItems("tags")
            .Items(0) = "VIP"
            .Items(0) = "活跃"
            .Items(0) = "付费"
        End With

        Debug.Print .Encode(, 2, True)
    End With
End Sub

输出：

{
  "users": [
    { "name": "张三", "age": 25 },
    { "name": "李四", "age": 30 }
  ],
  "tags": ["VIP", "活跃", "付费"]
}

示例 12：解析复杂嵌套 JSON

Private Sub ParseComplexNested()
    '假设这是从 API 获取的复杂 JSON
    Dim JsonText As String
    JsonText = "{"
    JsonText = JsonText & """code"":200,"
    JsonText = JsonText & """data"":{"
    JsonText = JsonText & "  ""company"":""ABC公司"","
    JsonText = JsonText & "  ""departments"":[{"
    JsonText = JsonText & "    ""name"":""技术部"","
    JsonText = JsonText & "    ""employees"":[{""name"":""张三"",""position"":""工程师""}]"
    JsonText = JsonText & "  }]"
    JsonText = JsonText & "}"
    JsonText = JsonText & "}"

    With New VBMANLIB.cJson
        .Decode JsonText

        '使用 Root 进行深层链式访问
        Dim Company As String
        Dim DeptName As String
        Dim EmpName As String

        Company = .Root("data")("company")
        DeptName = .Root("data")("departments")(1)("name")
        EmpName = .Root("data")("departments")(1)("employees")(1)("name")

        MsgBox "公司: " & Company & vbCrLf & _
               "部门: " & DeptName & vbCrLf & _
               "员工: " & EmpName
    End With
End Sub

---

实际业务场景

示例 13：用户登录接口（HTTP 服务端）

'在业务类中（如 bHello.cls）
Public Sub Login(ctx As cHttpServerContext)
    Dim username As String: username = ctx.Request.Form("username")
    Dim password As String: password = ctx.Request.Form("password")

    With New cJson
        .Item("name") = "邓伟"
        .Item("age") = 40
        .Item("username") = username
        .Item("password") = password

        '返回格式化 JSON
        ctx.Response.Text .Encode(, 2, True)
    End With
End Sub

示例 14：SSE 数据推送

'在定时发送类中（如 bSendData.cls）
Private Sub SendTotalData()
    With New VBMANLIB.cJson
        '服务器时间
        With .NewItem()
            .Item("id") = "serverTime"
            .Item("value") = Format(Now(), "yyyy年MM月dd日 HH:mm:ss")
        End With

        '统计数据
        With .NewItem()
            .Item("id") = "today_count"
            .Item("value") = GetTodayCount()
        End With

        With .NewItem()
            .Item("id") = "yesterday_count"
            .Item("value") = GetYesterdayCount()
        End With

        '发送给前端
        Form1.HttpServer.SSE.SendPack "total", .Encode()
    End With
End Sub

示例 15：数据库记录转 JSON

方法1：使用 RsToCollection 函数（推荐）

vbman 提供了全局函数 VBMAN.ToolsList.RsToCollection，可直接将 Recordset 转为集合，配合 cJson 使用更简便：

Private Sub RecordsToJsonEasy()
    Dim Rs As ADODB.Recordset
    Set Rs = GetRecords() '获取数据库记录集

    With New VBMANLIB.cJson
        .Item("code") = 200
        .Item("total") = Rs.RecordCount
        '直接赋值转换后的集合
        .Item("data") = VBMAN.ToolsList.RsToCollection(Rs)

        ctx.Response.Text .Encode(, 2, True)
    End With
End Sub

方法2：手动遍历构建（了解原理）

Private Sub RecordsToJson()
    Dim Rs As ADODB.Recordset
    Set Rs = GetRecords() '获取数据库记录集

    With New VBMANLIB.cJson
        .Item("code") = 200
        .Item("total") = Rs.RecordCount

        With .NewItems("data")
            Do While Not Rs.EOF
                With .NewItem()
                    .Item("id") = Rs("id")
                    .Item("name") = Rs("name")
                    .Item("created") = Rs("created_at")
                End With
                Rs.MoveNext
            Loop
        End With

        '输出或保存
        ctx.Response.Text .Encode(, 2, True)
    End With
End Sub

提示：RsToCollection 函数可通过 VBMAN.ToolsList.RsToCollection 全局调用，会自动处理分页和字段映射，是处理数据库记录转 JSON 的最佳实践。

示例 16：批量任务数据结构

Private Function MakeTaskData() As String
    With New cJson
        '根是数组，需要先 NewItem
        With .NewItem()
            .Item("uuid") = GenerateUUID()
            .Item("task_no") = "TASK001"
            .Item("task_type") = 1
            .Item("factory_code") = "0206"
            .Item("warehouse_code") = "0601"

            '明细数组
            With .NewItems("detail")
                With .NewItem()
                    .Item("row_no") = 1
                    .Item("part_no") = "PART001"
                    .Item("qty") = 45.5
                End With
                With .NewItem()
                    .Item("row_no") = 2
                    .Item("part_no") = "PART002"
                    .Item("qty") = 30.0
                End With
            End With
        End With

        MakeTaskData = .Encode(.Root, 2)
    End With
End Function

示例 17：动态构建报表数据

Private Sub BuildReportData()
    With New VBMANLIB.cJson
        .Item("ReportTime") = Format(Date, "yyyy-mm-dd")
        .Item("SampleModel") = "样品型号123"
        .Item("ProductModel") = "产品型号ABC"

        Dim i As Long
        For i = 1 To 10
            With .NewItem("record" & i)
                .Item("TestNum") = "TEST" & i
                .Item("T1") = RandValue()
                .Item("T2") = RandValue()
                .Item("Result") = IIf(i Mod 2 = 0, "PASS", "FAIL")
            End With
        Next

        '保存报表
        .SaveTo App.Path & "\Reports"" & Format(Now(), "yyyymmdd") & ".json", , 2, True
    End With
End Sub

示例 18：使用全局实例缓存数据

Private Sub UseGlobalInstance()
    '使用全局 VBMAN.Json 实例缓存配置
    With VBMAN.Json
        .Clear '先清理

        .Item("api_url") = "https://api.example.com"
        .Item("timeout") = 30
        .Item("retry") = 3

        '在其他地方可以直接使用（Root 是默认成员）
        'MsgBox VBMAN.Json.Root("api_url")
        '或简写为：
        'MsgBox VBMAN.Json("api_url")
    End With
End Sub

---

调试技巧

示例 19：格式化输出调试

Private Sub DebugJson()
    With New VBMANLIB.cJson
        '构建复杂数据...
        .Item("data") = "一些数据"

        '输出到立即窗口（格式化）
        Debug.Print .Encode(, 2, True)

        '输出到文本框
        Text1.Text = .Encode(, 2, True)

        '紧凑格式（用于传输）
        Debug.Print .Encode()
    End With
End Sub

示例 20：错误处理模式

Private Sub SafeParse()
    On Error GoTo ErrorHandler

    Dim Json As New cJson
    Json.Decode Text1.Text

    If Not Json.LastSuccess Then
        MsgBox "JSON 解析失败: " & Json.LastError
        Exit Sub
    End If

    '安全访问数据
    If Json.RootItem.Exists("name") Then
        MsgBox "Name: " & Json.Item("name")
    Else
        MsgBox "name 字段不存在"
    End If

    Exit Sub

ErrorHandler:
    MsgBox "发生错误: " & Err.Number & " - " & Err.Description
End Sub