📄 upfile.asp

📁 这是一套基于WEB的网站管理系统
💻 ASP
字号:
<!--#include file="config.asp"-->
<!--#include file="check.asp"-->
<!--#include file="../inc/UploadCls.Asp"-->
<%
Server.ScriptTimeOut = 18000
Dim UploadObject,AllowFileSize,AllowFileExt
Dim sUploadDir,SaveFileName,PathFileName,FileExtName
Dim sAction,sType,AutoRename
UploadObject = CInt(Newasp.UploadClass)   '上传文件对象 --- 0=无组件上传,1=新云上传组件,2=刘云峰上传组件
AllowFileSize = CLng(Newasp.UploadFileSize * 1024 )
AllowFileExt = Newasp.UploadFileType
AllowFileExt = Replace(Replace(UCase(AllowFileExt), "ASP", ""), "ASPX", "")
If Newasp.CheckPost=False Then
	Call Returnerr(Postmsg)
	Response.End
End If
Select Case ChannelID
	Case 0
		sUploadDir = Newasp.InstallDir & "UploadFile/"
	Case Else
		sUploadDir = Newasp.InstallDir & Newasp.ChannelDir & "UploadFile/"
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 CInt(Newasp.StopUpload) = 1 Then
		Response.Write ("<script>alert('对不起!本频道未开放上传功能!');history.go(-1)</script>")
		Response.End
	End If
	If CInt(GroupSetting(20)) <> 1 Then
		Response.Write ("<script>alert('对不起!您没有上传文件的权限');history.go(-1)</script>")
		Response.End
	End If
	If CLng(UserToday(1)) => CLng(GroupSetting(21)) Then
		Response.Write ("<script>alert('对不起!您每天只能上传" & GroupSetting(21) & "个文件。');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)
%>
<script language=javascript>
parent.document.myform.filePath.value='<%=PathFileName%>';
</script>
<input type=text name=file1 size=60 value='<%=PathFileName%>'> <input type="button" name="Submit4" onclick="javascript:history.go(-1)" value="继续上传文件" class=Button><br>
<font color=blue>请把地址复制到相应的输入框</font>
<%
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=45>
<input type="submit" name="Submit" value="开始上传">
<input type=checkbox name=AutoRename value='yes'> 自动更名
</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,sFileName
	' 建立上传对象
	Set objUpload = New upfile_class
	' 取得上传数据,限制最大上传
	objUpload.GetData(AllowFileSize)
	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
	AutoRename = LCase(objUpload.form("AutoRename"))
	Set objFile = objUpload.File("uploadfile")
	sFileExt = LCase(objFile.FileExt)
	sFileName = objFile.FileName
	Call CheckValidExt(sFileExt)
	If AutoRename = "yes" Then
		SaveFileName = FilePath & GetRndFileName(sFileExt)
	Else
		SaveFileName = FilePath & sFileName
	End If
	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,sFileExt
	Set objUpload = Server.CreateObject("NewCloudCMS.FileUpload") '建立上传对象
	objUpload.AutoSave = 2
	objUpload.AllowPlain = 0  '是否允许上传无效格式的文件，0=不允许，1=允许
	objUpload.ExtName = AllowFileExt                    '上传文件类型
	FilePath = sUploadDir & CreatePath(sUploadDir)      '按日期生成目录
	objUpload.SavePath = FilePath                       '保存上传文件
	objUpload.MaxSize = AllowFileSize     '上传文件大小
	objUpload.OpenLoad '打开上传对象
	AutoRename = LCase(objUpload.form("AutoRename"))
	sFileExt = objUpload.form("uploadfile_Ext")
	If AutoRename = "yes" Then
		FileName = GetRndFileName(sFileExt)         '自动更名上传方式
	Else
		FileName = objUpload.form("uploadfile_Name")'原文件名上传方式
	End If
	objUpload.Save "uploadfile",FileName
	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,sFileName
	Set objUpload = Server.CreateObject("LyfUpload.UploadFile")
	objUpload.MaxSize = AllowFileSize '上传文件大小
	objUpload.ExtName = AllowFileExt '上传文件类型
	FilePath = sUploadDir & CreatePath(sUploadDir)
	fromName = objUpload.Request("uploadfile")
	AutoRename = LCase(objUpload.Request("AutoRename"))
	patharray = Split(fromName, """")
	If Len(patharray(1)) <> 0 Then
		FileName_path = Split(patharray(1), ".")
		sFileName = Split(patharray(1), "\")
		FileExt = FileName_path(1)
	End If
	If AutoRename = "yes" Then
		FileName = GetRndFileName(FileExt)
		ss = objUpload.SaveFile("uploadfile", Server.MapPath(FilePath), True, FileName)
	Else
		FileName = sFileName(UBound(sFileName))
		ss = objUpload.SaveFile("uploadfile", Server.MapPath(FilePath), True)
	End If
	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
%>
💿 文件大小 3395 K
👤 上传用户 jc6629402
📂 所属分类 Internet/网络编程
🏷️ 相关标签

#WEB #网站 #管理系统
⌨️ 快捷键说明

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