一个简单的例子,实现对接webapi服务器的读写
VERSION 5.00
Begin VB.Form Form1
Caption = "本实例演示了一个用户登录的 WEBAPI 请求和返回过程"
ClientHeight = 7080
ClientLeft = 120
ClientTop = 465
ClientWidth = 9585
LinkTopic = "Form1"
ScaleHeight = 7080
ScaleWidth = 9585
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox Text4
Height = 375
Left = 240
TabIndex = 9
Text = "http://a-vi.com"
Top = 1560
Width = 9015
End
Begin VB.CommandButton Command4
Caption = "大数据量 JSON 解析"
Height = 375
Left = 5040
TabIndex = 8
Top = 720
Width = 2535
End
Begin VB.CommandButton Command3
Caption = "GET 示例"
Height = 375
Left = 7680
TabIndex = 7
Top = 720
Width = 1455
End
Begin VB.CommandButton Command2
Caption = "POST 示例"
Height = 375
Left = 7680
TabIndex = 6
Top = 240
Width = 1455
End
Begin VB.TextBox Text3
Height = 375
Left = 1200
TabIndex = 4
Text = "123456"
Top = 720
Width = 1695
End
Begin VB.TextBox Text2
Height = 375
Left = 1200
TabIndex = 2
Text = "dengwei"
Top = 240
Width = 1695
End
Begin VB.CommandButton Command1
Caption = "登录"
Height = 855
Left = 3000
TabIndex = 1
Top = 240
Width = 1215
End
Begin VB.TextBox Text1
Height = 4815
Left = 240
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Text = "Form1.frx":0000
Top = 2040
Width = 9015
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "接口地址:"
Height = 180
Left = 240
TabIndex = 10
Top = 1200
Width = 900
End
Begin VB.Label Label2
Caption = "密码:"
Height = 375
Left = 240
TabIndex = 5
Top = 720
Width = 975
End
Begin VB.Label Label1
Caption = "用户名:"
Height = 375
Left = 240
TabIndex = 3
Top = 240
Width = 975
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'定义api接口的主路径,即域名或者IP部分,这是所有接口公用的。
Dim ApiHost As String
'实例化webapi请求对象
Dim AjaxInst As New cAjax
Dim JsonInst As New cJson
Private Sub Logs(Optional ByVal S$, Optional isNew As Boolean)
If isNew Then Text1.Text = ""
Text1.Text = Text1.Text & vbCrLf & S
End Sub
'本过程演示了一个解析json对象的另外一种方法
'对于大文本值的json解析,此方法比下面几个函数的解析方法速度快很多
Private Sub Command4_Click()
'首先不需要自动解析json,可以让返回内容为文本
AjaxInst.repType = ResponseText
'需要构造 body
AjaxInst.postBody.Add "bjh", "068919"
' 接下来提交参数到获取信息接口,"/home/info",
If AjaxInst.PostData(ApiHost & "/home/info") = False Then
' 判断请求是否成功,不成功则这里处理,这里演示获取最后一个错误信息
Text1.Text = AjaxInst.LastErr
Exit Sub
End If
' 请求成功
Logs "以下为返回的原始内容:", True
Logs
Logs AjaxInst.res
Logs
'开始获取 code 值
Logs "其中 code 值为:" & JsonInst.jsDecode("code", AjaxInst.res)
Logs
'开始获取 msg 值
Logs "其中 msg 值为:" & JsonInst.jsDecode("msg", AjaxInst.res)
Logs
'开始获取 data 里面的子对象 zzno 值
Logs "其中 data 的子对象 zzno 值为:" & JsonInst.jsDecode("data.zzno", AjaxInst.res)
End Sub
Private Sub Command3_Click()
'设置自动解析json,可以让返回内容自动解析json到 resJson 变量
'注意该参数为全局参数,所以如果是一个工程里面有不同的地方设置该变量,就应该独立设置
AjaxInst.repType = ResponseJson
'厂家把 get 方法的参数也写到 body 了,所以需要构造 body
AjaxInst.postBody.Add "bjh", "068919"
' 接下来提交参数到获取信息接口,"/home/info",
If AjaxInst.GetData(ApiHost & "/home/info") = False Then
' 判断请求是否成功,不成功则这里处理,这里演示获取最后一个错误信息
Text1.Text = AjaxInst.LastErr
Exit Sub
End If
' 请求成功,开始处理返回值
Text1.Text = Join(Array( _
"返回 code 为:" & AjaxInst.resJson("code"), _
"返回 msg 为:" & AjaxInst.resJson("msg"), _
"返回 data 为:" & JsonInst.Encode(AjaxInst.resJson("data")), _
vbCrLf & vbCrLf & _
"以下为返回的原始内容:" & vbCrLf, _
AjaxInst.res _
), vbCrLf)
'判断某个节点是否存在的示例:
If AjaxInst.resJson.Exists("data") = True Then
If AjaxInst.resJson("data").Exists("zzno") = True Then
MsgBox "zzno: " & AjaxInst.resJson("data")("zzno")
End If
End If
End Sub
Private Sub Form_Load()
ApiHost = Trim(Text4.Text)
AjaxInst.postContentType = json
End Sub
Private Sub Form_Unload(Cancel As Integer)
'这里加了个取消,可以防止无网络了卡死问题
AjaxInst.Cancel
End Sub
Private Sub Command1_Click()
'设置自动解析json,可以让返回内容自动解析json到 resJson 变量
'注意该参数为全局参数,所以如果是一个工程里面有不同的地方设置该变量,就应该独立设置
AjaxInst.repType = ResponseJson
' 先构造 post 请求的数据,随便修改账号密码会返回失败的值
AjaxInst.postBody.Add "time", Now()
AjaxInst.postBody.Add "username", Trim(Text2.Text)
AjaxInst.postBody.Add "password", Trim(Text3.Text)
AjaxInst.SetResHeader "my-header", "dengwei"
' 以上添加了用户名和密码字段,接下来提交到登录接口,"/home/login",和接口主路径拼接就是完整接口地址。
If AjaxInst.PostData(ApiHost & "/home/login") = False Then
' 判断请求是否成功,不成功则这里处理,这里演示获取最后一个错误信息
Text1.Text = AjaxInst.LastErr
Exit Sub
End If
' 请求成功,开始处理返回值
Text1.Text = Join(Array( _
"返回 code 为:" & AjaxInst.resJson("code"), _
"返回 msg 为:" & AjaxInst.resJson("msg"), _
"返回 data 为:" & JsonInst.Encode(AjaxInst.resJson("data")), _
vbCrLf & vbCrLf & _
"以下为返回的原始内容:" & vbCrLf, _
AjaxInst.res _
), vbCrLf)
End Sub
Private Sub Command2_Click()
'设置自动解析json,可以让返回内容自动解析json到 resJson 变量
'注意该参数为全局参数,所以如果是一个工程里面有不同的地方设置该变量,就应该独立设置
AjaxInst.repType = ResponseJson
' 这里演示了如何构造JSON字符串并post到接口
Dim data As New Scripting.Dictionary
' 定义好一个json对象然后开始添加第一级的数据
data.Add "bjh", "12313"
data.Add "zmc", 2500
data.Add "kzjz", 210.1
data.Add "kzzdz", 211.1
data.Add "kzzxz", 209.2
' 子级开始
data.Add "bmkzjz", JsonInst.NewJsonSun(JsonArray)
data.Add "yckz", JsonInst.NewJsonSun(JsonArray)
'开始构造第二级,因为是数组,这里使用for循环个演示数据
Dim i&
Dim Dat2 As Scripting.Dictionary
For i = 0 To 1
Randomize
'构造子级对象
Set Dat2 = JsonInst.NewJsonSun(JsonObject)
Dat2.Add "mc", 100 * (i + 1)
Dat2.Add "kzjz", Rnd(99)
'塞入父级数组
Call JsonInst.pushDic(Dat2, data, "bmkzjz")
Next
For i = 0 To 1
Randomize
'构造子级对象
Set Dat2 = JsonInst.NewJsonSun(JsonObject)
Dat2.Add "mc", 100 * (i + 1)
Dat2.Add "kzjz", Rnd(99)
'塞入父级数组
Call JsonInst.pushDic(Dat2, data, "yckz")
Next
'开始生成json字符串
Dim postBody$: postBody = JsonInst.Encode(data)
'请求到后端地址
If AjaxInst.PostData(ApiHost & "/home/save", postBody) = False Then
' 判断请求是否成功,不成功则这里处理,这里演示获取最后一个错误信息
Text1.Text = AjaxInst.LastErr
Exit Sub
End If
' 请求成功,开始处理返回值
Text1.Text = Join(Array( _
"以下为请求接口的原始POST内容:" & vbCrLf & postBody, _
vbCrLf & vbCrLf & _
"返回 code 为:" & AjaxInst.resJson("code"), _
"返回 msg 为:" & AjaxInst.resJson("msg"), _
"返回 data 为:" & JsonInst.Encode(AjaxInst.resJson("data")), _
vbCrLf & vbCrLf & _
"以下为返回的原始内容:" & vbCrLf, _
AjaxInst.res _
), vbCrLf)
End Sub
Private Sub Text4_Change()
ApiHost = Trim(Text4.Text)
End Sub
下载:
这里再加一个更容易理解的例子,,(,因为上面的示例,群友们说不好理解)
Dim json As New cJson
'构造 jsn1 和 jsn2
Dim jsn1 As New Scripting.Dictionary
jsn1("姓名") = "张三"
jsn1("年龄") = 25
Dim jsn2 As New Scripting.Dictionary
jsn2("姓名") = "张三"
jsn2("年龄") = 26
'放入到一个数组
Dim objArr(): objArr = Array(jsn1, jsn2)
'最后放入一个根对象
Dim cJsn As New Scripting.Dictionary
cJsn("新对象键名") = objArr
'把对象转为字符串显示
Debug.Print json.Encode(cJsn)
Views: 255
备忘:cajax 类对象应该内置 urlencode 函数并自动处理