专家坐堂-照相上传Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  照相上传  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=104415)

--  作者：刘林
--  发布时间：2017/7/28 17:11:00
--  照相上传

Case "zc.htm"
wb.AddPageTitle("","pageheader","内江市教务系统","欢迎新用户注册使用")
If e.PostValues.Count = 0 Then
wb.AddForm("","form1","zc.htm")
Dim qxs As List(of String) = DataTables("学校信息").GetValues("区县")
With wb.AddInputGroup("form1","ipg1","")
.AddInput("姓名","姓名","Text") \'前一个"姓名"是ID,后一个"姓名"是标题
.AddInput("身份证号","身份证号","text")
.AddSelect("角色","角色","|教务主任|教师|学生")
.AddSelect("区县","区县","|" & String.Join("|",qxs.ToArray)).Attribute = "" \'调用js函数.
.AddSelect("group", "单位名称","")
.AddInput("password","登录密码:","password").placeholder ="请输入六位密码"
.AddUploader("up1","照片") \'True表示允许上传多个文件
End With
With wb.AddButtonGroup("form1","btg1",False)
.Add("btn1", "确定注册", "submit")
.Add("btn2", "返回登录", "", "logon.htm")
End With
For Each qx As String In qxs
wb.InsertHTML("<p hidden id=\'" & qx & "\'>" & "|" & DataTables("学校信息").GetComboListString("单位全称","区县=\'" & qx & "\'") & "</p>")
Next
wb.AppendHTML("<script src=\'./lib/brands.js\'></script>") \'引入脚本文件
e.WriteString(wb.Build) \'生成网页
Else
Dim nms() As String = {"姓名","身份证号","角色","区县","group","password"} \'不能为空的列名数组
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
Dim dr1 As DataRow = DataTables("用户").sqlfind("身份证号= \'" & e.PostValues("身份证号") & "\'")
If dr1 IsNot Nothing
With wb.AddMsgPage("","msgpage","注册失败", "该身份证号已注册,不能重复注册")
.icon = "Warn" \'改变图标
.AddButton("btn1","返回").Attribute = ""
End With
e.WriteString(wb.Build)
Return \'必须返回
End If
nms = New String() {"姓名","身份证号","角色","区县","group","password"} \'重新定义了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
e.SaveFile(key, fln, ProjectPath & "Attachments\\" & e.postvalues("身份证号") & "." & fln.split(".")(1))
dr("相片") = IIF(dr.isnull("相片"),"",dr("相片") & vbcrlf) & e.postvalues("身份证号") & "." & fln.split(".")(1)
dr.save()
With wb.AddMsgPage("","msgpage","注册成功", "欢迎您的加入") \'生成成功提示页
.AddButton("btn1","继续注册","zc.htm")
End With
e.WriteString(wb.Build)
End If

提示未定义key,请老师帮看下该怎样改

--  作者：有点甜
--  发布时间：2017/7/28 18:32:00
--
For Each fln As String In e.Files(key)
    e.SaveFile(key, fln, ProjectPath & "Attachments\\" & e.postvalues("身份证号") & "." & fln.split(".")(1))
Next

--  作者：刘林
--  发布时间：2017/7/28 18:36:00
--
还是说未声明key

--  作者：有点甜
--  发布时间：2017/7/28 18:42:00
--
For Each fln As String In e.Files("up1")
    e.SaveFile("up1", fln, ProjectPath & "Attachments\\" & e.postvalues("身份证号") & "." & fln.split(".")(1))
Next

--  作者：刘林
--  发布时间：2017/7/28 19:06:00
--

Case "zc.htm"
wb.AddPageTitle("","pageheader","内江市教务系统","欢迎新用户注册使用")
If e.PostValues.Count = 0 Then
wb.AddForm("","form1","zc.htm")
Dim qxs As List(of String) = DataTables("学校信息").GetValues("区县")
With wb.AddInputGroup("form1","ipg1","")
.AddInput("姓名","姓名","Text") \'前一个"姓名"是ID,后一个"姓名"是标题
.AddInput("身份证号","身份证号","text")
.AddSelect("角色","角色","|教务主任|教师|学生")
.AddSelect("区县","区县","|" & String.Join("|",qxs.ToArray)).Attribute = "" \'调用js函数.
.AddSelect("group", "单位名称","")
.AddInput("password","登录密码:","password").placeholder ="请输入六位密码"
With .AddUploader("up1","照片")
.ScaleWidth = 400 \'自动压缩图片宽度为400个像素,高度等比例压缩
End With
End With
With wb.AddButtonGroup("form1","btg1",False)
.Add("btn1", "确定注册", "submit").Attribute= ""
.Add("btn2", "返回登录", "", "logon.htm")
End With
For Each qx As String In qxs
wb.InsertHTML("<p hidden id=\'" & qx & "\'>" & "|" & DataTables("学校信息").GetComboListString("单位全称","区县=\'" & qx & "\'") & "</p>")
Next
wb.AppendHTML("<script src=\'./lib/brands.js\'></script>") \'引入脚本文件
e.WriteString(wb.Build) \'生成网页
Else
Dim nms() As String = {"姓名","身份证号","角色","区县","group","password"} \'不能为空的列名数组
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
Dim dr1 As DataRow = DataTables("用户").sqlfind("身份证号= \'" & e.PostValues("身份证号") & "\'")
If dr1 IsNot Nothing
With wb.AddMsgPage("","msgpage","注册失败", "该身份证号已注册,不能重复注册")
.icon = "Warn" \'改变图标
.AddButton("btn1","返回").Attribute = ""
End With
e.WriteString(wb.Build)
Return \'必须返回
End If
nms = New String() {"姓名","身份证号","角色","区县","group","password"} \'重新定义了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
For Each fln As String In e.Files("up1")
e.SaveFile("up1", fln, ProjectPath & "Attachments\\" & e.postvalues("身份证号") & "." & fln.split(".")(1))
dr("相片") = IIF(dr.isnull("相片"),"",dr("相片") & vbcrlf) & e.postvalues("身份证号") & "." & fln.split(".")(1)
Next

