📄 upfiles.asp

📁 这是一套基于WEB的网站管理系统
💻 ASP
字号:
<!--#include file="setup.asp"-->
<!--#include file="check.asp"-->
<!--#include file="../inc/UploadCls.Asp"-->
<%
'=====================================================================
' 软件名称：新云网站管理系统
' 当前版本：NewCloud Site Management System Version 2.0.0
' 文件名称：admin_upfiles.asp
' 更新日期：2004-12-20
' 官方网站：新云网络(www.newasp.net www.newasp.cn) QQ：94022511
'=====================================================================
' Copyright 2002-2005 newasp.net - All Rights Reserved.
' newasp is a trademark of newasp.net
'=====================================================================
Server.ScriptTimeOut = 18000
Dim UploadObject,AllowFileSize,AllowFileExt
Dim sUploadDir,SaveFileName,PathFileName,FileExtName
Dim sAction,sType
UploadObject = CStr(Newasp.UploadClass)   '上传文件对象 --- 0=无组件上传,1=新云上传组件,2=刘云峰上传组件
AllowFileSize = CStr(Newasp.UploadFileSize)
AllowFileExt = Newasp.UploadFileType
AllowFileExt = Replace(Replace(UCase(AllowFileExt), "ASP", ""), "ASPX", "")

Select Case ChannelID
	Case 0
		sUploadDir = Newasp.InstallDir & "UploadFile/"
	Case Else
		sUploadDir = Newasp.InstallDir & Newasp.ChannelDir & "UploadPic/"
End Select
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"><html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta name=keywords content="新云网络,新云论坛,新云下载，newasp.net,dnsxy.com">
<meta name="description" content="Design By www.Newasp.com">
<title>文件上传</title>
<LINK href="style.css" type=text/css rel=stylesheet>
<META content="MSHTML 6.00.2600.0" name=GENERATOR></head>
<body leftMargin=0 topMargin=0 marginwidth=0 marginheight=0>
<table style="width:100%;height:100%" border="0" cellspacing="0" cellpadding="3" align=center>
<tr vAlign=top>
<td class=TableRow1>
<%
sAction = UCase(Trim(Request.QueryString("action")))
If sAction = "SAVE" Then
	If Not ChkAdmin("UploadFile") Then
		Response.Write ("<script>alert('对不起!您没有上传文件的权限');history.go(-1)</script>")
		Response.End
	End If
	Select Case UploadObject
		Case 0
			Call UploadCls_0
		Case 1
			Call UploadCls_1
		Case 2
			Call UploadCls_2
		Case 999
			Response.Write ("<script>alert('本系统未开放上传功能!');history.go(-1)</script>")
			Response.End
		Case Else
			Response.Write ("<script>alert('本系统未开放上传功能!');history.go(-1)</script>")
			Response.End
	End Select
	PathFileName = SaveFileName
	'Call OutScript(PathFileName)
	FileExtName=mid(PathFileName,InStrRev(PathFileName, ".")+1)
	FileExtName=LCase(FileExtName)
%>
<script>
if ("<%=FileExtName%>"=="gif" || "<%=FileExtName%>"=="jpg" || "<%=FileExtName%>"=="png" || "<%=FileExtName%>"=="bmp"){
img="<img src=<%=PathFileName%>>"
}else{
img="<a target=_blank href=<%=PathFileName%>>相关附件</a>"
}
document.oncontextmenu = new Function('return false')
parent.IframeID.document.body.innerHTML+='\n'+img+''
</script>
<input type=text name=file1 size=70 value='<%=PathFileName%>'> <input type="button" name="Submit4" onclick="javascript:history.go(-1)" value="继续上传文件" class=Button>
<%
Else
%>
<table border="0" cellspacing="0" cellpadding="0">
<form action='?action=save&ChannelID=<%=ChannelID%>' method=post name=myform enctype="multipart/form-data">
<tr>
<td align=center noWrap>
<input type="file" name="uploadfile" size=50>
<input type="submit" name="Submit" value="开始上传">
</td>
</tr><tr vAlign=top><TD colspan=4 class=TableRow1 valign=top>
允许上传的文件类型：<%=AllowFileExt%> 　大小：<font color=red><B><%=CStr(Newasp.UploadFileSize)%></B></font>&nbsp;KB</td>
</tr></form></table>
<%
End If
%>
</td>
</tr></table>
</body>
</html>
<%
'================================================
'过程作用：无组件上传类
'================================================
Private Sub UploadCls_0()
	On Error Resume Next
	Dim objUpload, objFile,FilePath,sFileExt
	' 建立上传对象
	Set objUpload = New upfile_class
	' 取得上传数据,限制最大上传
	objUpload.GetData(AllowFileSize*1024)
	FilePath = sUploadDir & CreatePath(sUploadDir)
	If objUpload.Err > 0 Then
		Select Case objUpload.Err
		Case 1
			Call OutAlertScript("请选择有效的上传文件！")
		Case 2
			Call OutAlertScript("你上传的文件总大小超出了最大限制（" & AllowFileSize & "KB）！")
		Case 3
			Call OutAlertScript("^_^哥们！请选择一个有效的上传文件。")
		End Select
		Response.End
	End If

	Set objFile = objUpload.File("uploadfile")
	sFileExt = LCase(objFile.FileExt)
	Call CheckValidExt(sFileExt)
	SaveFileName = FilePath & GetRndFileName(sFileExt)
	objFile.SaveToFile Server.Mappath(SaveFileName)
	
	Set objFile = Nothing
	Set objUpload = Nothing
