清理上传文件的简易代码(asp)

<%@language=vbscript codepage=936 %>
<%
dim strFileName
strFileName="?"
dim totalPut,CurrentPage,TotalPages,pageFileCount,pageTotleSize
dim UploadDir,TruePath,fso,theFolder,theFile,whichfile,thisfile,FileCount,TotleSize

Const SaveUpFilesPath="UploadFiles" '文件所在目录
Const MaxPerPage=5 '每页显示记录数


if request("page")<>"" then
currentPage=cint(request("page"))
else
currentPage=1
end if

if right(SaveUpFilesPath,1)<>"/" then
UploadDir="../" & SaveUpFilesPath & "/"
else
UploadDir="../" & SaveUpFilesPath
end if
TruePath=Server.MapPath(UploadDir)
If not IsObjInstalled("Scripting.FileSystemObject") Then
Response.Write "<b><font color=red>你的服务器不支持 FSO(Scripting.FileSystemObject)! 不能使用本功能</font></b>"
Else
set fso=CreateObject("Scripting.FileSystemObject")
if request("Action")="Del" then
whichfile=server.mappath(Request("FileName"))
Set thisfile = fso.GetFile(whichfile)
thisfile.Delete True
end if

%>
<script language="JavaScript">
function ConfirmDel()
{
if (confirm("你真的要删除此文件吗!"))
return true;
else
return false;
}
</script>
<table width="100%" height="100%" border="0" cellpadding="0" cellspacing="0">
<tr>
<td width="862" align="center" valign="top"> <br>
<p align="center"><strong>上
传 文 件 管 理</strong></p>
<%
if fso.FolderExists(TruePath)then
FileCount=0
TotleSize=0
Set theFolder=fso.GetFolder(TruePath)
For Each theFile In theFolder.Files
FileCount=FileCount+1
TotleSize=TotleSize+theFile.Size
next
totalPut=FileCount
if currentpage<1 then
currentpage=1
end if
if (currentpage-1)*MaxPerPage>totalput then
if (totalPut mod MaxPerPage)=0 then
currentpage= totalPut / MaxPerPage
else
currentpage= totalPut / MaxPerPage + 1
end if

end if
if currentPage=1 then
showContent
showpage2 strFileName,totalput,MaxPerPage
response.write "<br><div align='center'>本页共显示 <b>" & pageFileCount & "</b> 个文件,占用 <b>" & pageTotleSize/1024 & "</b> K</div>"
else
if (currentPage-1)*MaxPerPage<totalPut then
showContent
showpage2 strFileName,totalput,MaxPerPage
response.write "<br><div align='center'>本页共显示 <b>" & pageFileCount & "</b> 个文件,占用 <b>" & pageTotleSize/1024 & "</b> K</div>"
else
currentPage=1
showContent
showpage2 strFileName,totalput,MaxPerPage
response.write "<br><div align='center'>本页共显示 <b>" & pageFileCount & "</b> 个文件,占用 <b>" & pageTotleSize/1024 & "</b> K</div>"
end if
end if
else
response.write "找不到文件夹!可能是配置有误!"
end if
end if

sub showContent()
dim c
pageFileCount=0
pageTotleSize=0
%>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="2" class="border">
<tr bgcolor="A4B6D7" class="title">
<td width="158" height="25" align="center">文件名</td>
<td width="84" height="20" align="center">文件大小</td>
<td width="134" height="20" align="center">文件类型</td>
<td width="119" height="20" align="center">最后修改时间</td>
<td width="43" height="20" align="center">操作</td>
</tr>
<%

