Foxtable(狐表) → 用户栏目 → 专家坐堂 → 怎么实现系统自动判断当前网页名去对应的获取函数名称并将代码进行显示？


  共有3679人关注过本帖树形打印复制链接

主题：怎么实现系统自动判断当前网页名去对应的获取函数名称并将代码进行显示？
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		怎么实现系统自动判断当前网页名去对应的获取函数名称并将代码进行显示？  发帖心情 Post By：2021/1/28 18:21:00 [显示全部帖子]

麻烦老师们看看 有没有办法优化代码
实现用户不管是选择任何网页名的内容，都能够对应的匹配对应的函数名及代码值。

创建有一  内部函数表
表中有函数名称  网页名  代码 字段
假设：
函数名称： logon  
网页名： logon.htm
代码列值为： 
Dim e As RequestEventArgs = args(0)
Dim wb As New weui
If Functions.Execute("yanzheng",e) = 1 '获取验证不能使用异步函数,必须等待并获取验证结果
    Dim cmd1 As New SQLCommand
    cmd1.C '记得设置数据源名称
    cmd1.CommandText = "Sel ect Count(*) From {test}"
    Dim dt As DataTable = cmd1.ExecuteReader
    wb.AddPageTitle("","pageheader","xx系统")
    If e.PostValues.Count > 0 Then '判断是否是验证失败后的重新登录
        wb.AddTopTips("","toptip11","用户名或密码错误!").msec = 2000 '如果用户通过登录按钮访问,则给用户一个2秒的提示.
    End If
    wb.AddForm("","form1","logon.htm")
    With wb.AddInputGroup("form1","ipg1")
        With .AddSelect("名称","名称*","|" & dt.sqlGetComboListString("名称"))
            .Attribute = "font-family: Verdana;">部门',false)"""
        End With
        
        With .AddSelect("部门","部门*","")
            .Attribute = "font-family: Verdana;">部门',false)"""
        End With
        With .AddSelect("姓名","姓名*","" )
        End With
        .AddInput("密码","密码*","password").Placeholder = "请输入6位数密码"
    End With
    With wb.AddButtonGroup("form1","btg1",True)
        .Add("btn1", "登录", "submit")
    End With
    With wb.AddPageFooter("","pf1","Copyright © 2021")
        .AddLink("本系统为初步demo版本")
    End With
    e.WriteString(wb.Build) '生成网页

End If

生成内部函数的代码：（生成对应htm代码页面的代码）
Dim st As Date = Date.Now '将开始时间保存在变量st中
Dim drs As new List(Of DataRow)
drs = DataTables("内部函数表").Select("")
Dim s As String
For Each dr As DataRow In  drs
    s =  dr("代码")
    If s.Contains("Dim e As RequestEventArgs = args(0)") = False Then
        dr("代码") =  "Dim e As RequestEventArgs = args(0)" & vbcrlf & dr("代码")
    End If
    Functions.remove(dr("函数名称"))
    Functions.Add(dr("函数名称"),dr("代码"))
    MessageBox.Show(dr("函数名称"))
Next
MessageBox.Show("成功")
Functions.Complie()
DataTables("内部函数表").save

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
Dim wb As New weui
Select Case e.Path
    Case Tables("内部函数表").Current("网页名")
        e.AsyncExecute = True  '通知系统,将采用异步方式生成网页
        Functions.AsyncExecute(Tables("内部函数表").Current("函数名称"), e) '异步调用函数生成网页

    Case ""
        e.AsyncExecute = True  '通知系统,将采用异步方式生成网页
        Functions.AsyncExecute("default", e) '异步调用函数生成网页
End Select

红色部分代码想实现系统自动判断当前网页名去对应的获取函数名称并将代码进行显示，当前运行有点不顺畅
麻烦老师们看看 有没有办法优化代码
实现用户不管是选择任何网页名的内容，都能够对应的匹配对应的函数名及代码值。
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）建个表，管理网页名称和函数的对应关...  发帖心情 Post By：2021/1/29 9:36:00 [显示全部帖子]


老师参照你提供的实列   我看了一下 下面的语句是关键
Select Case e.Path
    Case "teststep1.htm"
        Functions.Execute("teststep",e)

当前我已经按照你提供的思路创建了表  对应有函数名称  网页名  代码  也按照一楼的方式将对应的函数名称生成函数
生成内部函数的代码：（生成对应htm代码页面的代码）
Dim st As Date = Date.Now '将开始时间保存在变量st中
Dim drs As new List(Of DataRow)
drs = DataTables("内部函数表").Select("")
Dim s As String
For Each dr As DataRow In  drs
    s =  dr("代码")
    If s.Contains("Dim e As RequestEventArgs = args(0)") = False Then
        dr("代码") =  "Dim e As RequestEventArgs = args(0)" & vbcrlf & dr("代码")
    End If
    Functions.remove(dr("函数名称"))
    Functions.Add(dr("函数名称"),dr("代码"))
    MessageBox.Show(dr("函数名称"))
