关于网页授权 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

Dim e As RequestEventArgs = args(0)

Dim UserId As String

Dim sb As New StringBuilder

If e.GetValues.ContainsKey("code") Then '如果通过授权链接跳转而来,就根据传递过来的code参数调用接口,获取用户的UserId

Dim ul As String = "https://qyapi.weixin.qq.com/cgi-bin/user/getuserinfo?access_token={0}&code={1}"

ul = CExp(ul,Functions.Execute("GetQYAccessToken"),e.GetValues("code"))

Dim hc As new HttpClient(ul)

Dim jo As JObject = JObject.Parse(hc.GetData)

MessageBox.Show("a")

If jo("UserId") IsNot Nothing Then

UserId = jo("UserId")

End If

Else

UserId = e.Cookies("userid") '否则从cookie中提取userid和username

End If

If UserId > "" then'授权成功

e.AppendCookie("userid",UserId) '将userid和username存储在Cookie中

Return UserId

ElseIf e.GetValues.ContainsKey("code") = False Then '如果授权失败,且不是通过授权链接跳转而来,那么就跳转到授权链接

'Dim ul1 As String = "https://open.weixin.qq.com/connect/oauth2/authorize?appid={0}&redirect_uri={1}&response_type=code&scope=SCOPE&agentid=AGENTID&state=STATE#wechat_redirect"

'Dim ul2 As String = UrlEncode("http://www.whtcxx.com")

'ul1 = CExp(ul1,"wxc919804411b0d36c",ul2)

'sb.Append("<meta http-equiv='Refresh' c>") '跳转到授权链接

Dim ul As String = "https://open.weixin.qq.com/connect/oauth2/authorize?appid=wxc919804411b0d36c&redirect_uri=http%3a%2f%2fwww.whtcxx.com&response_type=code&scope=snsapi_userinfo&state=123#wechat_redirect"

sb.Append("<meta http-equiv='Refresh' c>") '跳转到授权链接

e.WriteString(sb.ToString)

Return ""

End If

---------------------------------------------------------------

http://www.whtcxx.com/?code=011zW6e92AT00S0Z01d92PCbe92zW6e7&state=123

每次卡在这里网页就不动了

[此贴子已经被作者于2018/4/20 19:47:18编辑过]

仍然卡在这里

http://www.whtcxx.com/?code=021er2pY0at0432VHSoY0bl6pY0er2p3&state=123

Dim e As RequestEventArgs = args(0)

Dim sb As New StringBuilder

sb.AppendLine("<meta name='viewport' c>")

If e.host = "www.whtcxx.com" Then '授权测试

Dim UserName As String

Dim OpenID As String

MessageBox.Show("A")

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,"wxc919804411b0d36c","8157869b6771df1efec88b1f01726b8c",e.GetValues("code"))

Dim hc As new HttpClient(ul)

Dim jo As JObject = JObject.Parse(hc.GetData)

MessageBox.Show("B")

If jo("openid") IsNot Nothing Then '如果获取openid成功(成功的话,还会同时返回一个accesstiken,用于获取用户详情)

OpenID = jo("openid")

Dim dr As DataRow = DataTables("WXUsers").Find("openid ='" & Openid & "'")

MessageBox.Show("C")

If dr IsNot Nothing Then

UserName = dr("nickname")

MessageBox.Show("D")

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)

MessageBox.Show("E")

If jo("openid") IsNot Nothing Then

UserName = jo("nickname")

dr = DataTables("WXUsers").AddNew()

MessageBox.Show("F")

Dim nms() As String = {"openid","nickname","sex","city","country","province","headimgurl"} '""

For Each nm As String In nms

dr(nm) = jo(nm)

dr.Save

Else

MessageBox.Show("G")

e.WriteString(jo.ToString) '在用户浏览器显示错误信息

Return ""

End If

e.AppendCookie("username",UserName) '用户名和openid存储在Cookie中

e.AppendCookie("openid",OpenID)

MessageBox.Show("H")

Else

e.WriteString(jo.ToString) '在用户浏览器显示错误信息

Return ""

End If

Else

MessageBox.Show("I")

UserName = e.Cookies("username") '从cookie获取用户名和openid

OpenID = e.Cookies("openid")

If userName = "" OrElse OpenID = "" Then

MessageBox.Show("J")

sb.Append("<meta http-equiv='Refresh' c>") '跳转到授权链接

e.WriteString(sb.ToString)

Return ""

End If

MessageBox.Show("L")

If OpenID > "" And UserName > "" Then

'这里可以做进一步的权限判断

sb.AppendLine("欢迎" & UserName & "光临, <a href='http://wexin.foxtable.com'>刷新页面</a>")

Else

sb.AppendLine("你无权访问本系统")

End If

e.WriteString(sb.ToString)

中间有授权确认界面出现

httprequest

------------------------------

Dim fl As String = "d:\web\" & e.path

If filesys.FileExists(fl)

