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) '生成网页
加好友 
发短信
Post By：2023/9/1 9:11:00 [只看该作者]
