以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  [求助]url该怎么写?  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=188097)

--  作者:fanjq8686
--  发布时间:2023/9/1 9:11:00
--  [求助]url该怎么写?
请教老师:

Dim e As RequestEventArgs = args(0)
Dim wb As New weui

\'显示上传照片
Dim dr As DataRow \'表
Dim Page As Integer \'页码变量
If e.GetValues.ContainsKey("page") Then \'如果地址中有page参数
    Integer.TryParse(e.GetValues("page"), page) \'提取page参数
End If

If e.GetValues.ContainsKey("key") = False Then \'如果没有传递报告编号,则新增与一个项目
    \'msgbox("没有传递报告编号")
Else \'如果传递了报告编号,则进行编辑
    dr = DataTables("业务流程表").SQLFind("报告编号=\'" & e.GetValues("key") & "\'")
    If dr Is Nothing Then \'多用户情况下,必须考虑其他用户删除订单的可能.
        wb.InSertHtml("此项目已被其他用户删除!")
        e.WriteString(wb.Build)
        Return "" \'必须返回
    End If
End If

Dim lst As New List(Of String)
Dim lst1 As New List(Of String)
lst = dr.Lines("检验记录")
lst1 = dr.Lines("电子档案目录")
Select Case e.Path
    Case "showphoto.htm"
        wb.AddPageTitle("", "pageheader", "管理系统", "<lable style=\'font-size:15px\'>沈阳电气传动研究所(有限公司)</lable>")
        
\'-----url变化的状态-----------------------------------------------------------------------------------        
        \'Dim url As String = "showphoto.htm?page=" & page & "&key=" & dr("报告编号") \'\'不能上传,运行错误:调用的目标发生了异常,提醒“上传失败”,显示正常页面。   传递页码和订单编号
        \'Dim url As String = "showphoto.htm" \'不能上传,运行错误:调用的目标发生了异常,提醒“上传失败”,显示正常页面
        \'Dim url As String = "Upload.htm" \'不能上传,运行错误:调用的目标发生了异常,提醒“上传失败”,显示正常页面
        Dim url As String = "Upload.htm?page=" & page & "&key=" & dr("报告编号") \'可以上传,运行错误:调用的目标发生了异常,提醒“上传成功”,不能显示正常页面
\'------url变化的状态----------------------------------------------------------------------------------        
        
        wb.AddForm("", "form1", url)
        
        With wb.AddInputGroup("form1", "ipg1", "项目信息")
            .AddInput("报告编号", "报告编号", "text").Value = dr("报告编号")
            .AddInput("客户名称", "客户名称", "text").Value = dr("客户名称")
            .AddInput("样品名称", "样品名称", "text").Value = dr("样品名称")
            .AddInput("型号规格", "型号规格", "text").Value = dr("样品型号规格")
            \'.AddInput("受理日期", "受理日期", "date").Value = dr("受理日期")
        End With
        \'Dim filename As String = "F:\\ftpFiles\\照片\\" & dr("报告编号")
        Dim filename As String = "E:\\myftp\\项目\\" & dr("报告编号")
        If FileSys.DirectoryExists(filename) = False Then \'如果目录不存在
            FileSys.CreateDirectory(filename) \'创建目录
        End If
        Dim sst As String = ""
        With wb.AddInputGroup("form1", "ipg22", "照片") \'带图片浏览的文件上传
            With .AddUploader("up2", "现场照片", True) \'True表示允许一次上传多个文件
                .AllowAdd = False \'关闭文件上传功能
                For Each File As String In FileSys.GetFiles(filename)
                    If filesys.FileExists(File) Then
                        Dim idx As Integer = File.LastIndexOf(".")
                        Dim ext As String = File.SubString(idx)
                        Select Case ext
                            Case ".jpg", ".gif", ".png", ".bmp", ".wmf"
                                \'msgbox(File)
                                File = File.Replace("\\", "/")
                                File = "/" & File
                                sst = File
                                .AddImage(UrlEncode(sst), UrlEncode(sst))
                        End Select
                    End If
                Next
            End With
        End With
        With wb.AddInputGroup("form1", "ipg2", "照片上传")
            With .AddUploader("up128", "添加照片", True)
                .Accept = "image/*" \'允许使用相册和相机
                .AllowDelete = True \'允许删除
                .Incremental = True \'允许重复选择文件或连续拍照
                .ScaleWidth = 400 \'自动压缩图片宽度为400个像素,高度等比例压缩
            End With
        End With
        
        With wb.AddButtonGroup("form1", "btg1", False)
            .Add("btn1", "上传", "button").Attribute = "" \'调用js函数上传
            .Add("btn3", "返回", "button", "list.htm?page=" & page) \'返回列表
        End With
        wb.AddToast("", "tst1", "正在上传", 1)
        wb.AddToast("", "tst2", "上传成功", 0)
        wb.AddToast("", "tst3", "上传失败", 0).Icon = "warn"
    Case "Upload.htm"
        Dim U As String = e.Cookies("username") \'从cookie中获取用户名
        Dim UserName As String = DecryptText(u, "123", "123") \'解密
        Dim bh As String = Format(Date.now, "yyMMddhhmm") \'生成编号的前10位,各2位
        Dim Str1 As String = e.PostValues("报告编号") & "照片-" & UserName & bh
        Dim filename As String = "E:\\myftp\\项目\\" & dr("报告编号") & "\\"
        For Each key As String In e.Files.Keys
            Dim i As Integer = 0
            For Each fln As String In e.Files(key)
                i = i + 1
                Dim ifo As New FileInfo( fln)
                Dim Str2 As String = Str1 & "-" & CStr(i) & ifo.Extension \'返回文件扩展名
                e.SaveFile(key, fln, filename & Str2) \'保存接收到的文件
                If fln > "" Then lst.add("\\项目\\" & e.PostValues("报告编号") & "\\" & Str2)
                If fln > "" Then lst1.add("\\项目\\" & e.PostValues("报告编号") & "\\" & Str2)
            Next
        Next
        dr.Lines("检验记录") = lst
        dr.Lines("电子档案目录") = lst1
        dr("备注") = Date.Now & UserName & ":上传检验现场照片;" & Chr(13) & Chr(10) & dr("备注")
        dr.save
        e.WriteString("OK") 
End Select
wb.AppendHTML("<script src=\'./lib/ajaxform.js\'></script>") \'引入脚本文件
e.WriteString(wb.Build) \'生成网页

--  作者:有点蓝
--  发布时间:2023/9/1 9:18:00
--  
httprequest事件代码发上来看看
--  作者:fanjq8686
--  发布时间:2023/9/1 9:41:00
--  
Functions.Execute("手机访问", e)

Dim dr As DataRow
Dim wb As New weui
Select Case e.Path
    Case "logon.htm"
        Functions.Execute("logon", e)
    Case "exit.htm"
        Functions.Execute("logon", e)
    Case "", "default.htm"
        Functions.Execute("logon", e)
    Case "filter.htm"
        Functions.Execute("Filter", e)
    Case "xianshi.htm" \'显示
        Functions.Execute("xianshi", e)
    Case "receive.htm" \'接收
        Functions.Execute("xianshi", e)
    Case "list.htm"
        Functions.Execute("List", e)
    Case "filterlist.htm"
        Functions.Execute("Filterlist", e)
    Case "showphoto.htm"
        Functions.Execute("ShowPhoto", e)
    Case "upload.htm"
        Functions.Execute("ShowPhoto", e)
\'--------暂时没用-----------------------        ShowPhoto   Uploade
    Case "but.htm"
        Functions.Execute("but", e)
    Case "edit.htm"
        Functions.Execute("Edit", e)
End Select