End Sub
'================================================
'过程作用：新云上传组件
'================================================
Private Sub UploadCls_1()
	On Error Resume Next
	Dim objUpload, FilePath, FileName
	Set objUpload = Server.CreateObject("NewCloudCMS.FileUpload") '建立上传对象
	'objUpload.AutoSave = 1
	objUpload.AllowPlain = 0  '是否允许上传无效格式的文件，0=不允许，1=允许
	objUpload.ExtName = AllowFileExt '上传文件类型
	FilePath = sUploadDir & CreatePath(sUploadDir) '按日期生成目录
	objUpload.SavePath = FilePath '保存上传文件
	objUpload.MaxSize = CStr(AllowFileSize * 1024) '上传文件大小
	objUpload.OpenLoad '打开上传对象
	FileName = objUpload.form("uploadfile")
	If objUpload.Error = 4 Then
		Call OutAlertScript("^_^哥们！请选择一个有效的上传文件。');history.go(-1)</script>")
		Response.End
	End If
	Select Case objUpload.form("uploadfile_Err")
	Case -1
		Call OutAlertScript("您没有选择要上传的文件名，文件上传失败!');history.go(-1)</script>")
		Response.End
	Case 0
		SaveFileName = FilePath & FileName
	Case 1
		Call OutAlertScript("文件尺寸过大!\n允许上传的文件大小：" & AllowFileSize & " KB")
		Response.End
	Case 2
		Call OutAlertScript("上传的文件类型不对!\n可以上传的文件类型如下\n" & AllowFileExt & "")
		Response.End
	Case 3
		Call OutAlertScript("文件太大且格式不对，拒绝上传!\n可以上传的文件类型如下\n" & AllowFileExt & "\n允许上传的文件大小：" & AllowFileSize & " KB")
		Response.End
	End Select
	Set objUpload = Nothing
End Sub
'================================================
'过程作用：Lyfupload组件上传
'================================================
Private Sub UploadCls_2()
	On Error Resume Next
	Dim objUpload, ss, FileExt, FileName, FilePath, fromName
	Dim patharray, FileName_path, File_Ext
	Set objUpload = Server.CreateObject("LyfUpload.UploadFile")
	objUpload.MaxSize = AllowFileSize * 1024 '上传文件大小
	objUpload.ExtName = AllowFileExt '上传文件类型
	FilePath = sUploadDir & CreatePath(sUploadDir)
	fromName = objUpload.Request("uploadfile")
	patharray = Split(fromName, """")
	If Len(patharray(1)) <> 0 Then
		FileName_path = Split(patharray(1), ".")
		'File_Ext = Split(FileName_path(UBound(FileName_path)), ".")
		FileExt = FileName_path(1)
	End If
	FileName = GetRndFileName(FileExt)
	ss = objUpload.SaveFile("uploadfile", Server.MapPath(FilePath), True, FileName)
	If ss = "3" Then
		Call OutAlertScript("文件名重复!")
		Response.End
	ElseIf ss = "0" Then
		Call OutAlertScript("文件尺寸过大!\n允许上传的文件大小：" & AllowFileSize & " KB")
		Response.End
	ElseIf ss = "1" Then
		Call OutAlertScript("上传的文件类型不对!\n可以上传的文件类型如下\n" & AllowFileExt & "")
		Response.End
	ElseIf ss = "" Then
		Call OutAlertScript("您没有选择要上传的文件名，文件上传失败!")
		Response.End
	Else
		SaveFileName = FilePath & FileName
	End If
	Set objUpload = Nothing
End Sub
Private Sub OutScript(url)
	Response.Write "<script language=javascript>" & vbCrLf
	Response.Write "parent.document.myform.ImageUrl.value='" & url & "';" & vbCrLf
	Response.Write "alert('文件上传成功!\n"&url&"');"
	Response.Write "history.go(-1);" & vbCrLf
	Response.Write "</script>" & vbCrLf
End Sub

' 取随机文件名
Function GetRndFileName(sExt)
	Dim sRnd
	Randomize
	sRnd = Int(900 * Rnd) + 100
	GetRndFileName = year(now) & month(now) & day(now) & hour(now) & minute(now) & second(now) & sRnd & "." & sExt
End Function
' 检测扩展名的有效性
Sub CheckValidExt(sExt)
	Dim b, i, aExt
	b = False
	aExt = Split(AllowFileExt, "|")
	For i = 0 To UBound(aExt)
		If LCase(aExt(i)) = sExt Then
			b = True
			Exit For
		End If
	Next
	If b = False Then
		OutAlertScript("提示：\n\n请选择一个有效的文件，\n支持的格式有（"+AllowFileExt+"）！")
		Response.End
	End If
End Sub
%>
⌨️ 快捷键说明

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