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

以下代码可用，但是每次会提示，

此主题相关图片如下：360截图20180930132835335.bmp

Dim Book As New XLS.Book(ProjectPath & "Attachments\订餐明细打印.xls")

Dim fl As String = ProjectPath & "Reports\订餐明细打印.xls"

Book.Build() '生成报表

Book.Save(fl)

Dim Proc As New Process

Proc.File = fl

Dim App As New MSExcel.Application

Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)

Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)

Dim Rg As MSExcel.Range = Ws.UsedRange '只取有数据的区域

Rg.copy

ClipBoard.GetImage.save("e:\web\webdc\images\订餐明细打印.jpg")

App.quit

去掉这2句

Dim Proc As New Process

Proc.File = fl

If e.host = "210121kc64.51mypc.cn" Then '需要授权才能访问的域名,前面不能加http

Dim UserId As String

Dim UserName As String

Dim sb As New StringBuilder

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

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)

If jo("UserId") IsNot Nothing Then

UserId = jo("UserId")

End If

Else

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

End If

Dim Verified As Boolean

Dim dr As DataRow = DataTables("Users").Find("userid ='" & UserId & "'") '根据openid找出对应的行

If UserId > "" AndAlso dr IsNot Nothing AndAlso dr("permit") = True Then '授权成功

Verified = True

UserName = dr("name")

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

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

Dim ul As String = "https://open.weixin.qq.com/connect/oauth2/authorize?appid={0}&redirect_uri={1}&response_type=code&scope=snsapi_base&state={2}#wechat_redirect"

Dim ul2 As String = UrlEncode("http://210121kc64.51mypc.cn:20996/logon.htm") '跳转到授权链接,登录主页

ul = CExp(ul,"wxcbfda17a529a96a6",ul2,"123") '123

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

'sb.Append("<meta http-equiv='Refresh' c>") '直接跳转到首页

e.WriteString(sb.ToString)

Return

End If

If Verified = False Then

sb.AppendLine("你无权访问本系统,请联系管理员开通!")

Else '<br/>表示换行

sb.AppendLine("<br/><h2>欢迎" & UserName & "</h2><a href='dcsx.htm'><h2>点击进入订餐系统</h2></a>")

End If

e.WriteString(sb.ToString)

End If

红色代码获取登入信息可用，但是进入后点击后进入dcsx.htm这个页面，还是停留在当前

测试没有问题。dcsx.htm页的定义代码看看

Dim wb As New WeUI

wb.AddPageTitle("","pageheader","工作餐平台","内部订餐系统")

With wb.AddGrid("","g1")

.Add("c6","我要订餐", "./webdc/images/dcmxtongji.png", "http://210121kc64.51mypc.cn:20996/wydc.htm")

.Add("c5","订餐明细", "./webdc/images/dcmx.png", "http://210121kc64.51mypc.cn:20996/dcmxmx.htm")

.Add("c7","我的订餐", "./webdc/images/dchj.png", "http://210121kc64.51mypc.cn:20996/wddc.htm")

.Add("c8","订餐统计", "./webdc/images/edit.png", "http://210121kc64.51mypc.cn:20996/dcmxtongji.htm")

.Add("c9","代码测试", "./webdc/images/list.png", "http://210121kc64.51mypc.cn:20996/Upimages.htm")

End With

.AddLink("底部链接","http://wap.baidu.com")

End With

e.WriteString(wb.Build)

HTTPrequest代码发上来看看

'通用事件头

HttpServer.WebPath = "e:\web"

Functions.Execute("WEBSERVERS",e)

WEBSERVERS：

Dim e As RequestEventArgs = args(0)

Dim drx As DataRow = DataTables("订餐网页表").SQLFind("网页='" & e.Path & "'")

If drx IsNot Nothing Then

' For Each dr As DataRow In DataTables("订餐网页表").DataRows

' If DataTables("订餐网页表").Find("启用状态") = true Then

e.AsyncExecute = True '通知系统,将采用异步方式生成网页

Functions.AsyncExecute(drx("函数名称"),e) '异步调用函数生成网页

' End If

' Next

End If

[此贴子已经被作者于2018/9/30 18:36:44编辑过]

试试改成

sb.AppendLine("<br/><h2>欢迎" & UserName & "</h2><a href='/dcsx.htm'><h2>点击进入订餐系统</h2></a>")

然后，你httprequest那里，加入msgbox，弹出msgbox(e.path)看看。

主题：逻辑按钮