dr.save()
With wb.AddMsgPage("","msgpage","注册成功", "欢迎您的加入") \'生成成功提示页
.AddButton("btn1","继续注册","zc.htm")
End With
e.WriteString(wb.Build)
End If

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

非常谢谢,对了，基本实现了需要，还有1.图片压缩,我按例子改了这句 .Add("btn1", "确定注册", "submit").Attribute= "",不晓得对不对，好像没有压缩起。2.文件不放在本地，放在FTP服务器，上之前图片列能打开，现在不能连接，请问是什么原因，该怎么办？谢谢,另外系统在阿里云服务器上开启是不是文件不用放在FTP上

--  作者：有点蓝
--  发布时间：2017/7/28 20:17:00
--
仔细看帮助的说明，不要只抄代码：http://www.foxtable.com/mobilehelp/scr/0251.htm

--  作者：刘林
--  发布时间：2017/7/28 21:41:00
--
.Incremental = True 老师，我看了下要加这句，但加了提示字典中不存在关键值，是什么原因，谢谢

--  作者：有点蓝
--  发布时间：2017/7/28 21:50:00
--
还是没有仔细看帮助：

要实现图片的压缩上传，单单设置ScaleWidth或ScaleHeight是不够的，我们还需要将Uploader的Incremental属性设置为True，所以和上一节一样，我们只能用submitAjaxForm函数提交表单，不过代码依旧很简单。

表单提交应该没有做对

--  作者：刘林
--  发布时间：2017/8/10 12:25:00
--

Case "", "default.htm" \'首页
\'Dim dr As DataRow = DataTables("成绩").sqlfind("身份证件号 = \'" & e.Cookies("username") & "\'")
\' Dim xssm As String =dr("姓名")
wb.AddPageTitle("","pageheader","内江市教务系统","个人主页")
With wb.AddGrid("","g1")
.Add("c1","我的成绩", "./images/21.png","cjcx.htm")
.Add("c2","上传照片", "./images/22.png", "upload.htm")
.Add("c3","销售统计", "./images/23.png", "http://www.foxtable.com")
.Add("c4","Dialog", "./images/24.png", "http://www.foxtable.com")
.Add("c5","Progress", "./images/25.png", "http://www.foxtable.com")
.Add("c6","Msg", "./images/26.png", "http://www.foxtable.com")
.Add("c7","Article", "./images/27.png", "http://www.foxtable.com")
.Add("c8","ActionSheet", "./images/28.png", "http://www.foxtable.com")
.Add("c9","Icons", "./images/29.png", "http://www.foxtable.com")
.Add("c10","Panel", "./images/30.png", "http://www.foxtable.com")
.Add("c11","返回", "./images/31.png","zc.htm")
.Add("c12","退出", "./images/32.png", "exit.htm") \'退出登录
End With

Case "upload.htm"
\'Dim wb As New weui
wb.AddForm("","form1","receive.htm")
With wb.AddInputGroup("form1","ipg1","文件上传")
With .AddUploader("up128","照片",True)
.AllowDelete = True \'允许删除
.Incremental = False \'允许重复选择文件或连续拍照
.ScaleWidth = 100 \'自动压缩图片宽度为400个像素,高度等比例压缩
End With
End With
With wb.AddButtonGroup("form1","btg1",True)
.Add("btn1", "确定", "button").Attribute= "" \'调用js函数上传
.Add("btn2", "退出","","default.htm").kind=1

End With
wb.AddToast("","tst1", "正在上传",1)
wb.AddToast("","tst2", "上传成功",0)
wb.AddToast("","tst3", "上传失败",0).Icon= "warn"
wb.AppendHTML("<script src=\'./lib/ajx.js\'></script>") \'引入脚本文件
e.WriteString(wb.Build) \'生成网页
Case "receive.htm"
Dim dr As DataRow = DataTables("用户").sqlfind("身份证号= \'" & e.Cookies("username") & "\'")
For Each key As String In e.Files.Keys
For Each fln As String In e.Files(key)
e.SaveFile(key,fln,"c:\\data\\xp\\" & e.Cookies("username") & "." & fln.split(".")(1)) \'保存接收到的文件
dr("相片") = e.Cookies("username") & "." & fln.split(".")(1)
Next
Next
dr.save
DataTables("用户").loadfilter="身份证号=\'" & e.Cookies("username") & "\'"
DataTables("用户").load
e.WriteString("OK")
老师，请问我上面代码图片能上传了，但压缩好像还是没得行，我测试了目标图片与传上后图片没有变大小，请问是什么原因，请帮指导ajx.js文件写了的。

--  作者：有点甜
--  发布时间：2017/8/10 13:05:00
--

照抄帮助文档测试

http://www.foxtable.com/mobilehelp/scr/0251.htm

如果你写得有问题，就对比和帮助文档差异。