Dim idx As Integer = fl.LastIndexOf(".")

Dim ext As String = fl.SubString(idx)

Select Case ext

Case ".jpg",".gif",".png",".bmp",".wmf",".js",".css" ,".html",".htm",".zip",".rar"

e.WriteFile(fl)

Return '这里必须返回

End Select

End If

Select Case e.Path

Case "kaipiaoyuyuetianjia.htm"

Functions.Execute("rrzz",e)

Functions.Execute("kaipiaoyuyuetianjia",e)

End Select

Dim e As RequestEventArgs = args(0)

Dim sb As New StringBuilder

sb.AppendLine("<meta name='viewport' c>")

If e.host = "www.whtcxx.com" Then '授权测试

Dim UserName As String

Dim OpenID As String

MessageBox.Show("A")

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,"wxc919804411b0d36c","8157869b6771df1efec88b1f01726b8c",e.GetValues("code"))

Dim hc As new HttpClient(ul)

Dim jo As JObject = JObject.Parse(hc.GetData)

MessageBox.Show("B")

If jo("openid") IsNot Nothing Then '如果获取openid成功(成功的话,还会同时返回一个accesstiken,用于获取用户详情)

OpenID = jo("openid")

Dim dr As DataRow = DataTables("WXUsers").Find("openid ='" & Openid & "'")

MessageBox.Show("C")

If dr IsNot Nothing Then

UserName = dr("nickname")

MessageBox.Show("D")

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)

MessageBox.Show("E")

If jo("openid") IsNot Nothing Then

UserName = jo("nickname")

dr = DataTables("WXUsers").AddNew()

MessageBox.Show("F")

Dim nms() As String = {"openid","nickname","sex","city","country","province","headimgurl"} '""

For Each nm As String In nms

dr(nm) = jo(nm)

dr.Save

Else

MessageBox.Show("G")

e.WriteString(jo.ToString) '在用户浏览器显示错误信息

Return ""

End If

e.AppendCookie("username",UserName) '用户名和openid存储在Cookie中

e.AppendCookie("openid",OpenID)

MessageBox.Show("H")

Else

e.WriteString(jo.ToString) '在用户浏览器显示错误信息

Return ""

End If

Else

MessageBox.Show("I")

UserName = e.Cookies("username") '从cookie获取用户名和openid

OpenID = e.Cookies("openid")

If userName = "" OrElse OpenID = "" Then

MessageBox.Show("J")

sb.Append("<meta http-equiv='Refresh' c>") '跳转到授权链接

e.WriteString(sb.ToString)

Return ""

End If

MessageBox.Show("L")

If OpenID > "" And UserName > "" Then

'这里可以做进一步的权限判断

sb.AppendLine("欢迎" & UserName & "光临, <a href='http://wexin.foxtable.com'>刷新页面</a>")

Else

sb.AppendLine("你无权访问本系统")

End If

e.WriteString(sb.ToString)

-----------------------------------

把红色这一段删掉，则跳转到http://www.whtcxx.com/kaipiaoyuyuetianjia.htm,但页面是一片空白

Functions.Execute("rrzz",e)

这个是是网页授权认证的，

Functions.Execute("kaipiaoyuyuetianjia",e)

这个是要访问的网页

希望访问kaipiaoyuyuetianjia.htm，用函数rrzz先授权认证一下

rrzz代码

Dim e As RequestEventArgs = args(0)

Dim sb As New StringBuilder

sb.AppendLine("<meta name='viewport' c>")

If e.host = "www.whtcxx.com" Then '授权测试

Dim UserName As String

