picupfile.asp

类似于baidu的百度知道

<style type="text/css">
<!--
body {
margin-left: 0px;
margin-top: 0px;
margin-right: 0px;
margin-bottom: 0px;
}
TD {
FONT-SIZE: 9pt; LINE-HEIGHT: 150%; FONT-FAMILY: 宋体
}
-->
</style>
<!--#include FILE="picupload.inc"-->
<%
''盛世麒麟 专注于网络、平面、多媒体设计
''http://www.ssqilin.com
''追梦阳光贴吧批量图片上传
''2007年农历新年修改制作


server.scripttimeout=1900
''建立上传目录
Dim objFSO,Fsofolder,uploadpath
Pathvalue="Upload/"
uploadpath = year(now) & "-" & month(now)
If Right(Pathvalue,1)<>"/" Then Pathvalue = Pathvalue&"/"
On Error Resume Next
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(Server.MapPath(Pathvalue & uploadpath))=False Then
objFSO.CreateFolder Server.MapPath(Pathvalue & uploadpath)
End If
If Err.Number = 0 Then
UpFilePath = Pathvalue & uploadpath & "/"
Else
UpFilePath = Pathvalue
End If
Set objFSO = Nothing

dim upload,file,formName,iCount
dim url,url1
set upload=new upload_5xSoft ''建立上传对象

iCount=0
for each formName in upload.objFile ''列出所有上传了的文件
set file=upload.file(formName)  ''生成一个文件对象

''如果一个文本框没有内容，则下面的全部过滤掉
if file.FileSize<1 then 
exit for
end if

''判断文件类型
FileExt=lcase(file.FileExt)
if CheckFileExt(fileEXT)=false then
response.write "<font size=2>上传文件格式不正确或者文件名太长![ <a href=# onclick=history.go(-1)>请重新上传</a> ]</font>"
response.end
end if

randomize
ranNum=int(90000*rnd)+10000
Filename=UpFilePath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&FileExt

if File.Filesize>50000000 then
response.write "<font size=2>文件上传大小超过了限制 500K[ <a href=# onclick=history.go(-1)>重新上传</a> ]</font>"
response.end
end if
    
if file.FileSize>0 then         ''如果 FileSize > 0 说明有文件数据
  file.SaveAs Server.mappath(Filename)   ''保存文件
  iCount=iCount+1
  Filename=""&Filename
Response.write "<script>parent.ftiwen.content.value+='        <-----点击下载或浏览!----->[url]"&Filename&"[/url]'</script>" '[img]"&Filename&"[/img]  可以添加在上一行的"点击"前面
  i=i+1
set file=nothing
end if

next
set upload=nothing  ''删除此对象
Htmend iCount

'判断文件类型是否合格
Private Function CheckFileExt (fileEXT)
dim Forumupload,i
Forumupload="jpg,gif,png,PNG,JPG,GIF,bmp,BMP,jpeg,JPEG"
Forumupload=split(Forumupload,",")
for i=0 to ubound(Forumupload)
if lcase(fileEXT)=lcase(trim(Forumupload(i))) then
CheckFileExt=true
exit Function
else
CheckFileExt=false
end if
next
End Function

sub HtmEnd(Msg)
set upload=nothing
response.write "<font size=2 color=red>&nbsp;文件上传成功 [ <a href=# onclick=history.go(-1)>如需继续，请点击!</a> ]</font>"
response.end
end sub
%>