'网页,生成装车单
'网页上显示,装车单
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
'End If
'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
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
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
Next
'增加记录到投诉跟进
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
Next
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
End If
Next
End If
Next
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);
}
}
加好友 
发短信
Post By：2019/9/9 20:07:00 [只看该作者]