For Each theFile In theFolder.Files
c=c+1
if pageFileCount>=MaxPerPage then
exit for
elseif c>MaxPerPage*(CurrentPage-1) then
%>
<tr class="tdbg">
<td height="22" bgcolor="F2F8FF"><a href="<%=(UploadDir & theFile.Name)%>" target="_blank"><strong>&nbsp;<%=theFile.Name%></strong></a></td>
<td width="84" align="right" bgcolor="F2F8FF"><%=theFile.size%>字节</td>
<td width="134" align="center" bgcolor="F2F8FF"><%=theFile.type%></td>
<td width="119" align="center" bgcolor="F2F8FF"><%=theFile.DateLastModified%></td>
<td width="43" align="center" bgcolor="F2F8FF"><a href="?Action=Del&FileName=<%=UploadDir&theFile.Name%>" onClick="return ConfirmDel()">删除</a></td>
</tr>
<%
pageFileCount=pageFileCount+1
pageTotleSize=pageTotleSize+theFile.Size
end if
Next
%>
</table>
<%
end sub
%> </td>
</tr>
</table>
<%
sub showpage2(sfilename,totalnumber,maxperpage)
dim n, i,strTemp
if totalnumber mod maxperpage=0 then
n= totalnumber / maxperpage
else
n= totalnumber / maxperpage+1
end if
strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td>"
strTemp=strTemp & "共 <b>" & totalnumber & "</b> 个文件,占用 <b>" & TotleSize/1024 & "</b> K&nbsp;&nbsp;&nbsp;"
sfilename=JoinChar(sfilename)
if CurrentPage<2 then
strTemp=strTemp & "首页 上一页&nbsp;"
else
strTemp=strTemp & "<a href='" & sfilename & "page=1'>首页</a>&nbsp;"
strTemp=strTemp & "<a href='" & sfilename & "page=" & (CurrentPage-1) & "'>上一页</a>&nbsp;"
end if

if n-currentpage<1 then
strTemp=strTemp & "下一页 尾页"
else
strTemp=strTemp & "<a href='" & sfilename & "page=" & (CurrentPage+1) & "'>下一页</a>&nbsp;"
strTemp=strTemp & "<a href='" & sfilename & "page=" & n & "'>尾页</a>"
end if
strTemp=strTemp & "&nbsp;页次:<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
strTemp=strTemp & "&nbsp;<b>" & maxperpage & "</b>" & "个/页"
strTemp=strTemp & "&nbsp;转到:<select name='page' size='1' οnchange='javascript:submit()'>"
for i = 1 to n
strTemp=strTemp & "<option value='" & i & "'"
if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
strTemp=strTemp & ">第" & i & "页</option>"
next
strTemp=strTemp & "</select>"
strTemp=strTemp & "</td></tr></form></table>"
response.write strTemp
end sub

'***************************************************
'函数名:IsObjInstalled
'作 用:检查组件是否已经安装
'参 数:strClassString ----组件名
'返回值:True ----已经安装
' False ----没有安装
'***************************************************
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function

