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
Select Case e.Path
Case "xzcpqd.htm"
Dim wb As New weui
If e.PostValues.Count = 0 Then
wb.AddForm("","form1","receive.htm")
With wb.AddInputGroup("form1","ipg1","图片上传")
With .AddUploader("up1","照片",True)
.AllowDelete = True '允许删除
.Incremental = True '允许 重复选择文件或连续拍照
End With
End With
With wb.AddButtonGroup("form1","btngrp1",False)
.Add("btn1", "上传", "button").Attribute= "" '调用js函数上传
End With
wb.AddToast("","tst1", "正在上传",1)
wb.AddToast("","tst2", "上传成功",0).Icon= "warn"
wb.AddToast("","tst3", "上传失败",0).Icon= "warn"
wb.AppendHTML("<script src='./lib/tpsc.js'></script>")
wb.AddForm("","form2","xzcpqd.htm")
With wb.AddInputGroup("form2","ipg2","新增产品")
With .AddInputCell("ic1")
.AddLabel("bh","编号",0)
.AddInput("编号","text",1)
.AddVcodeButton("scan","扫码输入",2) '增加二维码扫描按钮,2表示显示在右边
End With
.AddInput("产品","产品","text")
End With
With wb.AddButtonGroup("form2","btngrp2",False)
'.Add("btn1", "上传", "button").Attribute= "" '调用js函数上传
.Add("btn1", "增加", "submit")
.Add("btn2", "取消", "reset") '重置
.Add("btn3", "返回", "" ,"default.htm")
End With
'wb.AppendHTML("<script src='./lib/calc.js'></script>")
'wb.AddForm("","form2","receive.htm")
'With wb.AddInputGroup("form2","ipg2","图片上传")
'With .AddUploader("up1","照片",True)
'.AllowDelete = True '允许删除
'.Incremental = True '允许 重复选择文件或连续拍照
'End With
'End With
'With wb.AddButtonGroup("form2","btg1",True)
'.Add("btn1", "上传", "button").Attribute= "" '调用js函数上传
'End With
'wb.AddToast("","tst1", "正在上传",1)
'wb.AddToast("","tst2", "上传成功",0).Icon= "warn"
'wb.AddToast("","tst3", "上传失败",0).Icon= "warn"
'wb.AppendHTML("<script src='./lib/tpsc.js'></script>") '引入脚本文件
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)
Return '必须返回
End If
Next
nms = New String() {"产品","编号"} '重新定义了nms数组,增加了两列.
Dim dr As DataRow = DataTables("产品清单").AddNew()
dr("新增人") = e.Cookies("username")
'dr("照片") = e.PostValues("up1")
For Each nm As String In nms
If e.PostValues.ContainsKey(nm) Then
dr(nm) = e.PostValues(nm)
End If
Next
'For Each key As String In e.Files.Keys
'If key = "up1" Then
'For Each fln As String In e.Files(key)
'e.SaveFile(key, fln,"d:\web\images\" & fln)
'Next
'dr("照片") = e.Files(key)
'End If
'Next
e.WriteString("OK")
dr.save()
With wb.AddMsgPage("","msgpage","增加成功","") '生成成功提示页
.AddButton("btn1","继续增加","xzcpqd.htm")
End With
e.WriteString(wb.Build)
End If
Case "receive.htm"
For Each key As String In e.Files.Keys
For Each fln As String In e.Files(key)
e.SaveFile(key,fln,"d:\web\images\" & fln) '保存接收到的文件
Next
Next
e.WriteString("OK")
End Select
加好友 
发短信
Post By：2017/11/1 11:45:00 [只看该作者]
