📄 upload.asp

📁 这是一套基于WEB的网站管理系统
💻 ASP
字号:
<!--#include file="config.asp"-->
<!--#include file="check.asp"-->
<!--#include file="../inc/UploadCls.Asp"-->
<script language=JavaScript>
// 文件上传成功接口操作
function doInterfaceUpload(strValue){
	if (strValue=="") return;
	var objLinkUpload = parent.document.getElementsByName("UploadFileList")[0];
	if (objLinkUpload){
		if (objLinkUpload.value!=""){
			objLinkUpload.value = objLinkUpload.value + "|";
		}
		objLinkUpload.value = objLinkUpload.value + strValue;
		objLinkUpload.fireEvent("onchange");
	}
}
</script>
<%
Server.ScriptTimeOut = 18000
Dim UploadObject,AllowFileSize,AllowFileExt
Dim sUploadDir,SaveFileName,PathFileName,url
Dim sAction,sType,SaveFilePath,UploadPath
UploadObject = CInt(Newasp.UploadClass)   '上传文件对象 --- 0=无组件上传,1=新云上传组件,2=刘云峰上传组件
AllowFileSize = CLng(Newasp.UploadFileSize * 1024 )
AllowFileExt = Newasp.UploadFileType
AllowFileExt = Replace(Replace(UCase(AllowFileExt), "ASP", ""), "ASPX", "")
url = Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST")
sType = UCase(Request.QueryString("sType"))
If Newasp.CheckPost=False Then
	Call Returnerr(Postmsg)
	Response.End
End If
Select Case ChannelID
	Case 0
		If stype = "AD" Then
			UploadPath = "adfile/UploadPic/"
			sUploadDir = Newasp.InstallDir & UploadPath
		ElseIf stype = "LINK" Then
			UploadPath = "link/UploadPic/"
			sUploadDir = Newasp.InstallDir & UploadPath
		Else
			UploadPath = "UploadFile/"
			sUploadDir = Newasp.InstallDir & UploadPath
		End If
	Case Else
		UploadPath = "UploadPic/"
		sUploadDir = Newasp.InstallDir & Newasp.ChannelDir & UploadPath
End Select

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
	Dim strUserToday
	strUserToday = UserToday(0) &","& UserToday(1)+1 &","& UserToday(2) &","& UserToday(3) &","& UserToday(4) &","& UserToday(5)
	UpdateUserToday(strUserToday)
	SaveFilePath = UploadPath & SaveFilePath
	Call OutScript(SaveFilePath)
End If
%>
<!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="0" align=center>
<tr vAlign=top>
<td class=TableRow1>
<table border="0" cellspacing="0" cellpadding="0">
<form action='?action=save&ChannelID=<%=ChannelID%>&sType=<%=sType%>' method=post name=form2 enctype="multipart/form-data">
<tr vAlign=top>
<td align=center noWrap valign=top>
<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%> <br>
允许上传的大小：<font color=red><B><%=CStr(Newasp.UploadFileSize)%></B></font>&nbsp;KB
您今天还可以上传<font color=red><B><%=CLng(GroupSetting(21)) - CLng(UserToday(1)) %></B></font>个文件</td>
</tr></form></table></td>
</tr></table>
</body>
</html>
<%
'================================================
'过程作用：无组件上传类
'================================================
Private Sub UploadCls_0()
	On Error Resume Next
	Dim objUpload, objFile,FilePath,sFileExt,sFilePath,RndFileName
	' 建立上传对象
	Set objUpload = New upfile_class
	' 取得上传数据,限制最大上传
	objUpload.GetData(AllowFileSize)
	sFilePath = CreatePath(sUploadDir)
	FilePath = sUploadDir & sFilePath
	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)
	RndFileName = GetRndFileName(sFileExt)
	SaveFileName = FilePath & RndFileName
	SaveFilePath = sFilePath & RndFileName
	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,sFilePath
	Set objUpload = Server.CreateObject("NewCloudCMS.FileUpload") '建立上传对象
	'objUpload.AutoSave = 1
	objUpload.AllowPlain = 0  '是否允许上传无效格式的文件，0=不允许，1=允许
	objUpload.ExtName = AllowFileExt '上传文件类型
	sFilePath = CreatePath(sUploadDir) '按日期生成目录
	FilePath = sUploadDir & sFilePath
	objUpload.SavePath = FilePath '保存上传文件
	objUpload.MaxSize = AllowFileSize '上传文件大小
	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
		SaveFilePath = sFilePath & 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
	Case 4
		Call OutAlertScript("请选择一个有效的上传文件名，文件上传失败!');history.go(-1)</script>")
		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,sFilePath
	Set objUpload = Server.CreateObject("LyfUpload.UploadFile")
	objUpload.MaxSize = AllowFileSize  '上传文件大小
	objUpload.ExtName = AllowFileExt '上传文件类型
	sFilePath = CreatePath(sUploadDir) '按日期生成目录
	FilePath = sUploadDir & sFilePath
	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
		SaveFilePath = 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
	If CInt(Newasp.Modules) = 1 Then
		Response.Write "doInterfaceUpload('" & url & "')" & vbCrLf
	End If
	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 + -