📄 upfile.asp

📁 采用三级目录
💻 ASP
字号:
<!-- #include file="conn.asp" -->
  <%   
dim rs,sql,lei,msize,mwidth
set rs=server.createobject("adodb.recordset")
sql="select * from setmap"
rs.open sql,conn,1,1
lei=rs("leixin")
msize=rs("size")
mwidth=rs("width")
rs.close
set rs=nothing
conn.close
set conn=nothing
%>
<style>
<!--
BODY{
margin-top: 3px;
	background:#f4f4f4;
	font-size: 12px;
	font-style: normal;
	font-weight: normal;
	font-variant: normal;
	text-transform: none;
	color: #000000;
	text-decoration: none;
	font-family: Verdana;
}
-->
</style>
<body>  <%   
    
  Set   Upload   =   Server.CreateObject("Persits.Upload")     
    
  '   Prevent   overwriting     
  Upload.OverwriteFiles   =   False     
    
  '   We   use   memory   uploads,   文件大小限制   ,单位：b   
  Upload.SetMaxSize   msize,   true     
    
  if   Request.QueryString("PID")   =   ""   then   
  Upload.ProgressID="010D60EB00C5AA4B"   
  else   
  Upload.ProgressID=Request.QueryString("PID")   
  end   if   
    
  On   Error   Resume   Next   
      
  '   Save   to   memory   保存到内存   
  Upload.Save   
    
  If   Err.Number   =   8   Then   
        Response.Write   "文件大于"& msize &"b　[   <a   href=#   onclick=history.go(-1)>重新上传</a>   ]"   
  End   If     
    
    
  '为使文件不重名，用系统时间+随机数，作为文件名   
  Dim   ranNum   
  randomize   
  ranNum=int(999*rnd)   
  CreateName=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum   
  NewName   =   CreateName   
  '保存文件路径   
  articlepath   =   Server.MapPath("upfile")     
    
    
  For   Each   File   in   Upload.Files     
  FileExt=Lcase(replace(File.ext,".",""))   
  '服务器端判断文件类型,动网论坛的判断方式   
  If   CheckFileExt(FileExt)=false   then   
    Response.write   "文件格式不正确,或不能为空　[   <a   href=#   onclick=history.go(-1)>重新上传</a>   ]"   
    
  else   
        File.SaveAs   articlepath   &   "/"   &   NewName   &   File.ext     
'''图片
  If Lcase(FileExt)="jpg" or Lcase(FileExt)="gif" or Lcase(FileExt)="bmp" or Lcase(FileExt)="png" then
  Response.Write "上传成功："& File.FileName &" 　[   <a   href=#   onclick=history.go(-1)>继续上传</a>   ]"
  response.write "<script language=""javascript"">parent.myform.txtcontent.value+='[img]"& File.FileName &"[/img]';</script>"
If Not IsObjInstalled("Persits.Jpeg") Then
Response.Write "<font color=red>缩略图未生成，请安装aspjpeg组件</font>"
Else
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Path = Server.MapPath("upfile") & "\"& File.FileName &""
Jpeg.Open Path
Jpeg.Width = mwidth
Jpeg.Height =Jpeg.OriginalHeight / (Jpeg.OriginalWidth / Jpeg.Width)
Jpeg.Save Server.MapPath("small") & "\"& File.FileName &""
end if
else
'''不是图片
  Response.Write "上传成功："& File.FileName &" 　[   <a   href=#   onclick=history.go(-1)>继续上传</a>   ]"
  response.write "<script language=""javascript"">parent.myform.txtcontent.value+='[url=admin/up/upfile/"& File.FileName &"]"& File.FileName &"[/url]';</script>"
end if
  End   If   
    
  Next     
    
  %>     
  <%   
  '服务器端判断文件类型,动网论坛的判断方式   
  Private   Function   CheckFileExt(FileExt)   
    
  If   FileExt=""   or   IsEmpty(FileExt)   Then   
  CheckFileExt=false   
  Exit   Function   
  End   If   
  If   Lcase(FileExt)="asp"   or   Lcase(FileExt)="asa"   or   Lcase(FileExt)="aspx"   then   
  CheckFileExt=false   
  Exit   Function   
  End   If   
  If instr(lei,Lcase(FileExt)) then   
  CheckFileExt=true   
  Exit   Function   
  Else   
  CheckFileExt=false   
  End   If   
  End   Function   
  %>   
<%
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
''''''''''''''''''''''''''''''
Function getver(Classstr)
On Error Resume Next
getver=""
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(Classstr)
If 0 = Err Then getver=xtestobj.version
Set xTestObj = Nothing
Err = 0
End Function
%>
</body>
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -