这是一个客户的内部系统webapi对接需求，我搭建了mock模拟数据服务器做演示，已对数据进行脱敏处理，现分析该案例源码
源码在文章底部
源码
cApiTransport.cls
'这里是接口的封装类，目前只做了2个接口作为示例，实际接口有6个左右
'接口列表
Const API_LOGIN As String = "/v1/webapi/transport/auth/token"
Const API_NOTIFY_LIST As String = "/v1/webapi/transport/notification/list"
Const API_NOTIFY_UPDATE_STATUS As String = "/v1/webapi/transport/notification/updateStatusById"
'接口返回代码
Public Enum EnumApiResCode
Success = 200
ServerError = 500
NotAuth = 401
NotPerm = 403
BadRequest = 400
End Enum
'解密对象实例
Dim Aes As New cAes
Dim HttpClient As New cHttpClient
Public ApiServer As String
Public Aeskey As String
'缓存用户名和密码，用于token过期后自动更新，因为该接口没有提供 refreshToken
Private Type TypeApiAuth
HasAuth As Boolean
Username As String
Password As String '加密后的密码
Token As String
ExpiresIn As Date
End Type
Private ApiAuth As TypeApiAuth
Public Enum EnumNotifyStatus
初始 = 0
生效 = 10
执行中 = 20
申请完成 = 30
完成 = 40
作废 = 90
End Enum
Public NotifyStatus As EnumNotifyStatus
'接口：登录授权
'参数：
' Username 用户账号
' Password 用户密码
' IsAesEncode 【可选】是否aes加密后的密码 默认 false
'返回：cJson 对象
Public Function Login(Username As String, ByVal Password As String, Optional IsAesEncode As Boolean) As cJson
'如果使用明文密码，需要先进行 aes 加密
If IsAesEncode = False Then
Password = Aes.Encode(Aeskey, Password)
End If
'构造请求体
With New cJson
.Item("systemId") = Username
.Item("password") = Password
Set Login = HttpRequest(ReqPost, API_LOGIN, .Encode())
'如果登录成功，需要缓存 token
With Login
If .Item("code") = EnumApiResCode.Success Then
'过期时长为毫秒，注意转换为秒，并减少60秒，提前更新
Dim Span As Long: Span = .Item("data")("expiresIn")
ApiAuth.Username = Username
ApiAuth.Password = Password
ApiAuth.Token = .Item("data")("token")
ApiAuth.ExpiresIn = DateAdd("s", (Span / 1000 - 60), Now())
ApiAuth.HasAuth = True
End If
End With
End With
End Function
'接口：获取通知列表
'参数：【可选】IsFullSync 是否全量同步 默认 false
'返回：cJson 对象
Public Function NotifyList(Optional IsFullSync As Boolean) As cJson
'构造请求体
'syncType （string） 0：全量:1：增量
With New cJson
.Item("syncType") = IIf(IsFullSync, "0", "1")
Set NotifyList = HttpRequest(ReqPost, API_NOTIFY_LIST, .Encode())
End With
End Function
'接口：根据ID更新通知状态
'参数：
' Code 拉运通知单号(业务唯一主键)
' Total 实际完成总数(单位：吨)
' Status 状态：00-初始 、10-生效（生效后给到运销）、20-执行中、30-申请完成、40完成（含部分完成）、90-作废
'返回：cJson 对象
Public Function NotifyStatusUpdate(Code As String, Total As Long, Status As EnumNotifyStatus) As cJson
'构造请求体
With New cJson
.Item("shippingNoticeCode") = Code
.Item("actualCompletionTotal") = CStr(Total)
.Item("status") = Format$(Status, "00")
Set NotifyStatusUpdate = HttpRequest(ReqPost, API_NOTIFY_UPDATE_STATUS, AesEncodePack(.Encode()))
End With
End Function
'----------更多接口请自行参考前面2个函数扩展
'----------------------------------------------------------------------------------------------------------------------
'公用请求函数，每个接口都使用这个统一的请求和返回函数，减少冗余，确保接口函数是最轻量的，。
'返回值结构:
'{
' "code": "500",
' "data": {},
' "msg": "查询失败: 未获取到系统Id"
'}
'如果 code 为 0 表示需要解密 data 值，200 表示成功，其他为失败
Private Function HttpRequest( _
Method As VBMANLIB.EnumRequestMethod, _
Path As String, _
Data As String) As cJson
If App.LogMode <> 0 Then On Error GoTo eee
With HttpClient
'设置请求头：授权token值
.RequestHeaders("Authorization") = GetToken()
'IDE下开启调试
If App.LogMode = 0 Then .DebugStart = True
'发起请求并获取结果
.Fetch Method, ApiServer & Path, Data
'返回Json对象
Set HttpRequest = .ReturnJson()
With HttpRequest
If .Item("code") = 0 Then '如果是 0 就解密
Dim Miwen As String: Miwen = .Item("data")
Dim Mingwen As String: Mingwen = Aes.Decode(Aeskey, Miwen)
Dim Dat As New cJson '转为json对象
'此处转换 code 为 200，外部仅需要判断 200 就知道成功
.Item("code") = EnumApiResCode.Success
Set .Item("data") = Dat.Decode(Mingwen)
End If
End With
'IDE下显示调试信息，查看：立即窗口
If App.LogMode = 0 Then Debug.Print .DebugInfo.Encode(, 2, True)
End With
Exit Function
eee:
Set HttpRequest = New cJson
HttpRequest.Item("code") = Err.Number
HttpRequest.Item("msg") = Err.Description
End Function
'打包加密请求体，有些请求的内容需要加密的，就用的这个加密函数，
Private Function AesEncodePack(Data As String) As String
With New cJson
.Item("data") = Aes.Encode(Aeskey, Data)
AesEncodePack = .Encode()
End With
End Function
'获取 token 值，如果过期则自动更新
Private Function GetToken() As String
'判断是否已经缓存，避免循环调用
If ApiAuth.HasAuth = False Then Exit Function
If ApiAuth.ExpiresIn > Now() Then
GetToken = ApiAuth.Token
Exit Function
End If
'自动更新
With Login(ApiAuth.Username, ApiAuth.Password, True)
If .Item("code") <> EnumApiResCode.Success Then
Err.Raise .Item("code"), "GetToken", .Item("msg")
End If
End With
End Function
Form1.frm
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 7830
ClientLeft = 45
ClientTop = 390
ClientWidth = 12015
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 7830
ScaleWidth = 12015
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command2
Caption = "接口2：更新状态"
Height = 495
Left = 2400
TabIndex = 3
Top = 240
Width = 2175
End
Begin VB.CommandButton Command1
Caption = "接口1：获取列表"
Height = 495
Left = 240
TabIndex = 2
Top = 240
Width = 2175
End
Begin VB.ListBox List2
Height = 4740
Left = 240
TabIndex = 1
Top = 2640
Width = 11535
End
Begin VB.ListBox List1
Height = 1860
Left = 240
TabIndex = 0
Top = 840
Width = 11535
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'接口服务器地址
Const API_SERVER As String = "https://mock.vb6.pro/m1/6567931-6272257-default"
'Const API_SERVER As String = "https://mip-test.cloud.chinacoal.com"
'接口实例
Dim ApiInst As New cApiTransport
Private Sub Form_Load()
Me.Show
'先登录
VBMAN.Layer.msg "正在登录..."
With ApiInst
'配置接口方提供的aes加解密Key
.Aeskey = "73qFpsvbjJuAZ7kEEyzNUOstoUOJ5XrJM7jB01okRlU="
.ApiServer = API_SERVER
With .Login("dengwei", "123456")
If .Item("code") = EnumApiResCode.Success Then
VBMAN.Layer.msg "登录成功"
Else
MsgBox .Item("msg")
End If
End With
End With
End Sub
Private Sub Command1_Click()
'显示一个提示框，参数2 为 0 秒代表不会消失
VBMAN.Layer.msg "正在请求..."
With ApiInst.NotifyList(True)
If .Item("code") = EnumApiResCode.Success Then
List1.Clear
List2.Clear
'以下演示2种使用方式，从 data 字段的数组遍历显示内容到 listbox
Dim x As Variant, k As Variant, i As Long
For Each x In .Item("data").Root
'循环计数器
i = i + 1
'方式1，显示指定字段到 list1
List1.AddItem Join(Array( _
x("shippingNoticeCode"), _
x("coalTypeName"), _
x("settleCustomerName"), _
x("shippingDeadlineStarttime"), _
x("shippingDeadlineEndtime") _
), vbTab)
'方式2，遍历每个数组的成员字段到 list2
For Each k In x.Keys()
List2.AddItem "第 " & i & " 行的字段：" & k & " => " & x(k)
Next
Next
'默认3秒消失
VBMAN.Layer.msg "操作成功"
Else
MsgBox .Item("msg")
End If
End With
End Sub
'根据ID更新通知状态
Private Sub Command2_Click()
'显示一个提示框，参数2 为 0 秒代表不会消失
VBMAN.Layer.msg "正在请求..."
With ApiInst.NotifyStatusUpdate("HT20240828-XS00001", 100, 申请完成)
If .Item("code") = EnumApiResCode.Success Then
'默认3秒消失
VBMAN.Layer.msg "操作成功"
Else
MsgBox .Item("msg")
End If
End With
End Sub
封装类模块
业务调用
使用效果
