asp上传图片实现每月创建文件夹存储当月上传的图片
2007-12-31 11:10
489 查看
最近刚做了一个asp 上传图片的程序,该程序可实现同时上传表单和多张图片,现增加了一个功能,能实现每月创建文件夹存储当月上传的图片,现将代码传上来,供大家参考,希望大家多多指正.
1.建立数据库,我用的是access数据库
id 自动编号
.................................. '用于存储表单内容
userfilepate '用于存储图片路径
........................... '可存储上传多个图片的路径
2.上传页面:asp.asp
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>验证会员填写认证资料</title>
<style type="text/css">
<!--
.STYLE1 {color: #FF0000}
.STYLE2 {
font-size: 18px;
color: #3333CC;
font-weight: bold;
}
-->
</style>
<STYLE>
BODY {cursor:default}
.STYLE3 {color: #D4D0C8}
.STYLE4 {color: #0000FF}
body {
background-color: #00CCCC;
}
</STYLE>
</head>
<body onload="webClock()">
<p align="center" class="STYLE2">交易准入资格认证</p>
<form name="form1" method="post" action="uptodir.asp" enctype="multipart/form-data" onsubmit="return checkdata();">
<table width="669" border="0" cellspacing="0" cellpadding="0" id="table1" align="center">
<tr>
<td width="28%" bgcolor="#00CCCC"><span class="STYLE4">用户名:<font class="Need STYLE1">*</font></span></td>
<td width="35%" bgcolor="#00CCCC"><input name="username" type="text" onblur="checkdata()" /></td>
<td id="message1"></td>
</tr>
<tr>
<td width="28%" bgcolor="#00CCCC"><span class="STYLE4">姓名:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC"><input name="name" type="text" onblur="checkdata()" /> </td>
<td id="message2"></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%"><span class="STYLE4">性别:<font class="Need STYLE1">*</font></span></td>
<td><span class="STYLE4">
<select name="sex">
<option>男</option>
<option>女</option>
</select>
</span> </td>
</tr>
<tr>
<td width="28%" valign="top" bgcolor="#00CCCC"><span class="STYLE4">邮政编码:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC"><input name="postcode" type="text" onblur="checkdata()" size="20" maxlength="6" /> </td>
<td id="message3"><span class="red"></span> </td>
</tr>
<tr>
<td width="28%" valign="top" bgcolor="#00CCCC"><span class="STYLE4">通信地址:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC"><input name="mailaddress" type="text" onblur="checkdata()" /> </td>
<td id="message4"></td>
</tr>
<tr>
<td width="28%" valign="top" bgcolor="#00CCCC"><span class="STYLE4">身份证地址:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC"><input name="accountaddress" type="text" onblur="checkdata()" /> </td>
<td id="message5"></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" valign="top"><span class="STYLE4">职业:</span></td>
<td><input name="vocational" type="text"/></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" valign="top"><span class="STYLE4">职务:</span></td>
<td><input name="position" type="text"/></td>
</tr>
<tr>
<td width="28%" valign="top" bgcolor="#00CCCC"><span class="STYLE4">常用电话:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC" id="sss"><input name="homephone" type="text" onblur="clean()" onkeyup="change()" /> </td>
<td id="message" width="37%" bordercolorlight=#FF5050></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" valign="top"><span class="STYLE4">电子邮件:</span></td>
<td><input name="email" type="text"/></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" valign="top"><span class="STYLE4">单位或宿舍固定电话:</span></td>
<td><input name="telephone" type="text"/></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" valign="top"><span class="STYLE4">传真:</span></td>
<td><input name="fax" type="text"/></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" valign="top"><span class="STYLE4">手机:</span></td>
<td><input name="mobile" type="text"/></td>
</tr>
<tr>
<td width="28%" valign="top" bgcolor="#00CCCC"><span class="STYLE4">身份证号码:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC"><input name="cardnumber" type="text" onkeyup="checkcardnumber();" /> </td>
<td id="message7"></td>
</tr>
<tr>
<td width="28%" valign="top" bgcolor="#00CCCC"><span class="STYLE4">常用银行帐号:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC"><span class="STYLE4">
<select name="bankaccount">
<option></option>
<option>邮政</option>
<option>农行</option>
<option>工行</option>
<option>建行</option>
<option>交行</option>
<option>招行</option>
<option>中行</option>
<option>浦发</option>
</select>
<input name="bankaccount" type="text" maxlength="36" onblur="return checkdata()" />
</span> </td>
<td id="message6"></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%"><span class="STYLE4">备用银行帐号:</span></td>
<td><span class="STYLE4">
<label>
<textarea name="reservebankaccount" >
</textarea>
</label>
</span></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%"><span class="STYLE4">备用说明:</span></td>
<td><span class="STYLE4">
<label>
<textarea name="reservenote" >
</textarea>
</label>
</span>
</td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" height="83"><span class="STYLE4">上传身份证图片:</span><font class="Need STYLE1">*</font></td>
<td height="83"><span class="STYLE4">
<input type="file" name="file1" id="file1" onblur="return checkdata()"/>
</span></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" height="83"><span class="STYLE4">上传电话单图片:</span></td>
<td><span class="STYLE4">
<input type="file" name="file2" id="file2" onchange="picForm_Validator1()"/>
</span></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" height="83"><span class="STYLE4">上传汇款凭据:</span></td>
<td><span class="STYLE4">
<input type="file" name="file3" id="file3" onchange="picForm_Validator2()"/>
</span></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" height="83"><span class="STYLE4">上传其它认证图片:</span></td>
<td><span class="STYLE4">
<input type="file" name="file4" id="file4" onchange="picForm_Validator3()"/>
</span></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" height="83"><span class="STYLE4">上传其它认证图片:</span></td>
<td><span class="STYLE4">
<input type="file" name="file5" id="file5" onchange="picForm_Validator4()"/>
</span></td>
</tr>
<tr bgcolor="#00CCCC">
<td align =center><input name="Submit" type="submit" onclick="checkdata()" value="上传" /></td>
<td><input name="Submit2" type="reset" value="重置" /> </td>
</tr>
</table>
<p></p>
今天是：<input type="text" name="ddate" size="12" disabled="disabled">
现在时间：<input type="text" name="dtime" size="10" disabled="disabled"><br>
</form>
</body>
<script type="text/javascript" language="JavaScript">
var strTime,strDate;
function webClock()
{
var dNow = new Date();
var dHours = dNow.getHours();
var dMinutes = dNow.getMinutes();
var dSeconds = dNow.getSeconds();
strTime = dHours;
strTime += ((dMinutes<10)?":0":":")+dMinutes;
strTime += ((dSeconds<10)?":0":":")+dSeconds;
form1.dtime.value = strTime;
var dDate = dNow.getDate();
var dMonth = dNow.getMonth()+1;
var dYear = dNow.getYear();
strDate = dYear + "年";
strDate += ((dMonth<10)?"0":"")+dMonth + "月";
strDate += dDate + "日";
form1.ddate.value = strDate;
setTimeout("webClock()",1000);
}
</script>
<script language="JavaScript">
function change(){
document.getElementById("message").innerHTML="家庭电话，手机";
}
function clean(){
document.getElementById("message").innerHTML="";
}
</script>
<SCRIPT language=JavaScript>
function checkdata() {
if(document.form1.username.value.length==0){
document.getElementById("message1").innerHTML="用户名不能为空";
return false;
}
else{
document.getElementById("message1").innerHTML="";
}
if(document.form1.name.value.length==0){
document.getElementById("message2").innerHTML="姓名不能为空";
return false;
}
else{
document.getElementById("message2").innerHTML="";
}
if(document.form1.postcode.value.length==0){
document.getElementById("message3").innerHTML="邮政编码不能为空";
return false;
}
else{
document.getElementById("message3").innerHTML="";
}
if(document.form1.mailaddress.value.length==0){
document.getElementById("message4").innerHTML="通信地址不能为空";
return false;
}
else{
document.getElementById("message4").innerHTML="";
}
if(document.form1.accountaddress.value.length==0){
document.getElementById("message5").innerHTML="身份证地址不能为空";
return false;
}
else{
document.getElementById("message5").innerHTML="";
}
if(document.form1.bankaccount.value.length==0){
document.getElementById("message6").innerHTML="常用银行帐号不能为空";
return false;
}
else{
document.getElementById("message6").innerHTML="";
}
}
function checkcardnumber(){
var str=parseInt(document.all.cardnumber.value.length);
if(str!=15 && str!=18){
document.getElementById("message7").innerHTML="身份证号码不能为空且只能为15位和18位数字";
return false;
}
else{
document.getElementById("message7").innerHTML="";
}
}
</SCRIPT>
<script Language="JavaScript" Type="text/javascript">
function picForm_Validator(myform)
{
if(document.all.file1.value=="")
{
alert("请选择上传的照片！");
myform.mfile.focus();
return false;
}
var last=document.all.file1.value.match(/^(.*)(/.)(.{1,8})$/)[3]; //检查上传文件格式
last=last.toUpperCase();
if(last=="GIF" || last=="JPG" || last=="JPEG"){
}
else
{
alert("只能上传.GIF,JPEG 或.JPG 文件,请重新选择！");
parent.location.href="asp.asp";
return false;
}
return true;
}
function picForm_Validator1(myform)
{
if(document.all.file2.value=="")
{
alert("请选择上传的照片！");
myform.mfile.focus();
return false;
}
var last=document.all.file2.value.match(/^(.*)(/.)(.{1,8})$/)[3]; //检查上传文件格式
last=last.toUpperCase();
if(last=="GIF" || last=="JPG" || last=="JPEG"){
}
else
{
alert("只能上传.GIF,JPEG 或.JPG 文件,请重新选择！");
parent.location.href="asp.asp";
return false;
}
return true;
}
function picForm_Validator2(myform)
{
if(document.all.file3.value=="")
{
alert("请选择上传的照片！");
myform.mfile.focus();
return false;
}
var last=document.all.file3.value.match(/^(.*)(/.)(.{1,8})$/)[3]; //检查上传文件格式
last=last.toUpperCase();
if(last=="GIF" || last=="JPG" || last=="JPEG"){
}
else
{
alert("只能上传.GIF,JPEG 或.JPG 文件,请重新选择！");
parent.location.href="asp.asp";
return false;
}
return true;
}
function picForm_Validator3(myform)
{
if(document.all.file4.value=="")
{
alert("请选择上传的照片！");
myform.mfile.focus();
return false;
}
var last=document.all.file4.value.match(/^(.*)(/.)(.{1,8})$/)[3]; //检查上传文件格式
last=last.toUpperCase();
if(last=="GIF" || last=="JPG" || last=="JPEG"){
}
else
{
alert("只能上传.GIF,JPEG 或.JPG 文件,请重新选择！");
parent.location.href="asp.asp";
return false;
}
return true;
}
function picForm_Validator4(myform)
{
if(document.all.file5.value=="")
{
alert("请选择上传的照片！");
myform.mfile.focus();
return false;
}
var last=document.all.file5.value.match(/^(.*)(/.)(.{1,8})$/)[3]; //检查上传文件格式
last=last.toUpperCase();
if(last=="GIF" || last=="JPG" || last=="JPEG"){
}
else
{
alert("只能上传.GIF ,JPEG 或.JPG 文件,请重新选择！");
parent.location.href="asp.asp";
return false;
}
return true;
}
</script>
3.处理页面:uptodir.asp
<!-- #include file="Upload1.asp" -->
<!-- #include file="conn1.asp" -->
<%
Server.ScriptTimeout =20*60 '上传超时时间20分钟
dim userfilepath,userfilepath1,userfilepath2
set f=server.CreateObject("scripting.filesystemobject")
y=year(date)
m=month(date) '红色部分是实现每月创建文件夹
if len(m)<2 then m="0"&m
formPath = "UploadFiles/"&y&m&"/"
filename =server.mappath("UploadFiles/")&"/"&y&m&"/"
if not f.folderexists(filename) then f.createfolder(filename)
set f=nothing
Set upload= New DoteyUpload
Upload.SaveTo(formPath) '将文件根据其文件名统一保存在某路径下
If upload.ErrMsg = "" then
Response.Write ("form传递来的数据:<BR>")
For each formName in upload.Form ''列出所有form数据
temp=temp & "||" & upload.Form(formName) '用字符串存表单所有变量
next
temp2=split(temp,"||") '将字符串拆开存入数组
username=temp2(1)
name=temp2(2)
sex=temp2(3)
postcode=temp2(4)
mailaddress=temp2(5)
accountaddress=temp2(6)
vocational=temp2(7)
position=temp2(8)
homephone=temp2(9)
email=temp2(10)
telephone=temp2(11)
fax=temp2(12)
mobile=temp2(13)
cardnumber=temp2(14)
bankaccount=temp2(15)
reservebankaccount=temp2(16)
reservenote=temp2(17)
i=1
Response.Write ("<BR><BR>已经成功上传文件:<BR>")
set rs=server.createobject("adodb.recordset")
For Each formName In upload.Files ''列出所有上传了的文件
Set file = upload.Files(formName) ''生成一个文件对象
userfilepath=formPath & File.FileName
'判断
select case i
case 1
rs.open "submit",conn,1,3
rs.addnew
rs("username")=username
rs("name")=name
rs("sex")=sex
rs("postcode")=postcode
rs("mailaddress")=mailaddress
rs("accountaddress")=accountaddress
rs("vocational")=vocational
rs("position")=position
rs("homephone")=homephone
rs("email")=email
rs("telephone")=telephone
rs("fax")=fax
rs("mobile")=mobile
rs("cardnumber")=cardnumber
rs("bankaccount")=bankaccount
rs("reservebankaccount")=reservebankaccount
rs("reservenote")=reservenote
rs("ddate")=now()
rs("userfilepath").value=userfilepath
response.write "<hr>"
rs.update
rs.close
SQL="select top 1 id from submit ORDER BY ID DESC"
rs.open SQL,conn,1,3
MaxID = rs("ID")
rs.close
case 2
sql="select * from submit where id="&MaxID
rs.open sql,conn,1,3
rs("userfilepath1").value=userfilepath
response.write "<hr>"
rs.update
rs.close
case 3
sql="select * from submit where id="&MaxID
rs.open sql,conn,1,3
rs("userfilepath2").value=userfilepath
response.write "<hr>"
rs.update
rs.close
case 4
sql="select * from submit where id="&MaxID
rs.open sql,conn,1,3
rs("userfilepath3").value=userfilepath
response.write "<hr>"
rs.update
rs.close
case 5
sql="select * from submit where id="&MaxID
rs.open sql,conn,1,3
rs("userfilepath4").value=userfilepath
response.write "<hr>"
rs.update
rs.close
end select
i=i+1
Next
Else
Response.Write("上传过程中出现错误:<br>" & Upload.ErrMsg)
End If
Set file=nothing
Set upload=nothing
conn.close()
%><style type="text/css">
<!--
body {
background-color: #00CCCC;
}
-->
</style>
<BR><A HREF=http://192.168.1.108/index.asp>返回首页</A>
upload1.asp
<%
Dim DoteyUpload_SourceData
Class DoteyUpload
Public Files
Public Form
Public MaxTotalBytes
Public Version
Public ProgressID
Public ErrMsg
Private BytesRead
Private ChunkReadSize
Private Info
Private Progress
Private UploadProgressInfo
Private CrLf
Private Sub Class_Initialize()
Set Files = Server.CreateObject("Scripting.Dictionary") ' 上传文件集合
Set Form = Server.CreateObject("Scripting.Dictionary") ' 表单集合
UploadProgressInfo = "DoteyUploadProgressInfo" ' Application的Key
MaxTotalBytes = 1 *1024 *1024 *1024 ' 默认最大1G
ChunkReadSize = 64 * 1024 ' 分块大小64K
CrLf = Chr(13) & Chr(10) ' 换行
FileExt = "" ' 文件扩展名
Set DoteyUpload_SourceData = Server.CreateObject("ADODB.Stream")
DoteyUpload_SourceData.Type = 1 ' 二进制流
DoteyUpload_SourceData.Open
Version = "1.0 Beta" ' 版本
ErrMsg = "" ' 错误信息
Set Progress = New ProgressInfo
End Sub
' 将文件根据其文件名统一保存在某路径下
Public Sub SaveTo(path)
Upload() ' 上传
if right(path,1) <> "/" then path = path & "/"
' 遍历所有已上传文件
For Each fileItem In Files.Items
fileItem.FileName=Now()
fileItem.FileName=replace(fileItem.FileName," ", "")
fileItem.FileName=replace(fileItem.FileName,"-", "")
fileItem.FileName=replace(fileItem.FileName,":", "")
randomize
ranNum=int(90*rnd)+10
fileItem.FileName=fileItem.FileName&ranNum
fileItem.FileName=fileItem.FileName&".jpg"
fileItem.SaveAs path & fileItem.FileName
Next
' 保存结束后更新进度信息
Progress.ReadyState = "complete" '上传结束
UpdateProgressInfo progressID
End Sub
' 分析上传的数据，并保存到相应集合中
Public Sub Upload ()
Dim TotalBytes, Boundary
TotalBytes = Request.TotalBytes ' 总大小
If TotalBytes < 1 Then
Raise("无数据传入")
Exit Sub
End If
If TotalBytes > MaxTotalBytes Then
Raise("您当前上传大小为" & TotalBytes/1000 & " K，最大允许为" & MaxTotalBytes/1024 & "K")
Exit Sub
End If
Boundary = GetBoundary()
If IsNull(Boundary) Then
Raise("如果form中没有包括multipart/form-data上传是无效的")
Exit Sub ''如果form中没有包括multipart/form-data上传是无效的
End If
Boundary = StringToBinary(Boundary)
Progress.ReadyState = "loading" '开始上传
Progress.TotalBytes = TotalBytes
UpdateProgressInfo progressID
Dim DataPart, PartSize
BytesRead = 0
'循环分块读取
Do While BytesRead < TotalBytes
'分块读取
PartSize = ChunkReadSize
if PartSize + BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead
DataPart = Request.BinaryRead(PartSize)
BytesRead = BytesRead + PartSize
DoteyUpload_SourceData.Write DataPart
Progress.UploadedBytes = BytesRead
Progress.LastActivity = Now()
' 更新进度信息
UpdateProgressInfo progressID
Loop
' 上传结束后更新进度信息
Progress.ReadyState = "loaded" '上传结束
UpdateProgressInfo progressID
Dim Binary
DoteyUpload_SourceData.Position = 0
Binary = DoteyUpload_SourceData.Read
Dim BoundaryStart, BoundaryEnd, PosEndOfHeader, IsBoundaryEnd
Dim Header, bFieldContent
Dim FieldName
Dim File
Dim TwoCharsAfterEndBoundary
BoundaryStart = InStrB(Binary, Boundary)
BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary, 0)
Do While (BoundaryStart > 0 And BoundaryEnd > 0 And Not IsBoundaryEnd)
' 获取表单头的结束位置
PosEndOfHeader = InStrB(BoundaryStart + LenB(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))
' 分离表单头信息，类似于：
' Content-Disposition: form-data; name="file1"; filename="G:/homepage.txt"
' Content-Type: text/plain
Header = BinaryToString(MidB(Binary, BoundaryStart + LenB(Boundary) + 2, PosEndOfHeader - BoundaryStart - LenB(Boundary) - 2))
' 分离表单内容
bFieldContent = MidB(Binary, (PosEndOfHeader + 4), BoundaryEnd - (PosEndOfHeader + 4) - 2)
FieldName = GetFieldName(Header)
' 如果是附件
If InStr (Header,"filename=""") > 0 Then
Set File = New FileInfo
' 获取文件相关信息
Dim clientPath
clientPath = GetFileName(Header)
File.FileName = GetFileNameByPath(clientPath)
File.FileExt = GetFileExt(clientPath)
File.FilePath = clientPath
File.FileType = GetFileType(Header)
File.FileStart = PosEndOfHeader + 3
File.FileSize = BoundaryEnd - (PosEndOfHeader + 4) - 2
File.FormName = FieldName
' 如果该文件不为空并不存在该表单项保存之
If Not Files.Exists(FieldName) And File.FileSize > 0 Then
Files.Add FieldName, File
End If
'表单数据
Else
' 允许同名表单
If Form.Exists(FieldName) Then
Form(FieldName) = Form(FieldName) & "," & BinaryToString(bFieldContent)
Else
Form.Add FieldName, BinaryToString(bFieldContent)
End If
End If
' 是否结束位置
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, BoundaryEnd + LenB(Boundary), 2))
IsBoundaryEnd = TwoCharsAfterEndBoundary = "--"
If Not IsBoundaryEnd Then ' 如果不是结尾, 继续读取下一块
BoundaryStart = BoundaryEnd
BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary)
End If
Loop
' 解析文件结束后更新进度信息
Progress.UploadedBytes = TotalBytes
Progress.ReadyState = "interactive" '解析文件结束
UpdateProgressInfo progressID
End Sub
'异常信息
Private Sub Raise(Message)
ErrMsg = ErrMsg & "[" & Now & "]" & Message & "<BR>"
Progress.ErrorMessage = Message
UpdateProgressInfo ProgressID
'call Err.Raise(vbObjectError, "DoteyUpload", Message)
End Sub
' 取边界值
Private Function GetBoundary()
Dim ContentType, ctArray, bArray
ContentType = Request.ServerVariables("HTTP_CONTENT_TYPE")
ctArray = Split(ContentType, ";")
If Trim(ctArray(0)) = "multipart/form-data" Then
bArray = Split(Trim(ctArray(1)), "=")
GetBoundary = "--" & Trim(bArray(1))
Else '如果form中没有包括multipart/form-data上传是无效的
GetBoundary = null
Raise("如果form中没有包括multipart/form-data上传是无效的")
End If
End Function
' 将二进制流转化成文本
Private Function BinaryToString(xBinary)
Dim Binary
if vartype(xBinary) = 8 then Binary = MultiByteToBinary(xBinary) else Binary = xBinary
Dim RS, LBinary
Const adLongVarChar = 201
Set RS = CreateObject("ADODB.Recordset")
LBinary = LenB(Binary)
if LBinary>0 then
RS.Fields.Append "mBinary", adLongVarChar, LBinary
RS.Open
RS.AddNew
RS("mBinary").AppendChunk Binary
RS.Update
BinaryToString = RS("mBinary")
Else
BinaryToString = ""
End If
End Function
Function MultiByteToBinary(MultiByte)
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
if LMultiByte>0 then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
MultiByteToBinary = Binary
End Function
' 字符串到二进制
Function StringToBinary(String)
Dim I, B
For I=1 to len(String)
B = B & ChrB(Asc(Mid(String,I,1)))
Next
StringToBinary = B
End Function
'返回表单名
Private Function GetFieldName(infoStr)
Dim sPos, EndPos
sPos = InStr(infoStr, "name=")
EndPos = InStr(sPos + 6, infoStr, Chr(34) & ";")
If EndPos = 0 Then
EndPos = inStr(sPos + 6, infoStr, Chr(34))
End If
GetFieldName = Mid(infoStr, sPos + 6, endPos - _
(sPos + 6))
End Function
'返回文件名
Private Function GetFileName(infoStr)
Dim sPos, EndPos
sPos = InStr(infoStr, "filename=")
EndPos = InStr(infoStr, Chr(34) & CrLf)
GetFileName = Mid(infoStr, sPos + 10, EndPos - _
(sPos + 10))
End Function
'返回文件的 MIME type
Private Function GetFileType(infoStr)
sPos = InStr(infoStr, "Content-Type: ")
GetFileType = Mid(infoStr, sPos + 14)
End Function
'根据路径获取文件名
Private Function GetFileNameByPath(FullPath)
Dim pos
pos = 0
FullPath = Replace(FullPath, "/", "/")
pos = InStrRev(FullPath, "/") + 1
If (pos > 0) Then
GetFileNameByPath = Mid(FullPath, pos)
Else
GetFileNameByPath = FullPath
End If
End Function
'根据路径获取扩展名
Private Function GetFileExt(FullPath)
Dim pos
pos = InStrRev(FullPath,".")
if pos>0 then GetFileExt = Mid(FullPath, Pos)
End Function
' 更新进度信息
' 进度信息保存在Application中的ADODB.Recordset对象中
Private Sub UpdateProgressInfo(progressID)
Const adTypeText = 2, adDate = 7, adUnsignedInt = 19, adVarChar = 200
If (progressID <> "" And IsNumeric(progressID)) Then
Application.Lock()
if IsEmpty(Application(UploadProgressInfo)) Then
Set Info = Server.CreateObject("ADODB.Recordset")
Set Application(UploadProgressInfo) = Info
Info.Fields.Append "ProgressID", adUnsignedInt
Info.Fields.Append "StartTime", adDate
Info.Fields.Append "LastActivity", adDate
Info.Fields.Append "TotalBytes", adUnsignedInt
Info.Fields.Append "UploadedBytes", adUnsignedInt
Info.Fields.Append "ReadyState", adVarChar, 128
Info.Fields.Append "ErrorMessage", adVarChar, 4000
Info.Open
Info("ProgressID").Properties("Optimize") = true
Info.AddNew
Else
Set Info = Application(UploadProgressInfo)
If Not Info.Eof Then
Info.MoveFirst()
Info.Find "ProgressID = " & progressID
End If
If (Info.EOF) Then
Info.AddNew
End If
End If
Info("ProgressID") = clng(progressID)
Info("StartTime") = Progress.StartTime
Info("LastActivity") = Now()
Info("TotalBytes") = Progress.TotalBytes
Info("UploadedBytes") = Progress.UploadedBytes
Info("ReadyState") = Progress.ReadyState
Info("ErrorMessage") = Progress.ErrorMessage
Info.Update
Application.UnLock
End IF
End Sub
' 根据上传ID获取进度信息
Public Function GetProgressInfo(progressID)
Dim pi, Infos
Set pi = New ProgressInfo
If Not IsEmpty(Application(UploadProgressInfo)) Then
Set Infos = Application(UploadProgressInfo)
If Not Infos.Eof Then
Infos.MoveFirst
Infos.Find "ProgressID = " & progressID
If Not Infos.EOF Then
pi.StartTime = Infos("StartTime")
pi.LastActivity = Infos("LastActivity")
pi.TotalBytes = clng(Infos("TotalBytes"))
pi.UploadedBytes = clng(Infos("UploadedBytes"))
pi.ReadyState = Trim(Infos("ReadyState"))
pi.ErrorMessage = Trim(Infos("ErrorMessage"))
Set GetProgressInfo = pi
End If
End If
End If
Set GetProgressInfo = pi
End Function
' 移除指定的进度信息
Private Sub RemoveProgressInfo(progressID)
If Not IsEmpty(Application(UploadProgressInfo)) Then
Application.Lock
Set Info = Application(UploadProgressInfo)
If Not Info.Eof Then
Info.MoveFirst
Info.Find "ProgressID = " & progressID
If Not Info.EOF Then
Info.Delete
End If
End If
' 如果没有记录了, 直接释放, 避免'800a0bcd'错误
If Info.RecordCount = 0 Then
Info.Close
Application.Contents.Remove UploadProgressInfo
End If
Application.UnLock
End If
End Sub
' 移除指定的进度信息
Private Sub RemoveOldProgressInfo(progressID)
If Not IsEmpty(Application(UploadProgressInfo)) Then
Dim L
Application.Lock
Set Info = Application(UploadProgressInfo)
Info.MoveFirst
Do
L = Info("LastActivity").Value
If IsEmpty(L) Then
Info.Delete()
ElseIf DateDiff("d", Now(), L) > 30 Then
Info.Delete()
End If
Info.MoveNext()
Loop Until Info.EOF
' 如果没有记录了, 直接释放, 避免'800a0bcd'错误
If Info.RecordCount = 0 Then
Info.Close
Application.Contents.Remove UploadProgressInfo
End If
Application.UnLock
End If
End Sub
End Class
'---------------------------------------------------
' 进度信息 类
'---------------------------------------------------
Class ProgressInfo
Public UploadedBytes
Public TotalBytes
Public StartTime
Public LastActivity
Public ReadyState
Public ErrorMessage
Private Sub Class_Initialize()
UploadedBytes = 0 ' 已上传大小
TotalBytes = 0 ' 总大小
StartTime = Now() ' 开始时间
LastActivity = Now() ' 最后更新时间
ReadyState = "uninitialized" ' uninitialized,loading,loaded,interactive,complete
ErrorMessage = ""
End Sub
' 总大小
Public Property Get TotalSize
TotalSize = FormatNumber(TotalBytes / 1024, 0, 0, 0, -1) & " K"
End Property
' 已上传大小
Public Property Get SizeCompleted
SizeCompleted = FormatNumber(UploadedBytes / 1024, 0, 0, 0, -1) & " K"
End Property
' 已上传秒数
Public Property Get ElapsedSeconds
ElapsedSeconds = DateDiff("s", StartTime, Now())
End Property
' 已上传时间
Public Property Get ElapsedTime
If ElapsedSeconds > 3600 then
ElapsedTime = ElapsedSeconds / 3600 & " 时 " & (ElapsedSeconds mod 3600) / 60 & " 分 " & ElapsedSeconds mod 60 & " 秒"
ElseIf ElapsedSeconds > 60 then
ElapsedTime = ElapsedSeconds / 60 & " 分 " & ElapsedSeconds mod 60 & " 秒"
else
ElapsedTime = ElapsedSeconds mod 60 & " 秒"
End If
End Property
' 传输速率
Public Property Get TransferRate
If ElapsedSeconds > 0 Then
TransferRate = FormatNumber(UploadedBytes / 1024 / ElapsedSeconds, 2, 0, 0, -1) & " K/秒"
Else
TransferRate = "0 K/秒"
End If
End Property
' 完成百分比
Public Property Get Percentage
If TotalBytes > 0 Then
Percentage = fix(UploadedBytes / TotalBytes * 100) & "%"
Else
Percentage = "0%"
End If
End Property
' 估计剩余时间
Public Property Get TimeLeft
If UploadedBytes > 0 Then
SecondsLeft = fix(ElapsedSeconds * (TotalBytes / UploadedBytes - 1))
If SecondsLeft > 3600 then
TimeLeft = SecondsLeft / 3600 & " 时 " & (SecondsLeft mod 3600) / 60 & " 分 " & SecondsLeft mod 60 & " 秒"
ElseIf SecondsLeft > 60 then
TimeLeft = SecondsLeft / 60 & " 分 " & SecondsLeft mod 60 & " 秒"
else
TimeLeft = SecondsLeft mod 60 & " 秒"
End If
Else
TimeLeft = "未知"
End If
End Property
End Class
'---------------------------------------------------
' 文件信息 类
'---------------------------------------------------
Class FileInfo
Dim FormName, FileName, FilePath, FileSize, FileType, FileStart, FileExt, NewFileName
Private Sub Class_Initialize
FileName = "" ' 文件名
FilePath = "" ' 客户端路径
FileSize = 0 ' 文件大小
FileStart= 0 ' 文件开始位置
FormName = "" ' 表单名
FileType = "" ' 文件Content Type
FileExt = "" ' 文件扩展名
NewFileName = "" '上传后文件名
End Sub
Public Function Save()
SaveAs(FileName)
End Function
' 保存文件
Public Function SaveAs(fullpath)
Dim dr
SaveAs = false
If trim(fullpath) = "" Or FileStart = 0 Or FileName = "" Or right(fullpath,1) = "/" Then Exit Function
NewFileName = GetFileNameByPath(fullpath)
Set dr = CreateObject("Adodb.Stream")
dr.Mode = 3
dr.Type = 1
dr.Open
DoteyUpload_SourceData.position = FileStart
DoteyUpload_SourceData.copyto dr, FileSize
dr.SaveToFile MapPath(FullPath), 2
dr.Close
set dr = nothing
SaveAs = true
End function
' 返回Binary
Public Function GetBinary()
Dim Binary
If FileStart = 0 Then Exit Function
DoteyUpload_SourceData.Position = FileStart
Binary = DoteyUpload_SourceData.Read(FileSize)
GetBinary = Binary
End function
' 取服务器端路径
Private Function MapPath(Path)
If InStr(1, Path, ":") > 0 Or Left(Path, 2) = "//" Then
MapPath = Path
Else
MapPath = Server.MapPath(Path)
End If
End function
'根据路径获取文件名
Private Function GetFileNameByPath(FullPath)
Dim pos
pos = 0
pos = InStrRev(FullPath, "/") + 1
If (pos > 0) Then
GetFileNameByPath = Mid(FullPath, pos)
Else
GetFileNameByPath = FullPath
End If
End Function
End Class
%>
1.建立数据库,我用的是access数据库
id 自动编号
.................................. '用于存储表单内容
userfilepate '用于存储图片路径
........................... '可存储上传多个图片的路径
2.上传页面:asp.asp
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>验证会员填写认证资料</title>
<style type="text/css">
<!--
.STYLE1 {color: #FF0000}
.STYLE2 {
font-size: 18px;
color: #3333CC;
font-weight: bold;
}
-->
</style>
<STYLE>
BODY {cursor:default}
.STYLE3 {color: #D4D0C8}
.STYLE4 {color: #0000FF}
body {
background-color: #00CCCC;
}
</STYLE>
</head>
<body onload="webClock()">
<p align="center" class="STYLE2">交易准入资格认证</p>
<form name="form1" method="post" action="uptodir.asp" enctype="multipart/form-data" onsubmit="return checkdata();">
<table width="669" border="0" cellspacing="0" cellpadding="0" id="table1" align="center">
<tr>
<td width="28%" bgcolor="#00CCCC"><span class="STYLE4">用户名:<font class="Need STYLE1">*</font></span></td>
<td width="35%" bgcolor="#00CCCC"><input name="username" type="text" onblur="checkdata()" /></td>
<td id="message1"></td>
</tr>
<tr>
<td width="28%" bgcolor="#00CCCC"><span class="STYLE4">姓名:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC"><input name="name" type="text" onblur="checkdata()" /> </td>
<td id="message2"></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%"><span class="STYLE4">性别:<font class="Need STYLE1">*</font></span></td>
<td><span class="STYLE4">
<select name="sex">
<option>男</option>
<option>女</option>
</select>
</span> </td>
</tr>
<tr>
<td width="28%" valign="top" bgcolor="#00CCCC"><span class="STYLE4">邮政编码:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC"><input name="postcode" type="text" onblur="checkdata()" size="20" maxlength="6" /> </td>
<td id="message3"><span class="red"></span> </td>
</tr>
<tr>
<td width="28%" valign="top" bgcolor="#00CCCC"><span class="STYLE4">通信地址:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC"><input name="mailaddress" type="text" onblur="checkdata()" /> </td>
<td id="message4"></td>
</tr>
<tr>
<td width="28%" valign="top" bgcolor="#00CCCC"><span class="STYLE4">身份证地址:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC"><input name="accountaddress" type="text" onblur="checkdata()" /> </td>
<td id="message5"></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" valign="top"><span class="STYLE4">职业:</span></td>
<td><input name="vocational" type="text"/></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" valign="top"><span class="STYLE4">职务:</span></td>
<td><input name="position" type="text"/></td>
</tr>
<tr>
<td width="28%" valign="top" bgcolor="#00CCCC"><span class="STYLE4">常用电话:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC" id="sss"><input name="homephone" type="text" onblur="clean()" onkeyup="change()" /> </td>
<td id="message" width="37%" bordercolorlight=#FF5050></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" valign="top"><span class="STYLE4">电子邮件:</span></td>
<td><input name="email" type="text"/></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" valign="top"><span class="STYLE4">单位或宿舍固定电话:</span></td>
<td><input name="telephone" type="text"/></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" valign="top"><span class="STYLE4">传真:</span></td>
<td><input name="fax" type="text"/></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" valign="top"><span class="STYLE4">手机:</span></td>
<td><input name="mobile" type="text"/></td>
</tr>
<tr>
<td width="28%" valign="top" bgcolor="#00CCCC"><span class="STYLE4">身份证号码:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC"><input name="cardnumber" type="text" onkeyup="checkcardnumber();" /> </td>
<td id="message7"></td>
</tr>
<tr>
<td width="28%" valign="top" bgcolor="#00CCCC"><span class="STYLE4">常用银行帐号:<font class="Need STYLE1">*</font></span></td>
<td bgcolor="#00CCCC"><span class="STYLE4">
<select name="bankaccount">
<option></option>
<option>邮政</option>
<option>农行</option>
<option>工行</option>
<option>建行</option>
<option>交行</option>
<option>招行</option>
<option>中行</option>
<option>浦发</option>
</select>
<input name="bankaccount" type="text" maxlength="36" onblur="return checkdata()" />
</span> </td>
<td id="message6"></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%"><span class="STYLE4">备用银行帐号:</span></td>
<td><span class="STYLE4">
<label>
<textarea name="reservebankaccount" >
</textarea>
</label>
</span></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%"><span class="STYLE4">备用说明:</span></td>
<td><span class="STYLE4">
<label>
<textarea name="reservenote" >
</textarea>
</label>
</span>
</td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" height="83"><span class="STYLE4">上传身份证图片:</span><font class="Need STYLE1">*</font></td>
<td height="83"><span class="STYLE4">
<input type="file" name="file1" id="file1" onblur="return checkdata()"/>
</span></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" height="83"><span class="STYLE4">上传电话单图片:</span></td>
<td><span class="STYLE4">
<input type="file" name="file2" id="file2" onchange="picForm_Validator1()"/>
</span></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" height="83"><span class="STYLE4">上传汇款凭据:</span></td>
<td><span class="STYLE4">
<input type="file" name="file3" id="file3" onchange="picForm_Validator2()"/>
</span></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" height="83"><span class="STYLE4">上传其它认证图片:</span></td>
<td><span class="STYLE4">
<input type="file" name="file4" id="file4" onchange="picForm_Validator3()"/>
</span></td>
</tr>
<tr bgcolor="#00CCCC">
<td width="28%" height="83"><span class="STYLE4">上传其它认证图片:</span></td>
<td><span class="STYLE4">
<input type="file" name="file5" id="file5" onchange="picForm_Validator4()"/>
</span></td>
</tr>
<tr bgcolor="#00CCCC">
<td align =center><input name="Submit" type="submit" onclick="checkdata()" value="上传" /></td>
<td><input name="Submit2" type="reset" value="重置" /> </td>
</tr>
</table>
<p></p>
今天是：<input type="text" name="ddate" size="12" disabled="disabled">
现在时间：<input type="text" name="dtime" size="10" disabled="disabled"><br>
</form>
</body>
<script type="text/javascript" language="JavaScript">
var strTime,strDate;
function webClock()
{
var dNow = new Date();
var dHours = dNow.getHours();
var dMinutes = dNow.getMinutes();
var dSeconds = dNow.getSeconds();
strTime = dHours;
strTime += ((dMinutes<10)?":0":":")+dMinutes;
strTime += ((dSeconds<10)?":0":":")+dSeconds;
form1.dtime.value = strTime;
var dDate = dNow.getDate();
var dMonth = dNow.getMonth()+1;
var dYear = dNow.getYear();
strDate = dYear + "年";
strDate += ((dMonth<10)?"0":"")+dMonth + "月";
strDate += dDate + "日";
form1.ddate.value = strDate;
setTimeout("webClock()",1000);
}
</script>
<script language="JavaScript">
function change(){
document.getElementById("message").innerHTML="家庭电话，手机";
}
function clean(){
document.getElementById("message").innerHTML="";
}
</script>
<SCRIPT language=JavaScript>
function checkdata() {
if(document.form1.username.value.length==0){
document.getElementById("message1").innerHTML="用户名不能为空";
return false;
}
else{
document.getElementById("message1").innerHTML="";
}
if(document.form1.name.value.length==0){
document.getElementById("message2").innerHTML="姓名不能为空";
return false;
}
else{
document.getElementById("message2").innerHTML="";
}
if(document.form1.postcode.value.length==0){
document.getElementById("message3").innerHTML="邮政编码不能为空";
return false;
}
else{
document.getElementById("message3").innerHTML="";
}
if(document.form1.mailaddress.value.length==0){
document.getElementById("message4").innerHTML="通信地址不能为空";
return false;
}
else{
document.getElementById("message4").innerHTML="";
}
if(document.form1.accountaddress.value.length==0){
document.getElementById("message5").innerHTML="身份证地址不能为空";
return false;
}
else{
document.getElementById("message5").innerHTML="";
}
if(document.form1.bankaccount.value.length==0){
document.getElementById("message6").innerHTML="常用银行帐号不能为空";
return false;
}
else{
document.getElementById("message6").innerHTML="";
}
}
function checkcardnumber(){
var str=parseInt(document.all.cardnumber.value.length);
if(str!=15 && str!=18){
document.getElementById("message7").innerHTML="身份证号码不能为空且只能为15位和18位数字";
return false;
}
else{
document.getElementById("message7").innerHTML="";
}
}
</SCRIPT>
<script Language="JavaScript" Type="text/javascript">
function picForm_Validator(myform)
{
if(document.all.file1.value=="")
{
alert("请选择上传的照片！");
myform.mfile.focus();
return false;
}
var last=document.all.file1.value.match(/^(.*)(/.)(.{1,8})$/)[3]; //检查上传文件格式
last=last.toUpperCase();
if(last=="GIF" || last=="JPG" || last=="JPEG"){
}
else
{
alert("只能上传.GIF,JPEG 或.JPG 文件,请重新选择！");
parent.location.href="asp.asp";
return false;
}
return true;
}
function picForm_Validator1(myform)
{
if(document.all.file2.value=="")
{
alert("请选择上传的照片！");
myform.mfile.focus();
return false;
}
var last=document.all.file2.value.match(/^(.*)(/.)(.{1,8})$/)[3]; //检查上传文件格式
last=last.toUpperCase();
if(last=="GIF" || last=="JPG" || last=="JPEG"){
}
else
{
alert("只能上传.GIF,JPEG 或.JPG 文件,请重新选择！");
parent.location.href="asp.asp";
return false;
}
return true;
}
function picForm_Validator2(myform)
{
if(document.all.file3.value=="")
{
alert("请选择上传的照片！");
myform.mfile.focus();
return false;
}
var last=document.all.file3.value.match(/^(.*)(/.)(.{1,8})$/)[3]; //检查上传文件格式
last=last.toUpperCase();
if(last=="GIF" || last=="JPG" || last=="JPEG"){
}
else
{
alert("只能上传.GIF,JPEG 或.JPG 文件,请重新选择！");
parent.location.href="asp.asp";
return false;
}
return true;
}
function picForm_Validator3(myform)
{
if(document.all.file4.value=="")
{
alert("请选择上传的照片！");
myform.mfile.focus();
return false;
}
var last=document.all.file4.value.match(/^(.*)(/.)(.{1,8})$/)[3]; //检查上传文件格式
last=last.toUpperCase();
if(last=="GIF" || last=="JPG" || last=="JPEG"){
}
else
{
alert("只能上传.GIF,JPEG 或.JPG 文件,请重新选择！");
parent.location.href="asp.asp";
return false;
}
return true;
}
function picForm_Validator4(myform)
{
if(document.all.file5.value=="")
{
alert("请选择上传的照片！");
myform.mfile.focus();
return false;
}
var last=document.all.file5.value.match(/^(.*)(/.)(.{1,8})$/)[3]; //检查上传文件格式
last=last.toUpperCase();
if(last=="GIF" || last=="JPG" || last=="JPEG"){
}
else
{
alert("只能上传.GIF ,JPEG 或.JPG 文件,请重新选择！");
parent.location.href="asp.asp";
return false;
}
return true;
}
</script>
3.处理页面:uptodir.asp
<!-- #include file="Upload1.asp" -->
<!-- #include file="conn1.asp" -->
<%
Server.ScriptTimeout =20*60 '上传超时时间20分钟
dim userfilepath,userfilepath1,userfilepath2
set f=server.CreateObject("scripting.filesystemobject")
y=year(date)
m=month(date) '红色部分是实现每月创建文件夹
if len(m)<2 then m="0"&m
formPath = "UploadFiles/"&y&m&"/"
filename =server.mappath("UploadFiles/")&"/"&y&m&"/"
if not f.folderexists(filename) then f.createfolder(filename)
set f=nothing
Set upload= New DoteyUpload
Upload.SaveTo(formPath) '将文件根据其文件名统一保存在某路径下
If upload.ErrMsg = "" then
Response.Write ("form传递来的数据:<BR>")
For each formName in upload.Form ''列出所有form数据
temp=temp & "||" & upload.Form(formName) '用字符串存表单所有变量
next
temp2=split(temp,"||") '将字符串拆开存入数组
username=temp2(1)
name=temp2(2)
sex=temp2(3)
postcode=temp2(4)
mailaddress=temp2(5)
accountaddress=temp2(6)
vocational=temp2(7)
position=temp2(8)
homephone=temp2(9)
email=temp2(10)
telephone=temp2(11)
fax=temp2(12)
mobile=temp2(13)
cardnumber=temp2(14)
bankaccount=temp2(15)
reservebankaccount=temp2(16)
reservenote=temp2(17)
i=1
Response.Write ("<BR><BR>已经成功上传文件:<BR>")
set rs=server.createobject("adodb.recordset")
For Each formName In upload.Files ''列出所有上传了的文件
Set file = upload.Files(formName) ''生成一个文件对象
userfilepath=formPath & File.FileName
'判断
select case i
case 1
rs.open "submit",conn,1,3
rs.addnew
rs("username")=username
rs("name")=name
rs("sex")=sex
rs("postcode")=postcode
rs("mailaddress")=mailaddress
rs("accountaddress")=accountaddress
rs("vocational")=vocational
rs("position")=position
rs("homephone")=homephone
rs("email")=email
rs("telephone")=telephone
rs("fax")=fax
rs("mobile")=mobile
rs("cardnumber")=cardnumber
rs("bankaccount")=bankaccount
rs("reservebankaccount")=reservebankaccount
rs("reservenote")=reservenote
rs("ddate")=now()
rs("userfilepath").value=userfilepath
response.write "<hr>"
rs.update
rs.close
SQL="select top 1 id from submit ORDER BY ID DESC"
rs.open SQL,conn,1,3
MaxID = rs("ID")
rs.close
case 2
sql="select * from submit where id="&MaxID
rs.open sql,conn,1,3
rs("userfilepath1").value=userfilepath
response.write "<hr>"
rs.update
rs.close
case 3
sql="select * from submit where id="&MaxID
rs.open sql,conn,1,3
rs("userfilepath2").value=userfilepath
response.write "<hr>"
rs.update
rs.close
case 4
sql="select * from submit where id="&MaxID
rs.open sql,conn,1,3
rs("userfilepath3").value=userfilepath
response.write "<hr>"
rs.update
rs.close
case 5
sql="select * from submit where id="&MaxID
rs.open sql,conn,1,3
rs("userfilepath4").value=userfilepath
response.write "<hr>"
rs.update
rs.close
end select
i=i+1
Next
Else
Response.Write("上传过程中出现错误:<br>" & Upload.ErrMsg)
End If
Set file=nothing
Set upload=nothing
conn.close()
%><style type="text/css">
<!--
body {
background-color: #00CCCC;
}
-->
</style>
<BR><A HREF=http://192.168.1.108/index.asp>返回首页</A>
upload1.asp
<%
Dim DoteyUpload_SourceData
Class DoteyUpload
Public Files
Public Form
Public MaxTotalBytes
Public Version
Public ProgressID
Public ErrMsg
Private BytesRead
Private ChunkReadSize
Private Info
Private Progress
Private UploadProgressInfo
Private CrLf
Private Sub Class_Initialize()
Set Files = Server.CreateObject("Scripting.Dictionary") ' 上传文件集合
Set Form = Server.CreateObject("Scripting.Dictionary") ' 表单集合
UploadProgressInfo = "DoteyUploadProgressInfo" ' Application的Key
MaxTotalBytes = 1 *1024 *1024 *1024 ' 默认最大1G
ChunkReadSize = 64 * 1024 ' 分块大小64K
CrLf = Chr(13) & Chr(10) ' 换行
FileExt = "" ' 文件扩展名
Set DoteyUpload_SourceData = Server.CreateObject("ADODB.Stream")
DoteyUpload_SourceData.Type = 1 ' 二进制流
DoteyUpload_SourceData.Open
Version = "1.0 Beta" ' 版本
ErrMsg = "" ' 错误信息
Set Progress = New ProgressInfo
End Sub
' 将文件根据其文件名统一保存在某路径下
Public Sub SaveTo(path)
Upload() ' 上传
if right(path,1) <> "/" then path = path & "/"
' 遍历所有已上传文件
For Each fileItem In Files.Items
fileItem.FileName=Now()
fileItem.FileName=replace(fileItem.FileName," ", "")
fileItem.FileName=replace(fileItem.FileName,"-", "")
fileItem.FileName=replace(fileItem.FileName,":", "")
randomize
ranNum=int(90*rnd)+10
fileItem.FileName=fileItem.FileName&ranNum
fileItem.FileName=fileItem.FileName&".jpg"
fileItem.SaveAs path & fileItem.FileName
Next
' 保存结束后更新进度信息
Progress.ReadyState = "complete" '上传结束
UpdateProgressInfo progressID
End Sub
' 分析上传的数据，并保存到相应集合中
Public Sub Upload ()
Dim TotalBytes, Boundary
TotalBytes = Request.TotalBytes ' 总大小
If TotalBytes < 1 Then
Raise("无数据传入")
Exit Sub
End If
If TotalBytes > MaxTotalBytes Then
Raise("您当前上传大小为" & TotalBytes/1000 & " K，最大允许为" & MaxTotalBytes/1024 & "K")
Exit Sub
End If
Boundary = GetBoundary()
If IsNull(Boundary) Then
Raise("如果form中没有包括multipart/form-data上传是无效的")
Exit Sub ''如果form中没有包括multipart/form-data上传是无效的
End If
Boundary = StringToBinary(Boundary)
Progress.ReadyState = "loading" '开始上传
Progress.TotalBytes = TotalBytes
UpdateProgressInfo progressID
Dim DataPart, PartSize
BytesRead = 0
'循环分块读取
Do While BytesRead < TotalBytes
'分块读取
PartSize = ChunkReadSize
if PartSize + BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead
DataPart = Request.BinaryRead(PartSize)
BytesRead = BytesRead + PartSize
DoteyUpload_SourceData.Write DataPart
Progress.UploadedBytes = BytesRead
Progress.LastActivity = Now()
' 更新进度信息
UpdateProgressInfo progressID
Loop
' 上传结束后更新进度信息
Progress.ReadyState = "loaded" '上传结束
UpdateProgressInfo progressID
Dim Binary
DoteyUpload_SourceData.Position = 0
Binary = DoteyUpload_SourceData.Read
Dim BoundaryStart, BoundaryEnd, PosEndOfHeader, IsBoundaryEnd
Dim Header, bFieldContent
Dim FieldName
Dim File
Dim TwoCharsAfterEndBoundary
BoundaryStart = InStrB(Binary, Boundary)
BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary, 0)
Do While (BoundaryStart > 0 And BoundaryEnd > 0 And Not IsBoundaryEnd)
' 获取表单头的结束位置
PosEndOfHeader = InStrB(BoundaryStart + LenB(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))
' 分离表单头信息，类似于：
' Content-Disposition: form-data; name="file1"; filename="G:/homepage.txt"
' Content-Type: text/plain
Header = BinaryToString(MidB(Binary, BoundaryStart + LenB(Boundary) + 2, PosEndOfHeader - BoundaryStart - LenB(Boundary) - 2))
' 分离表单内容
bFieldContent = MidB(Binary, (PosEndOfHeader + 4), BoundaryEnd - (PosEndOfHeader + 4) - 2)
FieldName = GetFieldName(Header)
' 如果是附件
If InStr (Header,"filename=""") > 0 Then
Set File = New FileInfo
' 获取文件相关信息
Dim clientPath
clientPath = GetFileName(Header)
File.FileName = GetFileNameByPath(clientPath)
File.FileExt = GetFileExt(clientPath)
File.FilePath = clientPath
File.FileType = GetFileType(Header)
File.FileStart = PosEndOfHeader + 3
File.FileSize = BoundaryEnd - (PosEndOfHeader + 4) - 2
File.FormName = FieldName
' 如果该文件不为空并不存在该表单项保存之
If Not Files.Exists(FieldName) And File.FileSize > 0 Then
Files.Add FieldName, File
End If
'表单数据
Else
' 允许同名表单
If Form.Exists(FieldName) Then
Form(FieldName) = Form(FieldName) & "," & BinaryToString(bFieldContent)
Else
Form.Add FieldName, BinaryToString(bFieldContent)
End If
End If
' 是否结束位置
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, BoundaryEnd + LenB(Boundary), 2))
IsBoundaryEnd = TwoCharsAfterEndBoundary = "--"
If Not IsBoundaryEnd Then ' 如果不是结尾, 继续读取下一块
BoundaryStart = BoundaryEnd
BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary)
End If
Loop
' 解析文件结束后更新进度信息
Progress.UploadedBytes = TotalBytes
Progress.ReadyState = "interactive" '解析文件结束
UpdateProgressInfo progressID
End Sub
'异常信息
Private Sub Raise(Message)
ErrMsg = ErrMsg & "[" & Now & "]" & Message & "<BR>"
Progress.ErrorMessage = Message
UpdateProgressInfo ProgressID
'call Err.Raise(vbObjectError, "DoteyUpload", Message)
End Sub
' 取边界值
Private Function GetBoundary()
Dim ContentType, ctArray, bArray
ContentType = Request.ServerVariables("HTTP_CONTENT_TYPE")
ctArray = Split(ContentType, ";")
If Trim(ctArray(0)) = "multipart/form-data" Then
bArray = Split(Trim(ctArray(1)), "=")
GetBoundary = "--" & Trim(bArray(1))
Else '如果form中没有包括multipart/form-data上传是无效的
GetBoundary = null
Raise("如果form中没有包括multipart/form-data上传是无效的")
End If
End Function
' 将二进制流转化成文本
Private Function BinaryToString(xBinary)
Dim Binary
if vartype(xBinary) = 8 then Binary = MultiByteToBinary(xBinary) else Binary = xBinary
Dim RS, LBinary
Const adLongVarChar = 201
Set RS = CreateObject("ADODB.Recordset")
LBinary = LenB(Binary)
if LBinary>0 then
RS.Fields.Append "mBinary", adLongVarChar, LBinary
RS.Open
RS.AddNew
RS("mBinary").AppendChunk Binary
RS.Update
BinaryToString = RS("mBinary")
Else
BinaryToString = ""
End If
End Function
Function MultiByteToBinary(MultiByte)
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
if LMultiByte>0 then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
MultiByteToBinary = Binary
End Function
' 字符串到二进制
Function StringToBinary(String)
Dim I, B
For I=1 to len(String)
B = B & ChrB(Asc(Mid(String,I,1)))
Next
StringToBinary = B
End Function
'返回表单名
Private Function GetFieldName(infoStr)
Dim sPos, EndPos
sPos = InStr(infoStr, "name=")
EndPos = InStr(sPos + 6, infoStr, Chr(34) & ";")
If EndPos = 0 Then
EndPos = inStr(sPos + 6, infoStr, Chr(34))
End If
GetFieldName = Mid(infoStr, sPos + 6, endPos - _
(sPos + 6))
End Function
'返回文件名
Private Function GetFileName(infoStr)
Dim sPos, EndPos
sPos = InStr(infoStr, "filename=")
EndPos = InStr(infoStr, Chr(34) & CrLf)
GetFileName = Mid(infoStr, sPos + 10, EndPos - _
(sPos + 10))
End Function
'返回文件的 MIME type
Private Function GetFileType(infoStr)
sPos = InStr(infoStr, "Content-Type: ")
GetFileType = Mid(infoStr, sPos + 14)
End Function
'根据路径获取文件名
Private Function GetFileNameByPath(FullPath)
Dim pos
pos = 0
FullPath = Replace(FullPath, "/", "/")
pos = InStrRev(FullPath, "/") + 1
If (pos > 0) Then
GetFileNameByPath = Mid(FullPath, pos)
Else
GetFileNameByPath = FullPath
End If
End Function
'根据路径获取扩展名
Private Function GetFileExt(FullPath)
Dim pos
pos = InStrRev(FullPath,".")
if pos>0 then GetFileExt = Mid(FullPath, Pos)
End Function
' 更新进度信息
' 进度信息保存在Application中的ADODB.Recordset对象中
Private Sub UpdateProgressInfo(progressID)
Const adTypeText = 2, adDate = 7, adUnsignedInt = 19, adVarChar = 200
If (progressID <> "" And IsNumeric(progressID)) Then
Application.Lock()
if IsEmpty(Application(UploadProgressInfo)) Then
Set Info = Server.CreateObject("ADODB.Recordset")
Set Application(UploadProgressInfo) = Info
Info.Fields.Append "ProgressID", adUnsignedInt
Info.Fields.Append "StartTime", adDate
Info.Fields.Append "LastActivity", adDate
Info.Fields.Append "TotalBytes", adUnsignedInt
Info.Fields.Append "UploadedBytes", adUnsignedInt
Info.Fields.Append "ReadyState", adVarChar, 128
Info.Fields.Append "ErrorMessage", adVarChar, 4000
Info.Open
Info("ProgressID").Properties("Optimize") = true
Info.AddNew
Else
Set Info = Application(UploadProgressInfo)
If Not Info.Eof Then
Info.MoveFirst()
Info.Find "ProgressID = " & progressID
End If
If (Info.EOF) Then
Info.AddNew
End If
End If
Info("ProgressID") = clng(progressID)
Info("StartTime") = Progress.StartTime
Info("LastActivity") = Now()
Info("TotalBytes") = Progress.TotalBytes
Info("UploadedBytes") = Progress.UploadedBytes
Info("ReadyState") = Progress.ReadyState
Info("ErrorMessage") = Progress.ErrorMessage
Info.Update
Application.UnLock
End IF
End Sub
' 根据上传ID获取进度信息
Public Function GetProgressInfo(progressID)
Dim pi, Infos
Set pi = New ProgressInfo
If Not IsEmpty(Application(UploadProgressInfo)) Then
Set Infos = Application(UploadProgressInfo)
If Not Infos.Eof Then
Infos.MoveFirst
Infos.Find "ProgressID = " & progressID
If Not Infos.EOF Then
pi.StartTime = Infos("StartTime")
pi.LastActivity = Infos("LastActivity")
pi.TotalBytes = clng(Infos("TotalBytes"))
pi.UploadedBytes = clng(Infos("UploadedBytes"))
pi.ReadyState = Trim(Infos("ReadyState"))
pi.ErrorMessage = Trim(Infos("ErrorMessage"))
Set GetProgressInfo = pi
End If
End If
End If
Set GetProgressInfo = pi
End Function
' 移除指定的进度信息
Private Sub RemoveProgressInfo(progressID)
If Not IsEmpty(Application(UploadProgressInfo)) Then
Application.Lock
Set Info = Application(UploadProgressInfo)
If Not Info.Eof Then
Info.MoveFirst
Info.Find "ProgressID = " & progressID
If Not Info.EOF Then
Info.Delete
End If
End If
' 如果没有记录了, 直接释放, 避免'800a0bcd'错误
If Info.RecordCount = 0 Then
Info.Close
Application.Contents.Remove UploadProgressInfo
End If
Application.UnLock
End If
End Sub
' 移除指定的进度信息
Private Sub RemoveOldProgressInfo(progressID)
If Not IsEmpty(Application(UploadProgressInfo)) Then
Dim L
Application.Lock
Set Info = Application(UploadProgressInfo)
Info.MoveFirst
Do
L = Info("LastActivity").Value
If IsEmpty(L) Then
Info.Delete()
ElseIf DateDiff("d", Now(), L) > 30 Then
Info.Delete()
End If
Info.MoveNext()
Loop Until Info.EOF
' 如果没有记录了, 直接释放, 避免'800a0bcd'错误
If Info.RecordCount = 0 Then
Info.Close
Application.Contents.Remove UploadProgressInfo
End If
Application.UnLock
End If
End Sub
End Class
'---------------------------------------------------
' 进度信息 类
'---------------------------------------------------
Class ProgressInfo
Public UploadedBytes
Public TotalBytes
Public StartTime
Public LastActivity
Public ReadyState
Public ErrorMessage
Private Sub Class_Initialize()
UploadedBytes = 0 ' 已上传大小
TotalBytes = 0 ' 总大小
StartTime = Now() ' 开始时间
LastActivity = Now() ' 最后更新时间
ReadyState = "uninitialized" ' uninitialized,loading,loaded,interactive,complete
ErrorMessage = ""
End Sub
' 总大小
Public Property Get TotalSize
TotalSize = FormatNumber(TotalBytes / 1024, 0, 0, 0, -1) & " K"
End Property
' 已上传大小
Public Property Get SizeCompleted
SizeCompleted = FormatNumber(UploadedBytes / 1024, 0, 0, 0, -1) & " K"
End Property
' 已上传秒数
Public Property Get ElapsedSeconds
ElapsedSeconds = DateDiff("s", StartTime, Now())
End Property
' 已上传时间
Public Property Get ElapsedTime
If ElapsedSeconds > 3600 then
ElapsedTime = ElapsedSeconds / 3600 & " 时 " & (ElapsedSeconds mod 3600) / 60 & " 分 " & ElapsedSeconds mod 60 & " 秒"
ElseIf ElapsedSeconds > 60 then
ElapsedTime = ElapsedSeconds / 60 & " 分 " & ElapsedSeconds mod 60 & " 秒"
else
ElapsedTime = ElapsedSeconds mod 60 & " 秒"
End If
End Property
' 传输速率
Public Property Get TransferRate
If ElapsedSeconds > 0 Then
TransferRate = FormatNumber(UploadedBytes / 1024 / ElapsedSeconds, 2, 0, 0, -1) & " K/秒"
Else
TransferRate = "0 K/秒"
End If
End Property
' 完成百分比
Public Property Get Percentage
If TotalBytes > 0 Then
Percentage = fix(UploadedBytes / TotalBytes * 100) & "%"
Else
Percentage = "0%"
End If
End Property
' 估计剩余时间
Public Property Get TimeLeft
If UploadedBytes > 0 Then
SecondsLeft = fix(ElapsedSeconds * (TotalBytes / UploadedBytes - 1))
If SecondsLeft > 3600 then
TimeLeft = SecondsLeft / 3600 & " 时 " & (SecondsLeft mod 3600) / 60 & " 分 " & SecondsLeft mod 60 & " 秒"
ElseIf SecondsLeft > 60 then
TimeLeft = SecondsLeft / 60 & " 分 " & SecondsLeft mod 60 & " 秒"
else
TimeLeft = SecondsLeft mod 60 & " 秒"
End If
Else
TimeLeft = "未知"
End If
End Property
End Class
'---------------------------------------------------
' 文件信息 类
'---------------------------------------------------
Class FileInfo
Dim FormName, FileName, FilePath, FileSize, FileType, FileStart, FileExt, NewFileName
Private Sub Class_Initialize
FileName = "" ' 文件名
FilePath = "" ' 客户端路径
FileSize = 0 ' 文件大小
FileStart= 0 ' 文件开始位置
FormName = "" ' 表单名
FileType = "" ' 文件Content Type
FileExt = "" ' 文件扩展名
NewFileName = "" '上传后文件名
End Sub
Public Function Save()
SaveAs(FileName)
End Function
' 保存文件
Public Function SaveAs(fullpath)
Dim dr
SaveAs = false
If trim(fullpath) = "" Or FileStart = 0 Or FileName = "" Or right(fullpath,1) = "/" Then Exit Function
NewFileName = GetFileNameByPath(fullpath)
Set dr = CreateObject("Adodb.Stream")
dr.Mode = 3
dr.Type = 1
dr.Open
DoteyUpload_SourceData.position = FileStart
DoteyUpload_SourceData.copyto dr, FileSize
dr.SaveToFile MapPath(FullPath), 2
dr.Close
set dr = nothing
SaveAs = true
End function
' 返回Binary
Public Function GetBinary()
Dim Binary
If FileStart = 0 Then Exit Function
DoteyUpload_SourceData.Position = FileStart
Binary = DoteyUpload_SourceData.Read(FileSize)
GetBinary = Binary
End function
' 取服务器端路径
Private Function MapPath(Path)
If InStr(1, Path, ":") > 0 Or Left(Path, 2) = "//" Then
MapPath = Path
Else
MapPath = Server.MapPath(Path)
End If
End function
'根据路径获取文件名
Private Function GetFileNameByPath(FullPath)
Dim pos
pos = 0
pos = InStrRev(FullPath, "/") + 1
If (pos > 0) Then
GetFileNameByPath = Mid(FullPath, pos)
Else
GetFileNameByPath = FullPath
End If
End Function
End Class
%>
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- 为每个用户创建文件夹，并实现图片上传
- iOS文件处理，将图片存到手机目录里面 创建文件夹，NSFileManager用来存储图片，然后遍历将图片取出上传到服务器哦！！
- Express实现前端后端通信上传图片之存储数据库（mysql）傻瓜式教程（一）
- Express实现前端后端通信上传图片之存储数据库（mysql）傻瓜式教程（一）
- Asp.net FileUpload上传文件夹并检测所有子文件的实现代码
- 用asp.net实现将上传的图片变小存入数据库！（暑假里就开始想做的，很兴奋了）
- asp结合fso实现文件或文件夹创建删除等操作的函数
- asp图片上传以后，如何删除文件夹里的图片
- ASP.NET(C#)实现一次性上传多张图片（多个文件）
- SSM框架实现图片上传到工程目录下的upload文件夹与图片回显
- ASP程序实现图片上传的原理分析
- 在Asp.net中图片如何实现上传
- Ueditor结合七牛云及百度云存储（JAVA版，ueditor-1.4.3）实现图片文件上传
- Asp.Net 自定义控件实现图片的上传，浏览，删除功能
- Asp.net图片上传实现预览效果的简单代码
- webuploader+python3(BaseHTTPRequestHandler)实现图片文件的上传与接收存储
- 基于ASP.NET+EasyUI框架实现图片上传提交表单功能(js提交图片)
- asp.net多图片上传实现程序代码
- 如何实现ASP上传图片自动生成缩略图
- ASP.NET MVC WebAPI 上传图片实例与实战计算BOM成本的存储过程