📄 upload.asp

📁 这是一套基于WEB的网站管理系统
💻 ASP
字号:
<!--#include file="../conn.asp"-->
<!--#include file="../inc/const.asp"-->
<!--#include file="../inc/UploadCls.Asp"-->
<!--#include file="../inc/cls_down.Asp"-->
<%
Server.ScriptTimeOut = 18000
If Newasp.CheckPost = False Then
	Call OutAlertScript("您提交的数据不合法，请不要从外部提交。")
End If
If Session("AdminName") = Empty Then Response.End
Dim sType
Dim sAllowExt, nAllowSize, sUploadDir, nUploadObject, sBaseUrl, sContentPath
Dim sFileExt, sOriginalFileName, sSaveFileName, sPathFileName, nFileNum
Dim ChannelID,SaveFilePath,UploadPath,strUploadDir
If Request("ChannelID") <> "" And Request("ChannelID") <> 0 Then
	ChannelID = CInt(Request("ChannelID"))
	Newasp.ReadChannel(ChannelID)
Else
	ChannelID = 0
End If
Call InitUpload()		' 初始化上传变量

Dim sAction
sAction = UCase(Trim(Request.QueryString("action")))

Select Case sAction
Case "REMOTE"
	Call LoadRemote()			' 远程自动获取
Case "SAVE"
	Call ShowForm()			' 显示上传表单
	Call DoSave()			' 存文件
Case Else
	Call ShowForm()			' 显示上传表单
End Select
CloseConn
Sub ShowForm() 
%>
<HTML>
<HEAD>
<TITLE>文件上传</TITLE>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style type="text/css">
body, a, table, div, span, td, th, input, select{font:9pt;font-family: "宋体", Verdana, Arial, Helvetica, sans-serif;}
body {padding:0px;margin:0px}
</style>
<script language="JavaScript" src="dialog/dialog.js"></script>
</head>
<body bgcolor=menu>
<form action="?action=save&type=<%=sType%>&ChannelID=<%=ChannelID%>" method=post name=myform enctype="multipart/form-data">
<input type=file name=uploadfile size=1 style="width:100%" onchange="originalfile.value=this.value">
<input type=hidden name=originalfile value="">
</form>
<script language=javascript>
var sAllowExt = "<%=sAllowExt%>";
// 检测上传表单
function CheckUploadForm() {
	if (!IsExt(document.myform.uploadfile.value,sAllowExt)){
		parent.UploadError("提示：\n\n请选择一个有效的文件，\n支持的格式有（"+sAllowExt+"）！");
		return false;
	}
	return true
}

// 提交事件加入检测表单
var oForm = document.myform ;
oForm.attachEvent("onsubmit", CheckUploadForm) ;
if (! oForm.submitUpload) oForm.submitUpload = new Array() ;
oForm.submitUpload[oForm.submitUpload.length] = CheckUploadForm ;
if (! oForm.originalSubmit) {
	oForm.originalSubmit = oForm.submit ;
	oForm.submit = function() {
		if (this.submitUpload) {
			for (var i = 0 ; i < this.submitUpload.length ; i++) {
				this.submitUpload[i]() ;
			}
		}
		this.originalSubmit() ;
	}
}

