asp多文件上傳類, 是從我們服務器上搞來的是病毒
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
function GetFilePath(FullPath,str)
If FullPath <> "" Then
GetFilePath = left(FullPath,InStrRev(FullPath, str))
Else
GetFilePath = ""
End If
End function
%>
<%
class clsUp '文件上傳類
'------------------------
Dim Form,File
Dim AllowExt_ '答應上傳類型(白名單)
Dim NoAllowExt_ '不答應上傳類型(黑名單)
Private oUpFileStream '上傳的數據流
Private isErr_ '錯誤的代碼,0或true表示無錯
Private ErrMessage_ '錯誤的字符串消息
Private isGetData_ '指示能否已施行過GETDATA進程
'------------------------------------------------------------------
'類的屬性
Public Property Get Version
Version="上傳類聲明"
End Property
Public Property Get isErr '錯誤的代碼,0或true表示無錯
isErr=isErr_
End Property
Public Property Get ErrMessage '錯誤的字符串消息
ErrMessage=ErrMessage_
End Property
Public Property Get AllowExt '答應上傳類型(白名單)
AllowExt=AllowExt_
End Property
Public Property Let AllowExt(Value) '答應上傳類型(白名單)
AllowExt_=LCase(Value)
End Property
Public Property Get NoAllowExt '不答應上傳類型(黑名單)
NoAllowExt=NoAllowExt_
End Property
Public Property Let NoAllowExt(Value) '不答應上傳類型(黑名單)
NoAllowExt_=LCase(Value)
End Property
'----------------------------------------------------------------
'類實古代碼
'初始化類
Private Sub Class_Initialize
isErr_ = 0
NoAllowExt="" '黑名單,能夠在這里預設不可上傳的文件類型,以文件的后綴名來判別,不分大大寫,每個每綴名用;號分開,假如黑名單為空,則判別白名單
NoAllowExt=LCase(NoAllowExt)
AllowExt="" '白名單,能夠在這里預設可上傳的文件類型,以文件的后綴名來判別,不分大大寫,每個后綴名用;號分開
AllowExt=LCase(AllowExt)
isGetData_=false
End Sub
'類結束
Private Sub Class_Terminate
on error Resume Next
'肅清變量及對像
Form.RemoveAll
Set Form = Nothing
File.RemoveAll
Set File = Nothing
oUpFileStream.Close
Set oUpFileStream = Nothing
End Sub
'分析上傳的數據網站制作
Public Sub GetData (MaxSize)
'定義變量
on error Resume Next
if isGetData_=false then
Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
Dim sFormValue,sFileName
Dim iFindStart,iFindEnd
Dim iFormStart,iFormEnd,sFormName
'代碼開端
If Request.TotalBytes < 1 Then '假如沒有數據上傳
isErr_ = 1
ErrMessage_="沒有數據上傳"
Exit Sub
End If
If MaxSize > 0 Then '假如限制大小
If Request.TotalBytes > MaxSize Then
isErr_ = 2 '假如上傳的數據超出限制大小
ErrMessage_="上傳的數據超出限制大小"
Exit Sub
End If
End If
Set Form = Server.CreateObject ("Scripting.Dictionary")
Form.CompareMode = 1
Set File = Server.CreateObject ("Scripting.Dictionary")
File.CompareMode = 1
Set tStream = Server.CreateObject ("ADODB.Stream")
Set oUpFileStream = Server.CreateObject ("ADODB.Stream")
oUpFileStream.Type = 1
oUpFileStream.Mode = 3
oUpFileStream.Open
oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)
oUpFileStream.Position = 0
RequestBinDate = oUpFileStream.Read
iFormEnd = oUpFileStream.Size
bCrLf = ChrB (13) & ChrB (10)
'獲得每個項目之間的分隔符
sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
iStart = LenB(sSpace)
iFormStart = iStart+2
'分解項目
Do
iInfoEnd = InStrB (iFormStart,RequestBinDate,bCrLf & bCrLf)+3
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iFormStart
oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gb2312"
sInfo = tStream.ReadText
'獲得表單項目稱號
iFormStart = InStrB (iInfoEnd,RequestBinDate,sSpace)-1
iFindStart = InStr (22,sInfo,"name=""",1)+6
iFindEnd = InStr (iFindStart,sInfo,"""",1)
sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
'假如是文件
If InStr (45,sInfo,"filename=""",1) > 0 Then
Set oFileInfo = new clsFileInfo
'獲得文件屬性
iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr (iFindStart,sInfo,""""&vbCrLf,1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileName = GetFileName(sFileName)
oFileInfo.FilePath = GetFilePath(sFileName)
oFileInfo.FileExt = GetFileExt(sFileName)
iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr (iFindStart,sInfo,vbCr)
oFileInfo.FileMIME = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileStart = iInfoEnd
oFileInfo.FileSize = iFormStart -iInfoEnd -2
oFileInfo.FormName = sFormName
file.add sFormName,oFileInfo
else
'假如是表單項目
tStream.Close
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iInfoEnd
oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gb2312"
sFormValue = tStream.ReadText
If Form.Exists (sFormName) Then
Form (sFormName) = Form (sFormName) & ", " & sFormValue
else
Form.Add sFormName,sFormValue
End If
End If
tStream.Close
iFormStart = iFormStart+iStart+2
'假如到文件尾了就加入
Loop Until (iFormStart+2) >= iFormEnd
RequestBinDate = ""
Set tStream = Nothing
isGetData_=true
end if
End Sub
'保存到文件,主動覆蓋已具有的同名文件
Public Function SaveToFile(Item,Path)
SaveToFile=SaveToFileEx(Item,Path,True)
End Function
'保存到文件,主動設置文件名
Public Function AutoSave(Item,Path)
AutoSave=SaveToFileEx(Item,Path,false)
End Function
'保存到文件,OVER為真時,主動覆蓋已具有的同名文件,否則主動把文件改名保存
Private Function SaveToFileEx(Item,Path,Over)
On Error Resume Next
Dim oFileStream
Dim tmpPath
Dim nohack '防黑緩沖
isErr=0
Set oFileStream = CreateObject ("ADODB.Stream")
oFileStream.Type = 1
oFileStream.Mode = 3
oFileStream.Open
oUpFileStream.Position = File(Item).FileStart
oUpFileStream.CopyTo oFileStream,File(Item).FileSize
nohack=split(path,".") '重要修改，防止黑客二進制"01"斷名!!!
tmpPath=nohack(0)&"."&nohack(ubound(nohack)) '重要修改，防止黑客二進制"01"斷名!!!
if Over then
if isAllowExt(GetFileExt(tmpPath)) then
oFileStream.SaveToFile tmpPath,2
Else
isErr_=3
ErrMessage_="該后綴名的文件不答應上傳!"
End if
Else
Path=GetFilePath(Path)
if isAllowExt(File(Item).FileExt) then
do
Err.Clear()
nohack=split(Path&GetNewFileName()&"."&File(Item).FileExt,".") '重要修改，防止黑客二進制"01"斷名!!!
tmpPath=nohack(0)&"."&nohack(ubound(nohack)) '重要修改，防止黑客二進制"01"斷名！！!
oFileStream.SaveToFile tmpPath
loop Until Err.number<1
oFileStream.SaveToFile Path
Else
isErr_=3
ErrMessage_="該后綴名的文件不答應上傳!"
End if
End if
oFileStream.Close
Set oFileStream = Nothing
if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath)
End Function
'獲得文件數據
Public Function FileData(Item)
isErr_=0
if isAllowExt(File(Item).FileExt) then
oUpFileStream.Position = File(Item).FileStart
FileData = oUpFileStream.Read (File(Item).FileSize)
Else
isErr_=3
ErrMessage_="該后綴名的文件不答應上傳!"
FileData=""
End if
End Function
'獲得文件路徑
Public function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = Left(FullPath,InStrRev(FullPath, "\"))
Else
GetFilePath = ""
End If
End function
'獲得文件名
Public Function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
Else
GetFileName = ""
End If
End function
'獲得文件的后綴名
Public Function GetFileExt(FullPath)
If FullPath <> "" Then
GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1))
Else
GetFileExt = ""
End If
End function
'獲得一個不反復的序號
Public Function GetNewFileName()
dim ranNum
dim dtNow
dtNow=Now()
ranNum=int(90000*rnd)+10000
GetNewFileName=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum
End Function
Public Function isAllowExt(Ext)
if NoAllowExt="" then
isAllowExt=cbool(InStr(1,";"&AllowExt&";",LCase(";"&Ext&";")))
else
isAllowExt=not CBool(InStr(1,";"&NoAllowExt&";",LCase(";"&Ext&";")))
end if
End Function
End Class
'----------------------------------------------------------------------------------------------------
'文件屬性類
Class clsFileInfo
Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt
End Class
%>
<HTML>
<HEAD>
<STYLE TYPE="text/css">
<!--
.p9{ font-size: 9pt; font-family: 宋體 }
td {font-size: 9pt}
.tx {height: 16px; width: 30px; border-color: black black #000000; border-top-width: 0px; border-right-width: 0px; border-bottom-width: 1px; border-left-width: 0px; font-size: 9pt; background-color: #eeeeee; color: #0000FF}
.tx2 {height: 16px;border-top-width: 0px; border-right-width: 0px; border-bottom-width: 1px; border-left-width: 0px; font-size: 9pt; color: #0000FF; border-left-color:#000000; border-right-color:#000000; border-top-color:#000000; border-bottom-color:#000000}
.bt {border-left:1px solid #C0C0C0; border-top:1px solid #C0C0C0; font-size: 9pt; border-right-width: 1; border-bottom-width: 1; height: 16px; width: 80px; background-color: #EEEEEE; cursor: hand; border-right-style:solid; border-bottom-style:solid}
.tx1 { width: 400 ;height: 20px; font-size: 9pt; border: 1px solid; border-color: black black #000000; color: #0000FF}
-->
</STYLE>
<TITLE>上傳文件</TITLE>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=gb2312">
<SCRIPT LANGUAGE="vbscript">
function addfile()
dim str
str="<table>"
if not IsNumeric (window.form1.filenum.value) then window.form1.filenum.value =1
for i=1 to window.form1.filenum.value
str=str&"<tr><td valign='middle'>文件"&i&":</td><td><input type='file' name='file"&i&"' class='tx1' value size='20'> 保存為<input type='text' name='file"&i&"' size='20' class='tx2'></td></tr>"
next
window.uptd.innerHTML =str&"</table>"
end function
</SCRIPT>
</HEAD>
<BODY BGCOLOR="#ffffff" CLASS="p9" >
<%
dim upfile,formPath,ServerPath,FSPath,formName,FileName,oFile,upfilecount
upfilecount=0
set upfile=new clsUp ''建立上傳對象
upfile.NoAllowExt="code;" '設置上傳類型的黑名單
upfile.GetData (10240000) '獲得上傳數據,限制最大上傳10M
if upfile.isErr then '假如出錯
select case upfile.isErr
case 1
case 2
Response.Write "你上傳的文件超出我們的限制,最大10M"
end select
else
%>
<table align="center" width="750" border="1" cellpadding="0" cellspacing="0" bordercolor="#000000" class="p9" style="border-collapse: collapse">
<tr bgcolor="#CCCCCC">
<td height="25" valign='middle'> 外地文件 </td>
<td valign='middle'> 大小(字節) </td>
<td valign='middle'> 上傳到 </td>
<td valign='middle'> 形態 </td>
</tr>
<%
FSPath=GetFilePath(Server.mappath("uptofile.asp"),"\")'獲得當前文件在效勞器路徑
ServerPath=GetFilePath(Request.ServerVariables("HTTP_REFERER"),"/")'獲得在網站上的地位
for each formName in upfile.file '列出一切上傳了的文件
set oFile=upfile.file(formname)
FileName=upfile.form(formName)'獲得文本域的值
if not FileName>"" then FileName=oFile.filename'假如沒有輸出新的文件名,就用本來的文件名
upfile.SaveToFile formname,FSPath&FileName ''保存文件 也能夠使用AutoSave來保存,參數一樣,但是會主動建立新的文件名
%>
<tr>
<td height="20" valign='middle'> <%=oFile.FilePath&oFile.FileName%> </td>
<td valign='middle'> <%=oFile.filesize%> </td>
<td valign='middle'> <A HREF="<%=serverpath&FileName%>"><%=FileName%></A> </td>
<td valign='middle'> <%
if upfile.iserr then
Response.Write upfile.errmessage
else
upfilecount=upfilecount+1
Response.Write "上傳成功"
end if
%> </td>
</tr><%
set oFile=nothing
next
%>
<tr>
<td colspan="3" height="25" valign='middle'> 一共上傳了<%=upfileCount%>個文件</td>
</tr>
<%
end if
set upfile=nothing '刪除此對象
%>
</p>
</table>
<FORM METHOD="post" NAME="form1" ENCTYPE="multipart/form-data">
<TABLE BORDER="0" ALIGN="center" CELLPADDING="0" CELLSPACING="0">
<TR>
<TD><TABLE WIDTH="750" BORDER="1" ALIGN="center" CELLPADDING="0" CELLSPACING="0" BORDERCOLOR="#111111" STYLE="BORDER-COLLAPSE: collapse">
<TR>
<TD HEIGHT="27" COLSPAN="2">上傳<INPUT NAME="filenum" CLASS="tx2" VALUE="1" SIZE="4">個文件
<INPUT TYPE="button" NAME="Button" CLASS="bt" onClick="addfile" VALUE="設 定">
</TD>
</TR>
<TR>
<TD> <DIV ID="uptd"> </DIV></TD>
</TR>
<TR>
<TD HEIGHT="30" COLSPAN="2" ALIGN="middle">
<INPUT TYPE="submit" NAME="Button" CLASS="bt" VALUE="上 傳">
<INPUT TYPE="reset" NAME="Button" CLASS="bt" VALUE="重 置">
</TD>
</TR>
</TABLE></TD>
</TR>
</TABLE>
</FORM>
</BODY>
</HTML>
更多信息請查看IT技術專欄
公眾號
事業單位
當前位置：
公考類
招聘類
各類考試
