ASP多文件无组件上传
用了别人的类，挺不错的程序
需要的可以改改 通过遍历数据可以实现无组件上传多文件
对于访问量不大的中小站很有用 对于不能安装组件的虚拟主机就更有效了。。。
我发现这个类很强大
提取表单数据、上传到不同文件夹、保存到数据库(上传和保存表单可同时进行)、限制上传扩展名、限制上传大小、选择文件保存类型
具体如下
adm_upload.asp文件内容如下
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<LINK href="../css.css" type=text/css rel=stylesheet>
<style type="text/css">
<!--
BODY{
BACKGROUND-COLOR: #FFFFFF;
font-size:9pt
}
.tx1 { height: 20px;font-size: 9pt; border: 1px solid; border-color: #000000; color: #0000FF}
-->
</style>
<SCRIPT language=javascript>
function check()
{
var strFileName=form1.FileName.value;
var FileType;
if (strFileName=="")
{
alert("请选择要上传的文件");
return false;
}
}
</SCRIPT>
</head>
<body bgcolor="#FFFFFF" leftmargin="0" topmargin="0">
<%
dim fpath:fpath=request("fpath")
%>
<form action="adm_upfile.asp" method="post" name="form1" onSubmit="return check()" target="_self" enctype="multipart/form-data">
<TABLE border="0" cellpadding="0" cellspacing="0" bordercolor="#999999" id="parts" width="500"> </TABLE>
</td>
</tr>
<tr>
<td colspan="2"> <input name="Submit" type="button" class="btbg" onclick="javascript:Addparts()" value="增加文件" /> </td>
</tr>
<tr>
<td colspan="2"> <div align="center">
文件1:<input class="iFile" id="file1" type="file" name="file1" size="40" /><br />
<input name="SUBMIT" type=SUBMIT class="btbg" value="上 传" />
</div> </td>
</tr>
</table>
</form>
</body><script>
function Addparts()
{
var row = parts.insertRow(parts.rows.length);//id=recordTable
var col = row.insertCell(0);
var i = row.rowIndex+2;
col.innerHTML = "文件"+ i + " <input type='file' name='file"+ i + "' value='' style='width:300px; margin-left:5px; margin-right:40px; text-align:center;' onpropertychange='checkFile(this)'>";
col = row.insertCell(1);
col = row.insertCell(2);
}
function checkFile(obj){
var oExten = obj.value.replace(/^.*\.([^\.]*)$/, '$1').toLowerCase();
if(oExten != 'jpg'&& oExten != 'gif'&&oExten!='bmp'&&oExten!='png'&&oExten!='rar'&&oExten!='doc'&&oExten!='xls'&&oExten!='txt'){
obj.outerHTML = obj.outerHTML;
}
}
</script>
</html>
adm_upfile.asp文件内容如下
<!--#include file="upload_class.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" xml:lang="zh-cn" lang="zh-cn">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>多文件上传</title>
<style type="text/css">
TABLE {border:1px green solid;margin-top:5px;}
TD{border-bottom:1px #dddddd solid;height:20px;padding:3px 0 0 5px;}
.head{background-color:#eeeeee;}
</style>
</head>
<body >
<%
Dim Upload,successful
'===============================================================================
set Upload=new AnUpLoad '创建类实例
Upload.SingleSize=1024*1024 '设置单个文件最大上传限制,按字节计；默认为不限制
Upload.MaxSize=20*1024*1024 '设置最大上传限制,按字节计；默认为不限制
Upload.Exe="rar|jpg|bmp|gif|jepg" '设置合法扩展名,以|分割,忽略大小写
Upload.GetData() '获取并保存数据,必须调用本方法
'===============================================================================
if Upload.Err>0 then '判断错误号,如果myupload.Err<=0表示正常
response.write Upload.Description '如果出现错误,获取错误描述
else
if Upload.files(-1).count>0 then '这里判断是否上传了文件
path=server.mappath("./") '文件保存路径 要修改位置的话就修改这里
for each f in Upload.files(-1)
set tempCls=Upload.files(f)
successful=tempCls.SaveToFile(path,0) '以时间+随机数字为文件名保存
'successful=tempCls.SaveToFile(path,1) '原文件名保存
if successful then
response.write tempCls.FileName & "上传完毕" & "!<br />"
else
response.write "上传失败"
end if
set tempCls=nothing
next
response.write "所有文件保存完毕,本次共上传了" & Upload.files(-1).count & "个文件,位置在当前目录"
end if
end if
set Upload=nothing '销毁
%>
</body>
</html>UpLoad_Class.asp文件如下
<%
'=========================================================
'类名: AnUpLoad(艾恩无组件上传类)
'作者: Anlige
'版本: An-Upload无组件上传类8.12.20
'开发日期: 2008-4-12
'修改日期: 2008-12-20
'作者主页: http://www.ii-home.cn
'Email: zhanghuiguoanlige@126.com
'QQ: 417833272
'=========================================================
Dim StreamT
Class AnUpLoad
Private Form, Fils
Private vCharSet, vMaxSize, vSingleSizeg, vErr, vVersion, vTotalSize, vExe, NewName
'==============================
'设置和读取属性开始
'==============================
Public Property Let MaxSize(ByVal value)
vMaxSize = value
End Property
Public Property Let SingleSize(ByVal value)
vSingleSize = value
End Property
Public Property Let Exe(ByVal value)
vExe = LCase(value)
End Property
Public Property Let CharSet(ByVal value)
vCharSet = value
End Property
Public Property Get Err()
Err = vErr
End Property
Public Property Get Description()
Description = GetErr(vErr)
End Property
Public Property Get Version()
Version = vVersion
End Property
Public Property Get TotalSize()
TotalSize = vTotalSize
End Property
'==============================
'设置和读取属性结束，初始化类
'==============================
Private Sub Class_Initialize()
set StreamT=server.createobject("ADODB.STREAM")
set Form = server.createobject("Scripting.Dictionary")
set Fils = server.createobject("Scripting.Dictionary")
vVersion = "Anlige无组件上传8.12.20"
vMaxSize = -1
vSingleSize = -1
vErr = -1
vExe = ""
vTotalSize = 0
vCharSet = "gb2312"
End Sub
Private Sub Class_Terminate()
Set Form = Nothing
Set Fils = Nothing
Set StreamT = Nothing
End Sub
'==============================
'函数名:GetData
'作用:处理客户端提交来的所有数据
'==============================
Public Sub GetData()
Dim value, str, bcrlf, fpos, sSplit, slen, istartg
Dim formend, formhead, startpos, endpos, formname, FileName, fileExe, valueend, NewName
If checkEntryType = True Then
vTotalSize = 0
StreamT.Type = 1
StreamT.Mode = 3
StreamT.Open
StreamT.Write Request.binaryread(Request.totalbytes)
StreamT.Position = 0
tempdata = StreamT.Read
bcrlf = ChrB(13) & ChrB(10)
fpos = InStrB(1, tempdata, bcrlf)
sSplit = MidB(tempdata, 1, fpos - 1)
slen = LenB(sSplit)
istart = slen + 2
Do
formend = InStrB(istart, tempdata, bcrlf & bcrlf)
formhead = MidB(tempdata, istart, formend - istart)
str = Bytes2Str(formhead)
startpos = InStr(str, "name=""") + 6
endpos = InStr(startpos, str, """")
formname = LCase(Mid(str, startpos, endpos - startpos))
valueend = InStrB(formend + 3, tempdata, sSplit)
If InStr(str, "filename=""") > 0 Then
startpos = InStr(str, "filename=""") + 10
endpos = InStr(startpos, str, """")
FileName = Mid(str, startpos, endpos - startpos)
If Trim(FileName) <> "" Then
LocalName = FileName
FileName = Replace(FileName, "/", "\")
FileName = Mid(FileName, InStrRev(FileName, "\") + 1)
fileExe = Split(FileName, ".")(UBound(Split(FileName, ".")))
If vExe <> "" Then '判断扩展名
If checkExe(fileExe) = True Then
vErr = 3
Exit Sub
End If
End If
NewName = Getname()
NewName = NewName & "." & fileExe
vTotalSize = vTotalSize + valueend - formend - 6
If vSingleSize > 0 And (valueend - formend - 6) > vSingleSize Then '判断上传单个文件大小
vErr = 5
Exit Sub
End If
If vMaxSize > 0 And vTotalSize > vMaxSize Then '判断上传数据总大小
vErr = 1
Exit Sub
End If
If Fils.Exists(formname) Then
vErr = 4
Exit Sub
Else
Dim fileCls:set fileCls=New fileAction
fileCls.Size = (valueend - formend - 6)
fileCls.Position = (formend + 3)
fileCls.NewName = NewName
fileCls.LocalName = FileName
Fils.Add formname, fileCls
Form.Add formname, LocalName
Set fileCls = Nothing
End If
End If
Else
value = MidB(tempdata, formend + 4, valueend - formend - 6)
If Form.Exists(formname) Then
Form(formname) = Form(formname) & "," & Bytes2Str(value)
Else
Form.Add formname, Bytes2Str(value)
End If
End If
istart = valueend + 2 + slen
Loop Until (istart + 2) >= LenB(tempdata)
vErr = 0
Else
vErr = 2
End If
End Sub
'==============================
'判断扩展名
'==============================
Private Function checkExe(ByVal ex)
Dim notIn: notIn = True
If InStr(1, vExe, "|") > 0 Then
Dim tempExe: tempExe = Split(vExe, "|")
Dim I: I = 0
For I = 0 To UBound(tempExe)
If LCase(ex) = tempExe(I) Then
notIn = False
Exit For
End If
Next
Else
If vExe = LCase(ex) Then
notIn = False
End If
End If
checkExe = notIn
End Function
'==============================
'把数字转换为文件大小显示方式
'==============================
Public Function GetSize(ByVal Size)
If Size < 1024 Then
GetSize = FormatNumber(Size, 2) & "B"
ElseIf Size >= 1024 And Size < 1048576 Then
GetSize = FormatNumber(Size / 1024, 2) & "KB"
ElseIf Size >= 1048576 Then
GetSize = FormatNumber((Size / 1024) / 1024, 2) & "MB"
End If
End Function
'==============================
'二进制数据转换为字符
'==============================
Private Function Bytes2Str(ByVal byt)
If LenB(byt) = 0 Then
Bytes2Str = ""
Exit Function
End If
Dim mystream, bstr
Set mystream =server.createobject("ADODB.Stream")
mystream.Type = 2
mystream.Mode = 3
mystream.Open
mystream.WriteText byt
mystream.Position = 0
mystream.CharSet = vCharSet
mystream.Position = 2
bstr = mystream.ReadText()
mystream.Close
Set mystream = Nothing
Bytes2Str = bstr
End Function
'==============================
'获取错误描述
'==============================
Private Function GetErr(ByVal Num)
Select Case Num
Case 0
GetErr = "数据处理完毕!"
Case 1
GetErr = "上传数据超过" & GetSize(vMaxSize) & "限制!可设置MaxSize属性来改变限制!"
Case 2
GetErr = "未设置上传表单enctype属性为multipart/form-data,上传无效!"
Case 3
GetErr = "含有非法扩展名文件!只能上传扩展名为" & Replace(vExe, "|", ",") & "的文件"
Case 4
GetErr = "对不起,程序不允许使用相同name属性的文件域!"
Case 5
GetErr = "单个文件大小超出" & GetSize(vSingleSize) & "的上传限制!"
End Select
End Function
'==============================