Next
MessageBox.Show("成功")
Functions.Complie()
DataTables("内部函数表").save


此主题相关图片如下：111.png
按此在新窗口浏览图片
Case Tables("内部函数表").Current("网页名")
        e.AsyncExecute = True  '通知系统,将采用异步方式生成网页
        Functions.AsyncExecute(Tables("内部函数表").Current("函数名称"), e) '异步调用函数生成网页
麻烦老师们看看 有没有办法优化代码
实现用户不管是选择任何网页名的内容，都能够对应的匹配对应的函数名及代码值
[此贴子已经被作者于2021/1/29 9:36:12编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）您根本没看懂例子的用法   ...  发帖心情 Post By：2021/1/29 9:58:00 [显示全部帖子]

老师  没有在测试数据库中找到"httprequest"这个表  所以忽视了这部分代码  

 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）您根本没看懂例子的用法   ...  发帖心情 Post By：2021/1/29 10:02:00 [显示全部帖子]

老师  谢谢！我再学习一下

 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）您根本没看懂例子的用法   ...  发帖心情 Post By：2021/1/29 10:06:00 [显示全部帖子]

老师  

httprequest表只有两个字段 一个是path  一个是function  有没有办法不用在常见项目的时候就预设好内部函数呢？
而是采用在后期  输入代码 生成内部函数内容


下面这个代码有没有不足的地方呢？
生成内部函数的代码：（生成对应htm代码页面的代码）
Dim st As Date = Date.Now '将开始时间保存在变量st中
Dim drs As new List(Of DataRow)
drs = DataTables("内部函数表").Select("")
Dim s As String
For Each dr As DataRow In  drs
    s =  dr("代码")
    If s.Contains("Dim e As RequestEventArgs = args(0)") = False Then
        dr("代码") =  "Dim e As RequestEventArgs = args(0)" & vbcrlf & dr("代码")
    End If
    Functions.remove(dr("函数名称"))
    Functions.Add(dr("函数名称"),dr("代码"))
    MessageBox.Show(dr("函数名称"))
Next
MessageBox.Show("成功")
Functions.Complie()
DataTables("内部函数表").save
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）您根本没看懂例子的用法   ...  发帖心情 Post By：2021/1/31 16:38:00 [显示全部帖子]

httprequest事件代码如下：
Dim fl As String = ProjectPath & "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 ""
        e.AsyncExecute = True  '通知系统,将采用异步方式生成网页
        Functions.AsyncExecute("default", e) '异步调用函数生成网页
    Case Else
        Dim dr As DataRow = DataTables("内部函数表").Find("网页名='" & e.Path & "'")
        If dr IsNot Nothing Then
            Functions.Execute(dr("函数名称"),e)
        Else
            Dim wb As New weui
            wb.InsertHTML("<p>杯具!页面丢失了!!</p>")
            wb.AppendHTML("<script>console.warn('" & e.Path & "不在httprequest表,请检查是否没有设置.')</script>")
            e.WriteString(wb.Build)
        End If
End Select


页面代码如下：
With wb.AddInputGroup("form1","ipg111111","文件列表")
    For Each dr1 As DataRow In dt.DataRows
        Dim fln As  String = dr1("图片名称")
        Dim wj As String ="./缓存文件\" & fln
        If FileSys.FileExists(wj) Then '如果本地存在同名文件且CRC校验值相同
            '则直接使用本地文件
            Dim sb As New StringBuilder
            sb.appendLine("<div>")
            sb.appendLine("<a href='" & wj & "'>" & fln & "</a>")
            sb.appendLine("</div>")
            wb.InsertHTML("form1",sb.ToString)
        Else '否则从数据库提取文件
            If dr1.SQLLoadFile("图片",wj) = True Then '如果提取文件失败
                
            Dim sb1 As New StringBuilder
            sb1.appendLine("<div>")
            sb1.appendLine("<a href='" & wj & "'>" & fln & "</a>")
            sb1.appendLine("</div>")
            wb.InsertHTML("form1",sb1.ToString)
            End If
        End If
    Next
End With

运行页面代码  会下载对应的二进制文件到缓存文件夹下，
获取到的文件会在页面显示对应的网址路劲 ，但是打开会提示“杯具，页面不存在”
麻烦老师看看
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）参考：http://www.foxtable.com/mobi...  发帖心情 Post By：2021/1/31 22:18:00 [显示全部帖子]

HttpServer.WebPath = ProjectPath & "Attachments\web\"
HttpServer.Extensions.add(".doc")
HttpServer.Extensions.add(".docx")
HttpServer.Start()

打开依旧是提示杯具    经查这个对应的目录下是有文件的

图片点击可在新窗口打开查看此主题相关图片如下：111.png
图片点击可在新窗口打开查看
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）路径不对。web根目录是【HttpServer....  发帖心情 Post By：2021/1/31 23:07:00 [显示全部帖子]

OK 谢谢老师  按老师指导  红色部分对应修改解决了文件打开问题
With wb.AddInputGroup("form1","ipg111111","文件列表")
    If dt IsNot Nothing Then '如果找到的话
        For Each dr1 As DataRow In dt.DataTable.DataRows
            Dim fln As  String = dr1("图片名称")
            Dim Values() As String
            Values = fln.Split(".")
            If Values(1)="jpg" Or Values(1)="png" Or Values(1)="bmp" Then
                
            Else
                Dim wj As String ="./" & fln
                If FileSys.FileExists(wj) Then '如果本地存在同名文件且CRC校验值相同
                    '则直接使用本地文件
                    Dim sb As New StringBuilder
                    sb.appendLine("<div>")
                    sb.appendLine("<a href='" & wj & "'>" & fln & "</a>")
                    sb.appendLine("</div>")
                    wb.InsertHTML("form1",sb.ToString)
                Else '否则从数据库提取文件
                    If dr1.SQLLoadFile("图片",wj) = True Then '如果提取文件失败
                        Dim sb1 As New StringBuilder
                        sb1.appendLine("<div>")
                        sb1.appendLine("<a href='" & wj & "'>" & fln & "</a>")
                        sb1.appendLine("</div>")
                        wb.InsertHTML("form1",sb1.ToString)
                    End If
                End If
            End If
        Next
    Else
        Dim sb11 As New StringBuilder
        sb11.appendLine("<div>")
        sb11.appendLine("<a>没有对应的文件,请联系管理员!</a>")
        sb11.appendLine("</div>")
        wb.InsertHTML("form1",sb11.ToString)
    End If
    
End With
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）路径不对。web根目录是【HttpServer....  发帖心情 Post By：2021/2/1 13:12:00 [显示全部帖子]

老师   昨天晚上在程序开发调试中   wj1可以直接下载对应文件 并且页面可以访问
今天生成项目后，wj1就不能直接下载对应文件  页面上的名称连接也不能打开文件了
1、改成wj和wj1并用的时候才能即可以下载文件 又可以页面打开文件  有没有办法简化代码呢？
2、For Each dr1 As DataRow In dt.DataTable.DataRows  这个写法是不是有问题呢？
导致dr1.SQLLoadFile总是把当前表所有的文件下载下来了   dt的查询条件对应的数据是可以获得值得  麻烦老师指导下  谢谢！


With wb.AddInputGroup("form1","ipg111111","文件列表")
    Dim dt As DataRow = DataTables("附件").Find("类别= '" & leibie & "'and 编号= '" & bianhao & "'and 姓名= '" & xingming & "'and 单位= '" & danwei & "' and 部门= '" & bumen & "'")
    If dt IsNot Nothing Then '如果找到的话
        For Each dr1 As DataRow In dt.DataTable.DataRows
            Dim fln As  String = dr1("名称")
            Dim Values() As String
            Values = fln.Split(".")
            If Values(1)="jpg" Or Values(1)="png" Or Values(1)="bmp" Then
                
            Else
                Dim wj1 As String ="./" & fln
                Dim wj As String =ProjectPath & "Attachments\web\" & fln     ‘ProjectPath & "Attachments\web\" 为项目启动web服务的地址’
                If FileSys.FileExists(wj) Then '如果本地存在同名文件且CRC校验值相同
                    '则直接使用本地文件
                    Dim sb As New StringBuilder
                    sb.appendLine("<div>")
                    sb.appendLine("<a href='" & wj1 & "'>" & fln & "</a>")
                    sb.appendLine("</div>")
                    wb.InsertHTML("form1",sb.ToString)
                Else '否则从数据库提取文件
                    If dr1.SQLLoadFile("附件",wj) = True Then '如果提取文件失败
                        Dim sb1 As New StringBuilder
                        sb1.appendLine("<div>")
                        sb1.appendLine("<a href='" & wj1 & "'>" & fln & "</a>")
                        sb1.appendLine("</div>")
                        wb.InsertHTML("form1",sb1.ToString)
                    End If
                End If
            End If
        Next
    Else
        Dim sb11 As New StringBuilder
        sb11.appendLine("<div>")
        sb11.appendLine("<a>没有对应的文件,请联系管理员!</a>")
        sb11.appendLine("</div>")
        wb.InsertHTML("form1",sb11.ToString)
    End If  
End With
 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.15625 秒, 5 次数据查询