[浏览完整版]
标题：扫码带参数如何做
41楼
xuzihang 发表于：2024/6/17 21:07:00第一个 弹出 http://www.abc.com/indexhtm?tjr=xxxx
第二个 弹出 http://www.abc.com/?code=058.....state=123
第三个 弹出 http://www.abc.com
进入系统里
还是没有保存数据
42楼
有点蓝 发表于：2024/6/17 21:50:00那是网页授权取消了自定义参数，改为这样
……
dr = DataTables("客户").AddNew()
msgbox("增行后", 64, "提示")
Dim nms() As String = {"openid", "nickname", "headimgurl", "性别"} '"", "客户住址_县市", "country", "客户住址_省市"} '""
For Each nm As String In nms
dr(nm) = jo(nm)
msgbox("提取数据", 64, "提示")
Next
If e.GetValues.ContainsKey("state") Then
msgbox("写入推荐人: " & e.GetValues("state"), 64, "提示")
dr("客户来源_KHID") = e.GetValues("state")
msgbox("保存", 64, "提示")
dr.Save
End If
End If
……
Else
UserName = e.Cookies("username") '从cookie获取用户名和openid
OpenID = e.Cookies("openid")
Dim dr As DataRow = DataTables("客户").SQLFind("openid ='" & Openid & "'") '根据openid找出对应的行
If (dr Is Nothing OrElse UserName = "" OrElse OpenId = "") andalso e.GetValues.ContainsKey("tjr") Then '空
Dim url As String = e.Request.URL.ToString
Dim ul As String = "https://open.weixin.qq.com/connect/oauth2/authorize?appid=wx................&redirect_uri=" & UrlEncode(url) & "&response_type=code&scope=snsapi_userinfo&state=" & UrlEncode(e.GetValues("tjr")) & "#wechat_redirect"
sb.Append("<meta http-equiv='Refresh' c>") '跳转到授权链接
e.WriteString(sb.ToString)
Return
End If
End If
43楼
xuzihang 发表于：2024/6/18 8:05:00 根据老师改的，
第一个 弹出 http://www.abc.com/indexhtm?tjr=xxxx 第二个 弹出 http://www.abc.com/?code=058.....state= 还是没有保存数据 |
进不去系统里，手机端显示 系统繁忙稍后访问系统
是不是这个有问题了 If (dr Is Nothing OrElse UserName = "" OrElse OpenID = "") andalso e.GetValues.ContainsKey("tjr") Then '空
dr = DataTables("客户").AddNew()
msgbox("增行后", 64, "提示")
Dim nms() As String = {"openid", "nickname", "headimgurl", "性别"} '"", "客户住址_县市", "country", "客户住址_省市"} '""
For Each nm As String In nms
dr(nm) = jo(nm)
msgbox("提取数据", 64, "提示")
Next
If e.GetValues.ContainsKey("state") Then
msgbox("写入推荐人: " & e.GetValues("state"), 64, "提示")
dr("客户来源_KHID") = e.GetValues("state")
msgbox("保存", 64, "提示")
dr.Save
End If
End If
……
OpenID = e.Cookies("openid")
Dim dr As DataRow = DataTables("雇主").SQLFind("openid ='" & Openid & "'") '根据openid找出对应的行
MsgBox("dr = " & （dr Is Nothing）) '-----------------------------------------------------------------------------
If (dr Is Nothing OrElse UserName = "" OrElse OpenID = "") andalso e.GetValues.ContainsKey("tjr") Then '空
Dim url As String = e.Request.URL.ToString
' MsgBox(url) '--------------------------------------------------------------------------------------------
' msgbox("判断名 openid 行 空", 64, "提示")
Dim ul As String = "https://open.weixin.qq.com/connect/oauth2/authorize?appid=w.................&redirect_uri=http%3a%2f%2fwww.123.com&response_type=code&scope=snsapi_userinfo&state=" & UrlEncode(e.GetValues("tjr")) & "#wechat_redirect"
MsgBox(url) '--------------------------------------------------------------------------------------------
sb.Append("<meta http-equiv='Refresh' c>") '跳转到授权链接
e.WriteString(sb.ToString)
' msgbox("跳转授权链接", 64, "提示")
Return
End If
End If
[此贴子已经被作者于2024/6/18 8:08:05编辑过]
44楼
有点蓝 发表于：2024/6/18 8:14:00系统繁忙的原因看34楼。
这样调试看看
OpenID = e.Cookies("openid")
Dim dr As DataRow = DataTables("雇主").SQLFind("openid ='" & Openid & "'") '根据openid找出对应的行
MsgBox("tjr= " & （e.GetValues.ContainsKey("tjr")）) '-----------------------------------------------------------------------------
If (dr Is Nothing OrElse UserName = "" OrElse OpenID = "") andalso e.GetValues.ContainsKey("tjr") Then '空
Dim url As String = e.Request.URL.ToString
' MsgBox(url) '--------------------------------------------------------------------------------------------
' msgbox("判断名 openid 行 空", 64, "提示")
Dim ul As String = "https://open.weixin.qq.com/connect/oauth2/authorize?appid=w.................&redirect_uri=http%3a%2f%2fwww.123.com&response_type=code&scope=snsapi_userinfo&state=" & UrlEncode(e.GetValues("tjr")) & "#wechat_redirect"
MsgBox(ul ) '--------------------------------------------------------------------------------------------
sb.Append("<meta http-equiv='Refresh' c>") '跳转到授权链接
e.WriteString(sb.ToString)
' msgbox("跳转授权链接", 64, "提示")
Return
End If
End If
45楼
xuzihang 发表于：2024/6/18 8:45:00
手机显示 sb.AppendLine("系统繁忙稍后访问本系统") 的
[此贴子已经被作者于2024/6/18 9:30:02编辑过]
46楼
有点蓝 发表于：2024/6/18 8:53:00把完整代码放到记事本，重新发上来看看
47楼
xuzihang 发表于：2024/6/18 9:31:00内容上传
[此贴子已经被作者于2024/6/18 9:33:09编辑过]
48楼
xuzihang 发表于：2024/6/18 10:21:00 Dim sb As New StringBuilder '公众号授权详情页
sb.AppendLine("<meta name='viewport' c>")
If e.host = "www.123.com.cn" Then '授权测试
Dim UserName As String
Dim OpenID As String
Dim KHID As String
If e.GetValues.ContainsKey("code") Then '如果是通过授权链接跳转而来,就从链接重提取code来获取openid
MsgBox(e.Request.URL.ToString) '--------------------
Dim ul As String = "https://api.weixin.qq.com/sns/oauth2/access_token?appid={0}&secret={1}&code={2}&grant_type=authorization_code"
ul = CExp(ul, "wx88888888888888", "fuhgfdjknnbh58546588855", e.GetValues("code"))
Dim hc As New HttpClient(ul)
Dim jo As JObject = JObject.Parse(hc.GetData)
If jo("openid") IsNot Nothing Then '如果获取openid成功(成功的话,还会同时返回一个accesstiken,用于获取用户详情)
OpenID = jo("openid")
' msgbox("获取openid", 64, "提示")
Dim dr As DataRow = DataTables("客户").SQLFind("openid ='" & Openid & "'")
If dr IsNot Nothing Then
UserName = dr("nickname")
' msgbox("昵称", 64, "提示")
Else
ul = "https://api.weixin.qq.com/sns/userinfo?access_token={0}&openid={1}&lang=zh_CN "
'根据openid和accesstoken获取用户详情,注意这里这个accesstoken不是普通accesston,只能用于网页授权
hc = New HttpClient(CExp(ul, jo("access_token"), OpenId))
jo = jo.Parse(hc.GetData)
If jo("openid") IsNot Nothing Then
UserName = jo("nickname")
dr = DataTables("客户").AddNew()
Dim nms() As String = {"openid", "nickname", "headimgurl", "性别"} '"", "客户住址_县市", "country", "客户住址_省市"} '""
For Each nm As String In nms
dr(nm) = jo(nm)
' msgbox("提取数据", 64, "提示")
Next
' msgbox("判断tjr", 64, "提示")
If e.GetValues.ContainsKey("state") Then 'e.GetValues.ContainsKey("tjr")获取二维码推荐人的TJkhid
msgbox("写入推荐人: " & e.GetValues("state"), 64, "提示")
dr("客户来源_KHID") = e.GetValues("state") 'e.GetValues.ContainsKey("TJkhid")获取二维码推荐人的TJkhid ，保存tjkhid
msgbox("保存", 64, "提示")
End If
dr.Save
Else
e.WriteString(jo.ToString) '在用户浏览器显示错误信息
' msgbox("不能增行token里openid空", 64, "提示空")
Return
End If
End If
e.AppendCookie("username", UserName) '用户名和openid存储在Cookie中
e.AppendCookie("openid", OpenID)
' e.AppendCookie("KHID", KHID)
' MsgBox("OpenID=" & OpenID & ",UserName=" & UserName) '----------------------------
Else
e.WriteString(jo.ToString) '在用户浏览器显示错误信息
' msgbox("openid空的", 64, "提示")
Return
End If
Else
UserName = e.Cookies("username") '从cookie获取用户名和openid
OpenID = e.Cookies("openid")
' KHID = e.Cookies("KHID")
Dim dr As DataRow = DataTables("客户").SQLFind("openid ='" & Openid & "'") '根据openid找出对应的行
MsgBox("tjr= " & （e.GetValues.ContainsKey("tjr")）)
MsgBox("dr = " & （dr Is Nothing）) '-------------------------------------------------------------
If (dr Is Nothing OrElse UserName = "" OrElse OpenID = "") AndAlso e.GetValues.ContainsKey("tjr") Then '空
Dim url As String = e.Request.URL.ToString
' MsgBox(url) '------------------------------------------------------------------
' msgbox("判断名 openid 行 空", 64, "提示")
' If userName = "" OrElse OpenID = "" Then
Dim ul As String = "https://open.weixin.qq.com/connect/oauth2/authorize?appid=wx88888888888888&redirect_uri=http%3a%2f%2fwww.123.com.cn&response_type=code&scope=snsapi_userinfo&state=" & UrlEncode(e.GetValues("tjr")) & "#wechat_redirect"
MsgBox(url) '--------------------------------------------------------------------------------------------
MsgBox(ul) '--------------------------------------------------------------------------------------------
sb.Append("<meta http-equiv='Refresh' c>") '跳转到授权链接
e.WriteString(sb.ToString)
' msgbox("跳转授权链接", 64, "提示")
Return
End If
End If
' msgbox("授权成功", 64, "提示")
49楼
xuzihang 发表于：2024/6/18 10:22:00 Dim Verified As Boolean
Dim dr1 As DataRow = DataTables("客户").SQLFind("openid ='" & Openid & "'") '根据openid找出对应的行
If OpenId > "" AndAlso dr1 IsNot Nothing AndAlso dr1("permit") = False Then'授权成功
' msgbox("openid>0", 64, "提示")
Verified = True
'这里可以做进一步的权限判断
sb.AppendLine("欢迎" & UserName & "光临！,用心服务好每一天。 <a href='default.htm'>刷新页面</a>")
'开始生成网页 '导航头
Dim wb As New WeUI
wb.title = " 111"
Select Case e.Path
Case "" , "sy.htm" '首页 '首页这样 Case "", "default.htm"
If dr1.IsNull("客户名") AndAlso dr1.IsNull("电话") AndAlso dr1.IsNull("客户住址_蓝牌地址") Then
e.WriteString("<meta http-equiv='Refresh' c>") '那么直接跳转到客户资料页面
Else
e.WriteString("<meta http-equiv='Refresh' c>") '那么直接跳转到首页页面
Return '必须的
End If
Case "kehu.htm" '客户资料
If e.PostValues.Count = 0 Then
wb.InsertHTML("<h3 align='center' style='margin-top:5px'>完善信息 乐享会员服务</h3>")
wb.AddForm("", "form1", "kehu.htm")
' If OpenId > "" Then
If dr1.IsNull("客户名") AndAlso dr1.IsNull("电话") AndAlso dr1.IsNull("客户住址_蓝牌地址") Then
With wb.AddInputGroup("form1", "ipg1", "用户资料")
' If e.GetValues.ContainsKey("tjr") Then
' ' .AddHiddenValue(e.GetValues("tjr"), "客户来源_KHID")
' dr1("客户来源_KHID") = e.GetValues("tjr")
' End If
.AddInput("客户名", "姓名", "Text") '前一个"姓名"是ID,后一个"姓名"是标题
.AddInput("电话", "电话", "number")
.AddInput("客户住址_蓝牌地址", "地址", "Text")
.AddInput("身份证号码", "身份号码", "number")
.AddSelect("性别", "性别", "女|男")
.AddInput("邮箱", "邮箱", "Text").Placeholder = "选填，接收消费信息用"
End With
With wb.AddButtonGroup("form1", "btg2", True)
.Add("btn3", "提交基础资料", "submit")
End With
e.WriteString(wb.Build)
Else If dr1("客户名")IsNot Nothing AndAlso dr1("电话")IsNot Nothing AndAlso dr1("客户住址_蓝牌地址")IsNot Nothing Then
With wb.AddInputGroup("form1", "ipg1", "用户资料")
.AddInput("客户名", "姓名", "Text").value = dr1("客户名") '前一个"姓名"是ID,后一个"姓名"是标题
.AddInput("电话", "电话", "number").value = dr1("电话")
.AddInput("客户住址_蓝牌地址", "地址", "Text").value = dr1("客户住址_蓝牌地址")
.AddInput("身份证号码", "身份号码", "number").value = dr1("身份证号码")
.AddInput("性别", "性别", "女|男").value = dr1("性别")
.AddInput("邮箱", "邮箱", "Text").value = dr1("邮箱")
End With
With wb.AddButtonGroup("form1", "btg1", True)
.Add("btn1", "确定修改", "submit").Kind = 1
.Add("btn2", "返回主页", "button", "default.htm")
End With
e.WriteString(wb.Build)
End If
Else
Dim nms() As String = {"客户名", "性别", "电话", "客户住址_蓝牌地址"} '不能为空的列名数组
For Each nm As String In nms
If e.PostValues.ContainsKey(nm) = False Then '生成错误提示页
With wb.AddMsgPage("", "msgpage", "增加失败", nm & "不能为空!")
.icon = "Warn" '改变图标
.AddButton("btn1", "返回").Attribute = ""
End With
e.WriteString(wb.Build)
Return '必须返回
End If
Next
nms = New String() {"客户名", "电话", "客户住址_蓝牌地址", "身份证号码", "性别", "邮箱", "客户来源_KHID"} '重新定义了nms数组,增加了两列.
' Dim dr As DataRow = DataTables("客户").AddNew()
For Each nm As String In nms
If e.PostValues.ContainsKey(nm) Then
dr1(nm) = e.PostValues(nm)
End If
Next
'保存并生成增加成功提示页面
dr1.save()
e.AppendCookie("openid", OpenID)
With wb.AddMsgPage("", "msgpage", "增加成功", "用心服务好") '生成成功提示页
.AddButton("btn4", "修改", "kehu.htm").Kind = 1
.AddButton("btn5", "返回首页", "default.htm")
End With
e.WriteString(wb.Build)
End If
End Select '以下不是网页了---------------
e.WriteString(wb.Build) '生成网页
Else
sb.AppendLine("系统繁忙稍后访问本系统")
End If
Else
sb.AppendLine("你无权访问本系统")
End If
e.WriteString(sb.ToString)
50楼
有点蓝 发表于：2024/6/18 11:06:00调试，必须按我指定的位置放置调试代码，然后按顺序把所有提示发上来
Dim sb As New StringBuilder '公众号授权详情页
sb.AppendLine("<meta name='viewport' c>")
If e.host = "www.123.com.cn" Then '授权测试
Dim UserName As String
Dim OpenID As String
Dim KHID As String
MsgBox(e.Request.URL.ToString) '--------------------
If e.GetValues.ContainsKey("code") Then '如果是通过授权链接跳转而来,就从链接重提取code来获取openid
Dim ul As String = "https://api.weixin.qq.com/sns/oauth2/access_token?appid={0}&secret={1}&code={2}&grant_type=authorization_code"
ul = CExp(ul, "wx88888888888888", "fuhgfdjknnbh58546588855", e.GetValues("code"))
Dim hc As New HttpClient(ul)
Dim jo As JObject = JObject.Parse(hc.GetData)
If jo("openid") IsNot Nothing Then '如果获取openid成功(成功的话,还会同时返回一个accesstiken,用于获取用户详情)
OpenID = jo("openid")
Dim dr As DataRow = DataTables("客户").SQLFind("openid ='" & Openid & "'")
If dr IsNot Nothing Then
UserName = dr("nickname")
Else
ul = "https://api.weixin.qq.com/sns/userinfo?access_token={0}&openid={1}&lang=zh_CN "
'根据openid和accesstoken获取用户详情,注意这里这个accesstoken不是普通accesston,只能用于网页授权
hc = New HttpClient(CExp(ul, jo("access_token"), OpenId))
jo = jo.Parse(hc.GetData)
If jo("openid") IsNot Nothing Then
UserName = jo("nickname")
dr = DataTables("客户").AddNew()
Dim nms() As String = {"openid", "nickname", "headimgurl", "性别"} '"", "客户住址_县市", "country", "客户住址_省市"} '""
For Each nm As String In nms
dr(nm) = jo(nm)
' msgbox("提取数据", 64, "提示")
Next
msgbox("判断tjr有=" & e.GetValues.ContainsKey("state")) '--------------------
If e.GetValues.ContainsKey("state") Then 'e.GetValues.ContainsKey("tjr")获取二维码推荐人的TJkhid
msgbox("写入推荐人: " & e.GetValues("state"), 64, "提示")
dr("客户来源_KHID") = e.GetValues("state") 'e.GetValues.ContainsKey("TJkhid")获取二维码推荐人的TJkhid ，保存tjkhid
End If
dr.Save
Else
e.WriteString(jo.ToString) '在用户浏览器显示错误信息
' msgbox("不能增行token里openid空", 64, "提示空")
Return
End If
End If
e.AppendCookie("username", UserName) '用户名和openid存储在Cookie中
e.AppendCookie("openid", OpenID)
' e.AppendCookie("KHID", KHID)
' MsgBox("OpenID=" & OpenID & ",UserName=" & UserName) '----------------------------
Else
e.WriteString(jo.ToString) '在用户浏览器显示错误信息
' msgbox("openid空的", 64, "提示")
Return
End If
Else
UserName = e.Cookies("username") '从cookie获取用户名和openid
OpenID = e.Cookies("openid")
' KHID = e.Cookies("KHID")
Dim dr As DataRow = DataTables("客户").SQLFind("openid ='" & Openid & "'") '根据openid找出对应的行
MsgBox("tjr= " & (e.GetValues.ContainsKey("tjr")))
MsgBox("dr = " & (dr Is Nothing)) '-------------------------------------------------------------
If (dr Is Nothing OrElse UserName = "" OrElse OpenID = "") AndAlso e.GetValues.ContainsKey("tjr") Then '空
Dim url As String = e.Request.URL.ToString
MsgBox(url)
'看官方文档state仅支持字母和数字，不支持中文和特殊符号，而redirect_uri是支持有参数的
Dim ul As String = "https://open.weixin.qq.com/connect/oauth2/authorize?appid=wx88888888888888&redirect_uri=" & UrlEncode(url) & "&response_type=code&scope=snsapi_userinfo&state=state#wechat_redirect"
MsgBox(ul) '--------------------------------------------------------------------------------------------
sb.Append("<meta http-equiv='Refresh' c>") '跳转到授权链接
e.WriteString(sb.ToString)
' msgbox("跳转授权链接", 64, "提示")
Return
End If
End If
……