创作
源码分享网络编程

vb6网络webapi读写（POST和GET）DemoByVI

邓伟vb6网络webapi读写（POST和GET）DemoByVI有 1 条评论

一个简单的例子，实现对接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

下载：

vb6网络api读写DemoByVI-v1.6.zip下载

Views: 131

Hi, I’m 邓伟

本来无一物，何处惹尘埃

近期文章

首评

发表回复