挺不错的程序
需要的可以改改 通过遍历数据可以实现无组件上传多文件
对于访问量不大的中小站很有用 对于不能安装组件的虚拟主机就更有效了。。。
我发现这个类很强大
提取表单数据、上传到不同文件夹、保存到数据库(上传和保存表单可同时进行)、限制上传扩展名、限制上传大小、选择文件保存类型
具体如下
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 style="font-size:12px">
<%
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
'==============================
'根据日期生成随机文件名
'==============================
Private Function Getname()
Dim y, m, d, h, mm, S, r
Randomize
y = Year(Now)
m = Month(Now): If m < 10 Then m = "0" & m
d = Day(Now): If d < 10 Then d = "0" & d
h = Hour(Now): If h < 10 Then h = "0" & h
mm = Minute(Now): If mm < 10 Then mm = "0" & mm
S = Second(Now): If S < 10 Then S = "0" & S
r = 0
r = CInt(Rnd() * 1000)
If r < 10 Then r = "00" & r
If r < 100 And r >= 10 Then r = "0" & r
Getname = y & m & d & h & mm & S & r
End Function
'==============================
'检测上传类型是否为multipart/form-data
'==============================
Private Function checkEntryType()
Dim ContentType, ctArray, bArray
ContentType = LCase(Request.ServerVariables("HTTP_CONTENT_TYPE"))
ctArray = Split(ContentType, ";")
If Trim(ctArray(0)) = "multipart/form-data" Then
checkEntryType = True
Else
checkEntryType = False
End If
End Function
'==============================
'获取上传表单值,参数可选,如果为-1则返回一个包含所有表单项的一个dictionary对象
'==============================
Public Function Forms(ByVal formname)
If trim(formname) = "-1" Then
Set Forms = Form
Else
If Form.Exists(LCase(formname)) Then
Forms = Form(LCase(formname))
Else
Forms = ""
End If
End If
End Function
'==============================
'获取上传的文件类,参数可选,如果为-1则返回一个包含所有上传文件类的一个dictionary对象
'==============================
Public Function Files(ByVal formname)
If trim(formname) = "-1" Then
Set Files = Fils
Else
If Fils.Exists(LCase(formname)) Then
Set Files = Fils(LCase(formname))
Else
Set Files = Nothing
End If
End If
End Function
'==============================
'写文件函数
'==============================
Private Function WritFile(ByVal byt, ByVal fileName)
Dim objAso
set objAso=server.createobject("ADODB.Stream")
objAso.Type = 1
objAso.Mode = 3
objAso.Open
objAso.Position = 0
objAso.Write byt
objAso.SaveToFile fileName, 2
objAso.Close
Set objAso = Nothing
WritFile = True
End Function
'==============================
'下载函数
'==============================
Public Function UpFromUrl(ByVal URL, ByVal savePath)
On Error Resume Next
Dim ResBody, sStr, vPath, fileName,fileExe
vPath = Replace(savePath, "/", "\")
If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
sPos = InStrRev(URL, "/") + 1
sStr = Mid(URL, sPos)
Set Http = Server.CreateObject("MICROSOFT.XMLHTTP")
Http.Open "GET", URL, False
Http.Send
If Http.Readystate = 4 Then
If Http.Status = 200 Then
ResBody = Http.responseBody
head = Http.getResponseHeader("content-disposition")
If head <> "" Then
startpos = InStr(head, "=") + 1
fileName = Mid(head, startpos)
ElseIf InStr(sStr, ".") > 0 And InStr(sStr, "?") <= 0 Then
fileName = sStr
Else
fileName = Getname() & ".dat"
End If
fileExe = Split(FileName, ".")(UBound(Split(fileName, ".")))
if vExe<>"" then
if checkExe(fileExe) then
vErr=3
exit function
end if
end if
If WritFile(ResBody, vPath & fileName) Then UpFromUrl =true
End If
End If
End Function
End Class
'==============================
'文件类,存储文件的详细信息
'==============================
Class fileAction
Private vSize, vPosition, vName, vNewName, vLocalName, vPath, saveName
'==============================
'设置属性
'==============================
Public Property Let NewName(ByVal value)
vNewName = value
vName = value
End Property
Public Property Let LocalName(ByVal value)
vLocalName = value
End Property
Public Property Get FileName()
FileName = vName
End Property
Public Property Let Position(ByVal value)
vPosition = value
End Property
Public Property Let Size(ByVal value)
vSize = value
End Property
Public Property Get Size()
Size = vSize
End Property
'==============================
'函数名:SaveToFile
'作用:根据参数保存文件到服务器
'参数:参数1--文件保存的路径
' 参数2--文件保存的方式,有两个可选项0表示以新名字(时间+随机数)为文件名保存,1表示以原文件名保存文件
'==============================
Public Function SaveToFile(ByVal path, ByVal saveType)
'On Error Resume Next
Err.Clear
vPath = Replace(path, "/", "\")
If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
Dim mystream
Set mystream =server.createobject("ADODB.Stream")
mystream.Type = 1
mystream.Mode = 3
mystream.Open
StreamT.Position = vPosition
StreamT.CopyTo mystream, vSize
vName = vNewName
If saveType = 1 Then vName = vLocalName
mystream.SaveToFile vPath & vName, 2
mystream.Close
Set mystream = Nothing
If Err Then
SaveToFile = False
Else
SaveToFile = True
End If
End Function
'==============================
'函数名:GetBytes
'作用:获取文件的二进制形式
'参数:无
'==============================
Public Function GetBytes()
StreamT.Position = vPosition
GetBytes = StreamT.Read(vSize)
End Function
End Class
%>
发表评论：