// 上传表单已装入完成
try {
	parent.UploadLoaded();
}
catch(e){
}
</script>
</body>
</html>
<% 
End Sub 
' 保存操作
Sub DoSave()
	If Session("AdminName") = "" Then
		Call OutScript("parent.UploadError('对不起！你还没有登陆不能上传文件。')")
		Response.End
	End If
	If Not Newasp.CheckAdmin("UploadFile") Then
		Call OutScript("parent.UploadError('对不起!您没有上传文件的权限')")
		Response.End
	End If
	Select Case nUploadObject
		Case "0"
			Call UploadCls_0    '无组件上传类
		Case "1"
			Call UploadCls_1      '新云上传组件
		Case "2"
			Call UploadCls_2      '刘云峰上传组件
		Case "999"
			Call OutScript("parent.UploadError('对不起系统已经关闭上传文件功能！')")
			Response.End
		Case Else
			Call OutScript("parent.UploadError('对不起系统已经关闭上传文件功能！')")
			Response.End
	End Select
	strUploadDir = CreatePath(sUploadDir)
	sUploadDir = sUploadDir & strUploadDir
	Select Case sBaseUrl
		Case "0"
			sContentPath = sUploadDir
		Case "1"
			sContentPath = RelativePath2RootPath(sUploadDir)
		Case "2"
			sContentPath = RootPath2DomainPath(RelativePath2RootPath(sUploadDir))
	End Select
	sPathFileName = sContentPath & sSaveFileName
	SaveFilePath = UploadPath & strUploadDir & sSaveFileName
	Call OutScript("parent.UploadSaved('" & sPathFileName & "');var obj=parent.dialogArguments.dialogArguments;if (!obj) obj=parent.dialogArguments;try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & SaveFilePath & "');} catch(e){}")

End Sub

' 自动获取远程文件
Sub LoadRemote()
	Dim sContent, i,objFile
	strUploadDir = CreatePath(sUploadDir)
	sUploadDir = sUploadDir & strUploadDir
	For i = 1 To Request.form("NewCloud_UploadText").Count 
		sContent = sContent & Request.form("NewCloud_UploadText")(i) 
	Next
	If sAllowExt <> "" Then
		Set objFile = New Download_Cls
		objFile.RemoteDir = sUploadDir
		objFile.AllowMaxSize = nAllowSize
		objFile.AllowExtName = sAllowExt
		sContent = objFile.ChangeRemote(sContent)
		sOriginalFileName = objFile.RemoteFileName
		sSaveFileName = objFile.LocalFileName
		sPathFileName = objFile.LocalFilePath
		SaveFilePath = Replace(sPathFileName, Newasp.InstallDir & Newasp.ChannelDir, "",1,-1,1)
	End If

	Response.Write "<HTML><HEAD><TITLE>远程上传</TITLE><meta http-equiv='Content-Type' content='text/html; charset=gb2312'></head><body>" & _
		"<input type=hidden id=UploadText value=""" & inHTML(sContent) & """>" & _
		"</body></html>"

	Call OutScriptNoBack("parent.setHTML(UploadText.value);try{parent.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & SaveFilePath & "');} catch(e){} parent.remoteUploadOK();")
	Set objFile = Nothing
End Sub

' 无组件上传类
Sub UploadCls_0()
	On Error Resume Next
	Dim objUpload, objFile,FilePath
	' 建立上传对象
	Set objUpload = New upfile_class
	' 取得上传数据,限制最大上传
	objUpload.GetData(nAllowSize*1024)
	FilePath = sUploadDir & CreatePath(sUploadDir)
	If objUpload.Err > 0 Then
		Select Case objUpload.Err
		Case 1
			Call OutScript("parent.UploadError('请选择有效的上传文件！')")
		Case 2
			Call OutScript("parent.UploadError('你上传的文件总大小超出了最大限制（" & nAllowSize & "KB）！')")
		Case 3
			Call OutScript("parent.UploadError('^_^哥们！请选择一个有效的上传文件。')")
		End Select
		Response.End
	End If

	Set objFile = objUpload.File("uploadfile")
	sFileExt = LCase(objFile.FileExt)
	Call CheckValidExt(sFileExt)
	sOriginalFileName = objFile.FileName
	sSaveFileName = GetRndFileName(sFileExt)
	objFile.SaveToFile Server.Mappath(FilePath & sSaveFileName)
	
	Set objFile = Nothing
	Set objUpload = Nothing
End Sub
'================================================
'过程作用：新云组件上传
'================================================
Private Sub UploadCls_1()
	On Error Resume Next
	Dim objUpload, FilePath, fromName
	Set objUpload = Server.CreateObject("NewCloudCMS.FileUpload") '建立上传对象
	'objUpload.AutoSave = 0
	objUpload.AllowPlain = 0  '是否允许上传无效格式的文件，0=不允许，1=允许
	objUpload.ExtName = sAllowExt '上传文件类型
	objUpload.MaxSize = CStr(nAllowSize * 1024) '上传文件大小
	FilePath = sUploadDir & CreatePath(sUploadDir) '按日期生成目录
	objUpload.SavePath = FilePath '保存上传文件
	objUpload.OpenLoad '打开上传对象OpenLoad
	fromName = objUpload.form("uploadfile")
	If objUpload.Error = 4 Then
		Call OutScript("parent.UploadError('^_^哥们！请选择一个有效的上传文件。')")
		Response.End
	End If
	Select Case objUpload.form("uploadfile_Err")
	Case -1
		Call OutScript("parent.UploadError('您没有选择要上传的文件名，文件上传失败!')")
		Response.End
	Case 0
		sSaveFileName = fromName
	Case 1
		Call OutScript("parent.UploadError('文件尺寸过大!\n允许上传的文件大小：" & nAllowSize & " KB')")
		Response.End
	Case 2
		Call OutScript("parent.UploadError('<script>alert('上传的文件类型不对!\n可以上传的文件类型如下\n" & sAllowExt & "')")
		Response.End
	Case 3
		Call OutScript("parent.UploadError('<script>alert('文件太大且格式不对，拒绝上传!\n可以上传的文件类型如下\n" & sAllowExt & "\n允许上传的文件大小：" & nAllowSize & " KB')")
		Response.End
	End Select
	Set objUpload = Nothing
End Sub
'================================================
'过程作用：Lyfupload组件上传
'================================================
Sub UploadCls_2()
	On Error Resume Next
	Dim objUpload, ss, FileExt, filename, FilePath
	Dim patharray, FileName_path, fromName
	Set objUpload = Server.CreateObject("LyfUpload.UploadFile")
	objUpload.maxsize = CStr(nAllowSize * 1024) '上传文件大小
	objUpload.extname = sAllowExt '上传文件类型
	If objUpload.Request("uploadfile") = "" Or IsNull(objUpload.Request("uploadfile")) Then
		Call OutScript("parent.UploadError('请选择有效的上传文件！')")
		Response.End
	End If
	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 OutScript("parent.UploadError('文件名重复！')")
		Response.End
	ElseIf ss = "0" Then
		Call OutScript("parent.UploadError('你上传的文件总大小超出了最大限制（" & nAllowSize & "KB）！')")
		Response.End
	ElseIf ss = "1" Then
		Call OutScript("parent.UploadError('请选择有效的上传文件！')")
		Response.End
	ElseIf ss = "" Then
		Call OutScript("parent.UploadError('请选择有效的上传文件！')")
		Response.End
	Else
		sSaveFileName = filename
	End If
	Set objUpload = Nothing
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 OutScript(str)
	Response.Write "<script language=javascript>" & vbcrlf
	Response.Write str
	Response.Write ";history.back()" & vbcrlf
	Response.Write "</script>" & vbcrlf
End Sub
Sub OutScriptNoBack(str)
	Response.Write "<script language=javascript>" & str & "</script>" & vbcrlf
End Sub
' 检测扩展名的有效性
Sub CheckValidExt(sExt)
	Dim b, i, aExt
	b = False
	aExt = Split(sAllowExt, "|")
	For i = 0 To UBound(aExt)
		If LCase(aExt(i)) = sExt Then
			b = True
			Exit For
		End If
	Next
	If b = False Then
		OutScript("parent.UploadError('提示：\n\n请选择一个有效的文件，\n支持的格式有（"+sAllowExt+"）！')")
		Response.End
	End If
End Sub
' 初始化上传限制数据
Sub InitUpload()
	sType = UCase(Trim(Request.QueryString("type")))
	sBaseUrl = "1"        '路径模式 --- 0=相对路径,1=绝对根路径,2绝对全路径
	nUploadObject = CStr(Newasp.UploadClass)   '上传文件对象 --- 0=无组件上传,1=新云上传组件,2=刘云峰上传组件
	nAllowSize = CStr(Newasp.UploadFileSize)
	sAllowExt = Newasp.UploadFileType     '上传文件类型
	If ChannelID <> 0 Then
		sUploadDir = Newasp.InstallDir & Newasp.ChannelDir    '上传文件路径
	Else
		sUploadDir = Newasp.InstallDir    '上传文件路径
	End If
	Select Case sType
		Case "REMOTE"     '远程文件设置
			UploadPath = "UploadPic/"
			sUploadDir = sUploadDir & UploadPath    '上传文件路径
			sAllowExt = "gif|jpg|bmp|png|jpge"           '上传文件类型
		Case "FILE"       '上传文件设置
			UploadPath = "UploadFile/"
			sUploadDir = sUploadDir & UploadPath    '上传文件路径
		Case "MEDIA"      '上传媒体设置
			UploadPath = "UploadFile/"
			sUploadDir = sUploadDir & UploadPath    '上传文件路径
		Case "FLASH"      '上传动画设置
			UploadPath = "UploadFile/"
			sUploadDir = sUploadDir & UploadPath    '上传文件路径
	Case Else         '上传图片设置
		UploadPath = "UploadPic/"
		sUploadDir = sUploadDir & UploadPath    '上传文件路径
	End Select
	' 任何情况下都不允许上传asp脚本文件
	sAllowExt = Replace(Replace(UCase(sAllowExt), "ASP", ""), "ASPX", "")
End Sub
'================================================
' 得到安全字符串,在查询中使用
'================================================
Function Get_SafeStr(str)
	Get_SafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")
End Function
'================================================
' 去除Html格式，用于从数据库中取出值填入输入框时
' 注意：value="?"这边一定要用双引号
'================================================
Function inHTML(str)
	Dim sTemp
	sTemp = str
	inHTML = ""
	If IsNull(sTemp) = True Then
		Exit Function
	End If
	sTemp = Replace(sTemp, "&", "&amp;")
	sTemp = Replace(sTemp, "<", "&lt;")
	sTemp = Replace(sTemp, ">", "&gt;")
	sTemp = Replace(sTemp, Chr(34), "&quot;")
	inHTML = sTemp
End Function
%>
⌨️ 快捷键说明

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