Dim OpenID As String

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,"wxc919804411b0d36c","8157869b6771df1efec88b1f01726b8c",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("WXUsers").Find("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("WXUsers").AddNew()

Dim nms() As String = {"openid","nickname","sex","city","country","province","headimgurl"} '""

For Each nm As String In nms

dr(nm) = jo(nm)

dr.Save

Else

e.WriteString(jo.ToString) '在用户浏览器显示错误信息

Return ""

End If

e.AppendCookie("username",UserName) '用户名和openid存储在Cookie中

e.AppendCookie("openid",OpenID)

Else

e.WriteString(jo.ToString) '在用户浏览器显示错误信息

Return ""

End If

Else

UserName = e.Cookies("username") '从cookie获取用户名和openid

OpenID = e.Cookies("openid")

If userName = "" OrElse OpenID = "" Then

Dim ul As String = "https://open.weixin.qq.com/connect/oauth2/authorize?appid=wxc919804411b0d36c&redirect_uri=http%3a%2f%2www.whtcxx.com&response_type=code&scope=snsapi_userinfo&state=123#wechat_redirect"

sb.Append("<meta http-equiv='Refresh' c>") '跳转到授权链接

e.WriteString(sb.ToString)

Return ""

End If

'If OpenID > "" And UserName > "" Then

''这里可以做进一步的权限判断

'sb.AppendLine("欢迎" & UserName & "光临, <a href='http://wexin.foxtable.com'>刷新页面</a>")

'Else

'sb.AppendLine("你无权访问本系统")

'End If

End If

e.WriteString(sb.ToString)

kaipiaoyuyuetianjia代码

-------------------------------------

Dim e As RequestEventArgs = args(0)

Dim wb As New weui

wb.InsertHTML("<img width='100%' src='images/home.jpg'/>")

If e.PostValues.Count = 0 Then

wb.AddForm("","form1","kaipiaoyuyuetianjia.htm")

With wb.AddInputGroup("form1","ipg4","fa piao类型及领取方式")

.AddSelect("fa piao类型","<label style='font-size:18px'>fa piao类型 : </label>","|普通fa piao|增值税专用fa piao")

.AddSelect("领取方式","<label style='font-size:18px'>领取方式 : </label>","|酒店前台自取|到付邮寄")

End With

With wb.AddInputGroup("form1","ipg3","开piao内容")

.AddInput("公司名称","<label style='font-size:18px'>公司名称 : </label>","text")

.AddInput("纳税人识别号","<label style='font-size:18px'>纳税人识别号 : </label>","text")

.AddInput("fa piao抬头","<label style='font-size:18px'>fa piao抬头 : </label>","text")

.AddInput("房间号","<label style='font-size:18px'>房间号 : </label>","text")

.AddInput("入住时间","<label style='font-size:18px'>入住时间 : </label>","Date")

.AddInput("离店时间","<label style='font-size:18px'>离店时间 : </label>","Date")

.AddInput("姓名","<label style='font-size:18px'>姓名 : </label>","text")

.AddInput("电话","<label style='font-size:18px'>电话 : </label>","number")

.AddInput("备注","<label style='font-size:18px'>备注 : </label>","text")

End With

With wb.AddInputGroup("form1","ipg5","开piao二维码图片上传")

With .AddUploader("up128","开piao信息二维码",True)

.AllowDelete = True '允许删除

.Incremental = True '允许重复选择文件或连续拍照

.ScaleWidth = 400

End With

With wb.AddButtonGroup("form1","btg6",True)

.Add("btn1", "确定", "button").Attribute= "" '调用js函数上传

End With

wb.AddToast("","tst1", "正在上传",1)

wb.AddToast("","tst2", "上传成功",0)

wb.AddToast("","tst3", "上传失败",0).Icon= "warn"

wb.AppendHTML("<script src='./lib/ajaxform.js'></script>") '引入脚本文件

wb.InsertHTML("</br><img width='100%' src=' images/kefu.jpg '/>")

e.WriteString(wb.Build)

Else

Dim nms() As String = {"fa piao类型","公司名称","纳税人识别号","fa piao抬头","房间号","入住时间","离店时间","姓名","电话","领取方式"} '不能为空的列名数组

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

nms = New String() {"fa piao类型","公司名称","纳税人识别号","fa piao抬头","房间号","入住时间","离店时间","姓名","电话","领取方式","备注","开piao信息二维码"} '重新定义了nms数组,增加了两列.

Dim dr As DataRow = DataTables("酒店开fa piao预登记").AddNew()

For Each nm As String In nms

If e.PostValues.ContainsKey(nm) Then

dr(nm) = e.PostValues(nm)

End If

dr("UserName") = e.Cookies("username") '从cookie获取用户名和openid

'MessageBox.Show(e.Cookies("openid"))

dr("OpenID") = e.Cookies("openid")

dr("登记时间") = Today

dr("预约号码") =dr("_Identify")

Dim t As TimeSpan

t = CDate(dr("离店时间")) - CDate(dr("入住时间"))

If t.TotalDays = 0 Then

dr("合计天数") = 1

Else

dr("合计天数") = t.TotalDays

End If

dr("酒店名称") = e.Cookies("jdmc")

dr("地区") = "五华县"

For Each key As String In e.Files.Keys

If e.Files(key).Count - 1 < 0 Then

Else

For Each fln As String In e.Files(key)

Dim NewName As String = fln

Dim idx As Integer = fln.LastIndexOf(".")

Dim cnt As Integer = 1

Do While FileSys.FileExists("d:\web\uploadfiles\" & NewName) '判断文件夹是否存在同名文件

NewName = fln.Insert(idx,""& cnt &"") '如果存在同名文件,在原文件名加上序号

cnt = cnt + 1 '递增序号

Loop

e.SaveFile(key,fln,"d:\web\uploadfiles\" & NewName) '保存接收到的文件

Dim lst As List(of String) = dr.Lines("开piao信息二维码") '获取文件集合

lst.Add(Filesys.GetName(NewName)) '给集合增加一个文件

dr.Lines("开piao信息二维码") = lst '将新的集合赋值给文件列

End If

e.WriteString("OK")

dr.save()

e.WriteString(wb.Build)

End If

主题：关于网页授权