专家坐堂-weiui显示上传进度，怎么先检查表单是否完整，后上传Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

\'网页,生成装车单

\'网页上显示,装车单

Dim e As RequestEventArgs = args(0)

Dim tsbh As String = "" \'投诉编号

If e.GetValues.ContainsKey("tsbh") Then \'如果地址中有tsbh参数

tsbh=e.GetValues("tsbh") \'提取投诉编号

Else

e.WriteString ("地址错误")

End If

Dim tsclh As String \'投诉处理号

Dim userid As Integer \'用户ID

Dim username As String \'用户名

Dim udeptid As String \'部门ID

\'Dim drtsts As DataRow = DataTables("投诉推送")

\'\'\'企业微信权限判断

\'\'Dim QyWxYh As String = Functions.Execute("QyWxAuthUser",e,UrlEncode(e.Request.URL.ToString))

\'\'If QyWxYh = "False" Then \'未获取企业微信用户账号

\'\'Return 0

\'\'Else \'查找有无权限新增记录

\'Dim dttsts As DataRow = DataTables("投诉推送").SQLFind("投诉单编号=\'" & tsbh & "\' And 企业微信 =\'" & QyWxYh & "\'" )

\'If dttsts Is Nothing Then

\'e.WriteString("你未收到处理此案件的邀请!")

\'Return 0

\'Else

\'tsclh = dttsts("投诉处理号")

\'Dim druser As DataRow = DataTables("V用户表").SQLFind("Sys_UId=" & dttsts("用户Id"))

\'If druser IsNot Nothing Then

\'userid = druser("Sys_UId")

\'username = druser("姓名")

\'udeptid =druser("部门ID")

\'Else

\'e.WriteString("你未在系统登记,暂不能处理此事件!")

\'Return 0

\'End If

\'\'\'\'\'调试段\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'

Dim QyWxYh As String ="ZhaoYuQing"

Dim dttsts As DataRow = DataTables("投诉推送").SQLFind("投诉单编号=\'" & tsbh & "\' And 企业微信 =\'" & QyWxYh & "\'" )

If dttsts Is Nothing Then

e.WriteString("你未收到处理此案件的邀请!")

Return 0

Else

tsclh = dttsts("投诉处理号")

Dim druser As DataRow = DataTables("V用户表").SQLFind("Sys_UId=" & dttsts("用户Id"))

If druser IsNot Nothing Then

userid = druser("Sys_UId")

username = druser("姓名")

udeptid =druser("部门ID")

End If

\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'调试段结束\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'

Dim wb As New WeUI

wb.InsertHTML("<h3 align=\'center\' style=\'margin-top:5px\'>投诉跟进</h3>") \'网页头

wb.AppendHTML("<script >var localurl = \'" & e.Request.URL.ToString & "\';</script>",True) \'传递参数

\'test,用于测试

\'查找数据

If e.PostValues.Count = 0 Then

wb.AddForm("","formgj",e.Request.URL.ToString)

With wb.AddInputGroup("formgj","ipg1","增加处理记录")

.AddInput("调查方式","调查方式","text")

.AddHidenValue("投诉编号",tsbh)

.AddHidenValue("处理编号",tsclh)

.AddHidenValue("处理人",username)

.AddHidenValue("处理日期",Format(Date.Now,"G"))

End With

With wb.AddInputGroup("formgj","dcjgg","调查结果")

.AddTextArea("调查结果",3).Placeholder = "请输入调查结果"

End With

With wb.AddInputGroup("formgj","clyjg","处理意见")

.AddTextArea("处理意见",3).Placeholder = "请输入处理意见"

End With

With wb.AddInputGroup("formgj","qtg","其他要说明的")

.AddTextArea("其他",3).Placeholder = "请输入基他要说明的内容"

End With

With wb.AddInputGroup("formgj","fjg","上传附件") \'文件上传

With .AddUploader("附件","附件",True)

.AllowDelete = True \'允许用户删除图片

End With

With wb.AddButtonGroup("formgj","btg2", False) \'水平排列

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

End With

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

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

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

wb.AddToast("","tst4", "填写不完整",0).Icon= "warn"

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

wb.InsertHTML("<h4 align=\'Left\' style=\'margin-top:5px\'>--END--转发无效--</h4>") \'结束标记

wb.AddPageFooter("","pf1","丰园销售售后管理系统")

e.WriteString(wb.Build) \'生成网页

Else \'保存提交事件

Dim nms() As String = {"投诉编号","处理编号","调查方式","调查结果","处理意见","处理人","处理日期"} \'不能为空的列名数组

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)

e.WriteString("FalseNrqs")

Return 0 \'必须返回

End If

\'增加记录到投诉跟进

nms = New String() {"投诉编号","处理编号","调查方式","调查结果","处理意见","其他","处理人","处理日期"} \'重新定义了nms数组,增加了两列.

Dim dr As DataRow = DataTables("投诉跟进").AddNew()

For Each nm As String In nms

If e.PostValues.ContainsKey(nm) Then

dr(nm) = e.PostValues(nm)

End If

dr.Save

\'处理附件

For Each key As String In e.Files.Keys

If key = "附件" Then

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

If e.Host = "scglxt.hnfyqy.com" Then \'如果是正常状态,直接保存至

Dim RealFileNamePreNUm As Integer = Functions.Execute("GetAutoNo","附件","附件编号",Format(Date.Today,"yyyyMMdd"))

Dim RealFileName As String = Format(Date.Today,"yyyyMMdd") & Format(RealFileNamePreNUm ,"000") & "-" & fln

e.SaveFile(key, fln, "D:\\销售售后FTP\\投诉跟进A附件\\" & RealFileName)

\'填加到附件记录中

Dim LDtNames() As String = {"SysCaseLink"}

Functions.Execute("LoadDt",LDtNames,False) \'加载表

Dim rcase As Row = Tables("SysCaseLink").AddNew

rcase("Case_Id") = Functions.Execute("GetAutoNo","SysAutoNumber","Case_Id","")

rcase("Case_Name") = fln

rcase("Case_RealPath") = "投诉跟进A附件"& "\\" & RealFileName

rcase("Sys_CreatBy") = userid

rcase("Sys_CreatDeptId") =udeptid

rcase("Sys_CreatTime") = Date.Now

rcase("Table_Name")= "投诉跟进"

rcase("Table_Field")= "附件"

rcase("Table_Iden")= dr("_Identify")

rcase.Save

MessageBox.Show("a")

Else

Dim localfile As String = ProjectPath & "附件\\" & fln

e.SaveFile(key, fln,localfile )

If Functions.Execute("CasUp",dr,"附件",localfile,userid,udeptid)="ok" Then

If FileSys.FileExists(localfile) Then \'如果指定的文件存在

FileSys.DeleteFile(localfile,2,2) \'则彻底删除之

End If

Else

End If

e.WriteString("OK")

\'With wb.AddMsgPage("","msgpage","处理结果增加成功", "处理已提交!") \'生成成功提示页

\'.AddButton("btn1","继续增加",e.Request.URL.ToString)

\'End With

End If

e.Handled = True \'通知系统异步函数执行完毕,可以关闭信道

JS代码

function submitWithProgress(){

var result = submitAjaxForm(\'formgj\',\'afterSubmit\',true,\'tst1\');

}

function afterSubmit(result){

hide("tst1");

if (result==\'OK\') {

show("tst2");

location=localurl;

}

else if (result==\'FalseNrqs\'){

show("tst4",2000);

}

else {

show("tst3",2000);

}