--  作者:fanjq8686
--  发布时间:2023/9/1 9:41:00
--  
function submitForm1(){
    show("tst1",2000);
    var result = submitAjaxForm(\'form1\',\'afterSubmit1\');
}

function afterSubmit1(result){
    hide("tst1");
    if (result==\'OK\') {
        show("tst2");
        location="showphoto.htm";
    }
    else{
        show("tst3",2000);
    }
}


--  作者:fanjq8686
--  发布时间:2023/9/1 9:53:00
--  
list函数
Dim e As RequestEventArgs = args(0)
Dim wb As New WeUI

\'获取要显示的页
Dim page As Integer = 0 \'默认page为0,显示第一页
Dim pageRows As Integer = 10 \'每页10行-----------------------
If e.GetValues.ContainsKey("page") Then \'如果地址中有page参数
    Integer.TryParse(e.GetValues("page"), page) \'提取page参数
End If
Dim StartRow As Integer = page * pageRows + 1 \'此页第一行
Dim EndRow As Integer = (page + 1) * pageRows \'此页最后一行

Dim Filter As String \'条件表达式
If e.GetValues.ContainsKey("unfilter") Then
    wb.ClearCookie() \'清除Cookie
Else
    Filter = Functions.Execute("GetFilter", e, wb, "")\'合成条件表达式
End If

If Filter Is Nothing Then
    Filter = "流程状态 = \'完成\' OR 流程状态 = \'内部\' OR 流程状态 = \'加急\' OR 流程状态 = \'正常\' OR 流程状态 = \'新\' OR 流程状态 = \'OK\' OR 流程状态 = \'调档\' OR 流程状态  Is Null"
End If
\'msgbox("查询内容 = " & Filter)
\'------------获取该页数据-----------------
Dim cmd As New SQLCommand
cmd.C \'记得设置数据源名称
cmd.CommandText = 
Dim Count As Integer = cmd.ExecuteScalar() \'获取总的行数

\'msgbox("e.PostValues(查询内容) = " & e.PostValues("查询内容") & "      e.Cookies(查询内容) = " & e.Cookies("nr"))

Dim cxnr As String \'查询内容  e.Cookies("查询内容")
\'If e.PostValues("查询内容") Is Nothing Then
If e.PostValues("查询内容") Is Nothing Then
    If e.Cookies("nr") Is Nothing Then
        cxnr = "交费情况"\'查询内容
    Else
        cxnr = e.Cookies("nr")\'查询内容
    End If
Else
    cxnr = e.PostValues("查询内容")\'查询内容
    \'cxnr = e.Cookies("nr")\'查询内容
End If
\'msgbox("查询内容 = " & cxnr)

Dim Pages As Integer = Math.Ceiling(Count / PageRows) \'计算出总页数
cmd.CommandText = 
Dim dt As DataTable = cmd.ExecuteReader

\'根据此页数据生成表格
\'wb.AddForm("", "form1", "edit.htm")
With wb.AddTable("", "Table1")
    .PageNumber = page \'设置页码
    \'.Highlight = -1 \'关闭高亮显示
    \'.Alternate = 2 \'每两行显示一个不同背景颜色的行
    .RowHead = 1 \'左边第一列作为行头
    .ActiveSheet = "menu" \'指定菜单
    \'.ColWidth = "12px,,120px" \'设置列宽
    .Primarykey = "报告编号" \'指定主键,只要是能唯一区分行的列即可,并非一定要表的实际主键.False
    \'.Primarykey = "_Identify" \'设置主键
    .CreateFromDataTable(dt, False , "", "", "序号", "报告编号", cxnr, "客户名称", "样品名称") 
    \'DataTables("订单"),False【显示行号】,"客户=\'CS01【筛选】\'","日期 desc【排序】","产品","单价","数量","日期","审核"【列名】
    \'.Attribute="style=\'text-align:center;background-color:#FF4500;color:#fff;font-weight:bold\'"
    .Attribute = "style=\'text-align:center\'" \'居中
End With
\'设计菜单
With wb.AddActionSheet("", "menu")
    .Add("photo1", "样品照片").Attribute = "" \'showphoto
    \'.Add("photo1", "样品照片").Attribute = "" \'showphoto
    .Add("mnuCancel", "取消", "", True)
End With

\'生成换页按钮
With wb.AddButtonGroup("", "btg1", False)
    \'.Add("btnAdd", "增加订单").Attribute = ""
    .Add("mnuFirst", "第一页", "", "List.htm?page=0")
    .Add("mnuLast", "最末页", "", "List.htm?page=" & pages - 1)
End With
With wb.AddButtonGroup("", "btg2", False)
    If page > 0 Then
        .Add("btnPrev", "上一页", "", "List.htm?page=" & page - 1)
    Else
        .Add("btnPrev", "上一页").Kind = 1
    End If
    If Endrow < count Then
        .Add("btnNext", "下一页", "", "List.htm?page=" & page + 1)
    Else
        .Add("btnNext", "下一页").Kind = 1
    End If
End With
With wb.AddButtonGroup("", "btg3", False)
    If Filter = "流程状态 = \'完成\' OR 流程状态 = \'内部\' OR 流程状态 = \'加急\' OR 流程状态 = \'正常\' OR 流程状态 = \'新\' OR 流程状态 = \'OK\' OR 流程状态 = \'调档\' OR 流程状态  Is Null" Then
        .Add("mnuFilter", "筛选数据", "button").Attribute = ""
        \'.Add("mnuFilter", "筛选数据", "", "filterlist.htm")
    Else
        .Add("mnuUnFilter", "撤销筛选", "", "List.htm?page=0&unfilter=true")
    End If
    .Add("mnuCancel", "返回", "", "filterlist.htm").Kind = 2
    \'.Add("photo", "照片", "button").Attribute = "" \'showphoto
End With
‘wb.AppendHTML("<script src=\'./lib/ajaxform.js\'></script>") \'引入脚本文件
’e.WriteString(wb.Build)
[此贴子已经被作者于2023/9/1 9:54:34编辑过]

--  作者:有点蓝
--  发布时间:2023/9/1 9:54:00
--  
上传的文件默认就有扩展名的,不需要另外处理。另外文件还没有保存,不能使用这种用法:Dim ifo As New FileInfo( fln)

               Dim ifo As New FileInfo( fln)
                Dim Str2 As String = Str1 & "-" & CStr(i) & ifo.Extension \'返回文件扩展名
                e.SaveFile(key, fln, filename & Str2) \'保存接收到的文件
改为
                Dim Str2 As String = Str1 & "-" & CStr(i) & fln.split(".")(1) \'返回文件扩展名
                e.SaveFile(key, fln, filename & Str2) \'保存接收到的文件

--  作者:fanjq8686
--  发布时间:2023/9/1 10:02:00
--  
改后试了,没有作用。
--  作者:有点蓝
--  发布时间:2023/9/1 10:05:00
--  
调试看还有哪一句代码出错
--  作者:fanjq8686
--  发布时间:2023/9/1 10:35:00
--  
过程和原来一样,而且上传的文件名变成了:FB20230759照片-XXXX2309011032-1tencent,不正确。
--  作者:fanjq8686
--  发布时间:2023/9/1 10:41:00
--  
文件名称上传我在另一个函数里用没报错,我感觉还是url的问题,蓝版能再帮我看看吗,应该如何写?

\'-----url变化的状态-----------------------------------------------------------------------------------        
        \'Dim url As String = "showphoto.htm?page=" & page & "&key=" & dr("报告编号") \'\'不能上传,运行错误:调用的目标发生了异常,提醒“上传失败”,显示正常页面。   传递页码和订单编号
        \'Dim url As String = "showphoto.htm" \'不能上传,运行错误:调用的目标发生了异常,提醒“上传失败”,显示正常页面
        \'Dim url As String = "Upload.htm" \'不能上传,运行错误:调用的目标发生了异常,提醒“上传失败”,显示正常页面
        Dim url As String = "Upload.htm?page=" & page & "&key=" & dr("报告编号") \'可以上传,运行错误:调用的目标发生了异常,提醒“上传成功”,不能显示正常页面
\'------url变化的状态----------------------------------------------------------------------------------