'***********************************************
'函数名:JoinChar
'作 用:向地址中加入 ? 或 &
'参 数:strUrl ----网址
'返回值:加了 ? 或 & 的网址
'pos=InStr(1,"abcdefg","cd")
'则pos会返回3表示查找到并且位置为第三个字符开始。
'这就是“查找”的实现,而“查找下一个”功能的
'实现就是把当前位置作为起始位置继续查找。
'***********************************************
function JoinChar(strUrl)
if strUrl="" then
JoinChar=""
exit function
end if
if InStr(strUrl,"?")<len(strUrl) then
if InStr(strUrl,"?")>1 then
if InStr(strUrl,"&")<len(strUrl) then
JoinChar=strUrl & "&"
else
JoinChar=strUrl
end if
else
JoinChar=strUrl & "?"
end if
else
JoinChar=strUrl
end if
end function
%>
无组件ASP文件上传代码 记得在建立一个文件夹"updata" saveannounce_upload.asp 上传页 ------------------------------------ body {font-size:9pt;} input {font-size:9pt;} 文件上传 文件 ------------------------------------ saveannouce_upfile.asp 保存文件到服务器 ------------------------------------ 文件上传 <% dim upload,file,formName,formPath set upload=new upload_5xSoft ''建立上传对象 formPath=upload.form("filepath") ''在目录后加(/) if right(formPath,1)"/" then formPath=formPath&"/" for each formName in upload.file ''列出所有上传了的文件 set file=upload.file(formName) ''生成一个文件对象 if file.filesize<100 then response.write "请先选择你要上传文件 [ 重新上传 ]" response.end end if if file.filesize>500*1000 then '设置上传文件大小为500K response.write "文件大小超过了限制 500K [ 重新上传 ]" response.end end if if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据 file.SaveAs Server.mappath("updata\"&file.FileName) ''保存文件 end if set file=nothing next set upload=nothing response.write "文件上传成功 [ 继续上传 ]" %> ------------------------------------ upload.inc 建立upload对象 ------------------------------------ dim upfile_5xSoft_Stream Class upload_5xSoft dim Form,File,Version Private Sub Class_Initialize dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr Version="" if Request.TotalBytes<1 then Exit Sub set Form=CreateObject("Scripting.Dictionary") set File=CreateObject("Scripting.Dictionary") set upfile_5xSoft_Stream=CreateObject("Adodb.Stream") upfile_5xSoft_Stream.mode=3 upfile_5xSoft_Stream.type=1 upfile_5xSoft_Stream.open upfile_5xSoft_Stream.write Request.BinaryRead(Request.TotalBytes) vbEnter=Chr(13)&Chr(10) iDivLen=inString(1,vbEnter)+1 strDiv=subString(1,iDivLen) iFormStart=iDivLen iFormEnd=inString(iformStart,strDiv)-1 while iFormStart 0 and iFileNameStartiStart then mFileSize=iEnd-iStart-4 else mFileSize=0 end if set theFile=new FileInfo theFile.FileName=getFileName(mFileName) theFile.FilePath=getFilePath(mFileName) theFile.FileSize=mFileSize theFile.FileStart=iStart+4 theFile.FormName=FormName file.add mFormName,theFile else iStart=inString(iEnd+1,vbEnter&vbEnter) iEnd=inString(iStart+4,vbEnter&strDiv) if iEnd>iStart then mFormValue=subString(iStart+4,iEnd-iStart-4) else mFormValue="" end if form.Add mFormName,mFormValue end if iFormStart=iformEnd+iDivLen iFormEnd=inString(iformStart,strDiv)-1 wend End Sub Private Function subString(theStart,theLen) dim i,c,stemp upfile_5xSoft_Stream.Position=theStart-1 stemp="" for i=1 to theLen if upfile_5xSoft_Stream.EOS then Exit for c=ascB(upfile_5xSoft_Stream.Read(1)) If c > 127 Then if upfile_5xSoft_Stream.EOS then Exit for stemp=stemp&Chr(AscW(ChrB(AscB(upfile_5xSoft_Stream.Read(1)))&ChrB(c))) i=i+1 else stemp=stemp&Chr(c) End If Next subString=stemp End function Private Function inString(theStart,varStr) dim i,j,bt,theLen,str InString=0 Str=toByte(varStr) theLen=LenB(Str) for i=theStart to upfile_5xSoft_Stream.Size-theLen if i>upfile_5xSoft_Stream.size then exit Function upfile_5xSoft_Stream.Position=i-1 if AscB(upfile_5xSoft_Stream.Read(1))=AscB(midB(Str,1)) then InString=i for j=2 to theLen if upfile_5xSoft_Stream.EOS then inString=0 Exit for end if if AscB(upfile_5xSoft_Stream.Read(1))AscB(MidB(Str,j,1)) then InString=0 Exit For end if next if InString0 then Exit Function end if next End Function Private Sub Class_Terminate form.RemoveAll file.RemoveAll set form=nothing set file=nothing upfile_5xSoft_Stream.close set upfile_5xSoft_Stream=nothing End Sub Private function GetFilePath(FullPath) If FullPath "" Then GetFilePath = left(FullPath,InStrRev(FullPath, "\")) Else GetFilePath = "" End If End function Private function GetFileName(FullPath) If FullPath "" Then GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1) Else GetFileName = "" End If End function Private function toByte(Str) dim i,iCode,c,iLow,iHigh toByte="" For i=1 To Len(Str) c=mid(Str,i,1) iCode =Asc(c) If iCode255 Then iLow = Left(Hex(Asc(c)),2) iHigh =Right(Hex(Asc(c)),2) toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh) Else toByte = toByte & chrB(AscB(c)) End If Next End function End Class Class FileInfo dim FormName,FileName,FilePath,FileSize,FileStart Private Sub Class_Initialize FileName = "" FilePath = "" FileSize = 0 FileStart= 0 FormName = "" End Sub Public function SaveAs(FullPath) dim dr,ErrorChar,i SaveAs=1 if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function if FileStart=0 or right(fullpath,1)="/" then exit function set dr=CreateObject("Adodb.Stream") dr.Mode=3 dr.Type=1 dr.Open upfile_5xSoft_Stream.position=FileStart-1 upfile_5xSoft_Stream.copyto dr,FileSize dr.SaveToFile FullPath,2 dr.Close set dr=nothing SaveAs=0 end function End Class
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值