IDC资讯中心
受本论坛某些帖子启发，于是动手编写了这个程序。该程序支持任何文本和二进制格式文件的上传；支持文件表单域和普通表单域混合上传；支持中文文件名；支持覆盖上传和文件同名时自动修改文件名；支持同时上传多个文件，而且多个文件表单域名可以相同；支持上传文件大小的控制…… 我自己感觉很不错哟：)
本程序无须任何数据库支持，直接将上传的文件保存到服务器指定的路径下。
测试环境：windows2000 + iis 5.0(对ado版本有要求)
已知bug：利用相同文件表单名以唯一文件名方式同时上传多个文件，且服务器上存在多个相同文件名时，只有第一个文件会自动改名上传成功，然后程序报错。
源代码如下，欢迎大家参考指正：
文件名：uploadx.asp
<%
dim formdata, formsize, divider, bcrlf
formsize = request.totalbytes
formdata = request.binaryread(formsize)
bcrlf = chrb(13) & chrb(10)
divider = leftb(formdata, instrb(formdata, bcrlf) – 1)
将上传的文件保存到path所指定的目录下面。
formfield 上传表单的"file"域名
path 要保存文件的服务器绝对路径，形式为："d:\path\subpath"或"d:\path\subpath\"
maxsize 限制上传文件的最大长度，以kbyte为单位
savtype 服务器保存文件的方式：
0 唯一文件名方式，如果有同名则自动改名；
1 报错方式，如果有同名则出错；
2 覆盖方式，如果有同名则覆盖原来的文件
function savefile(formfilefield, path, maxsize, savtype)
dim streamobj,streamobj1
set streamobj = server.createobject("adodb.stream")
set streamobj1 = server.createobject("adodb.stream")
streamobj.mode = 3
streamobj1.mode = 3
streamobj.type = 1
streamobj1.type = 1
savefile = ""
startpos = lenb(divider) + 2
formfilefield = chr(34) & formfilefield & chr(34)
if right(path,1) <> "\" then
path = path & "\"
end if
do while startpos > 0
strlen = instrb(startpos, formdata, bcrlf) – startpos
searchstr = midb(formdata, startpos, strlen)
if instr(bin2str(searchstr), formfilefield) > 0 then
filename = bin2str(getfilename(searchstr,path,savtype))
if filename <> "" then
filestart = instrb(startpos, formdata, bcrlf & bcrlf) + 4
filelen = instrb(startpos, formdata, divider) – 2 – filestart
if filelen <= maxsize*1024 then
filecontent = midb(formdata, filestart, filelen)
streamobj.open
streamobj1.open
streamobj.write formdata
streamobj.position=filestart-1
streamobj.copyto streamobj1,filelen
if savtype =0 then
savtype = 1
end if
streamobj1.savetofile path & filename, savtype
streamobj.close
streamobj1.close
if savefile <> "" then
savefile = savefile & "," & filename
else
savefile = filename
end if
else
if savefile <> "" then
savefile = savefile & ",*toobig*"
else
savefile = "*toobig*"
end if
end if
end if
end if
if instrb(startpos, formdata, divider) < 1 then
exit do
end if
startpos = instrb(startpos, formdata, divider) + lenb(divider) + 2
loop
end function
function getformval(formname)
getformval = ""
startpos = lenb(divider) + 2
formname = chr(34) & formname & chr(34)
do while startpos > 0
strlen = instrb(startpos, formdata, bcrlf) – startpos
searchstr = midb(formdata, startpos, strlen)
if instr(bin2str(searchstr), formname) > 0 then
valstart = instrb(startpos, formdata, bcrlf & bcrlf) + 4
vallen = instrb(startpos, formdata, divider) – 2 – valstart
valcontent = midb(formdata, valstart, vallen)
if getformval <> "" then
getformval = getformval & "," & bin2str(valcontent)
else
getformval = bin2str(valcontent)
end if
end if
if instrb(startpos, formdata, divider) < 1 then
exit do
end if
startpos = instrb(startpos, formdata, divider) + lenb(divider) + 2
loop
end function
function bin2str(binstr)
dim varlen, clow, ccc, skipflag
skipflag = 0
ccc = ""
varlen = lenb(binstr)
for i = 1 to varlen
if skipflag = 0 then
clow = midb(binstr, i, 1)
if ascb(clow) > 127 then
ccc = ccc & chr(ascw(midb(binstr, i + 1, 1) & clow))
skipflag = 1
else
ccc = ccc & chr(ascb(clow))
end if
else
skipflag = 0
end if
next
bin2str = ccc
end function
function str2bin(str)
for i = 1 to len(str)
str2bin = str2bin & chrb(asc(mid(str, i, 1)))
next
end function
function getfilename(str,path,savtype)
set fs = server.createobject("scripting.filesystemobject")
str = rightb(str,lenb(str)-instrb(str,str2bin("filename="))-9)
getfilename = ""
filename = ""
for i = lenb(str) to 1 step -1
if midb(str, i, 1) = chrb(asc("\")) then
filename = midb(str, i + 1, lenb(str) – i – 1)
exit for
end if
next
if savtype = 0 and fs.fileexists(path & bin2str(filename)) = true then
hfilename = filename
rfilename = ""
for i = lenb(filename) to 1 step -1
if midb(filename, i, 1) = chrb(asc(".")) then
hfilename = leftb(filename, i-1)
rfilename = rightb(filename, lenb(filename)-i+1)
exit for
end if
next
for i = 0 to 9999
hfilename = hfilename & str2bin(i)
if fs.fileexists(path & bin2str(hfilename) & i & bin2str(rfilename)) = false then
filename = hfilename & str2bin(i) & rfilename
exit for
end if
next
end if
set fs = nothing
getfilename = filename
end function
%>
应用举例：
upload.htm
<html>
<head>
<meta http-equiv="content-language" content="zh-cn">
<meta http-equiv="content-type" content="text/html; charset=gb2312">
<meta name="generator" content="microsoft frontpage 4.0">
<meta name="progid" content="frontpage.editor.document">
<title>new page 1</title>
</head>
<body>
<form method="post" action="upload.asp" enctype="multipart/form-data">
<p>姓名：<input type="text" name="name" size="20"></p>
<p>城市：<input type="text" name="city" size="20"></p>
<p>爱好：1、<input type="text" name="lover" size="10"> 2、<input type="text" name="lover" size="10"></p>
<p>性别：<input type="radio" value="男" checked name="sex">男
<input type="radio" name="sex" value="女">女</p>
<p>省份：<select size="1" name="province">
<option selected value="江苏">江苏</option>
<option value="山西">山西</option>
</select></p>
爱好(补充)：3、<input type="text" name="lover" size="10"> 4、<input type="text" name="lover" size="10">
<p>作品1：<input type="file" name="fruit" size="20"></p>
<p>作品1：<input type="file" name="fruit" size="20"></p>
<p>作品2：<input type="file" name="fruit2" size="20"></p>
<p><input type="submit" value="提交" name="subbutt"><input type="reset" value="全部重写" name="rebutt"></p>
</form>
</body>
</html>
upload.asp
<%@ language = vbscript %>
<!– #include file="uploadx.asp" –>
<%
response.write "<br>name=""" & getformval("name") & """"
response.write "<br>sex=""" & getformval("sex") & """"
response.write "<br>province=""" & getformval("province") & """"
response.write "<br>city=""" & getformval("city") & """"
response.write "<br>lover=""" & getformval("lover") & """"
dim filename
path = server.mappath("./")
filename = savefile("fruit",path,1024,0)
if filename <> "*toobig*" then
response.write "<br><br>""" & filename & """已经上传"
else
response.write "<br><br>文件超出限制太大"
end if
filename = savefile("fruit2",path,1024,0)
if filename <> "*toobig*" then
response.write "<br><br>""" & filename & """已经上传"
else
response.write "<br><br>文件超出限制太大"
end if
%>
