upload.asp

来自「小游戏网站演示www.4399.io 拥有4万条游戏数据」· ASP 代码 · 共 339 行 · 第 1/2 页

ASP
339
字号
<!--#include file="setup.asp"-->
<!--#include file="check.asp"-->
<!--#include file="../inc/UploadCls.Asp"-->
<%
'=====================================================================
' 软件名称:四博CMS网站管理系统 2008 sp3
' 当前版本:dincoo.com
' 文件名称:upload.asp
' 更新日期:2007-4-2
' 官方网站:新云网络(www.newasp.net www.newasp.cn) QQ:94022511
'=====================================================================
' Copyright 2004-2007 newasp.net - All Rights Reserved.
' newasp is a trademark of newasp.net
'=====================================================================
Server.ScriptTimeOut = 18000
Dim UploadObject,AllowFileSize,AllowFileExt
Dim sUploadDir,SaveFileName,PathFileName,url
Dim sAction,sType,SaveFilePath,UploadPath,m_strInstance,m_intMaxsize
Dim m_strFiletype,m_strType,m_strFileExt,m_strRootPath,m_intshow,m_intRename

UploadObject		= CInt(Newasp.UploadClass)   '上传文件对象 --- 0=无组件上传,1=Aspupload3.0组件,2=SA-FileUp 4.0组件
AllowFileSize		= CLng(Newasp.UploadFileSize)
AllowFileExt		= Newasp.UploadFileType
AllowFileExt		= Replace(Replace(Replace(UCase(AllowFileExt), "ASP", ""), "ASPX", ""), "|", ",")
url					= Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST")
sType				= UCase(Trim(Request.QueryString("sType")))
m_strType			= UCase(Trim(Request.QueryString("m")))
m_strInstance		= Trim(Request.QueryString("inst"))
m_intshow			= Newasp.ChkNumeric(Request.QueryString("s"))

'--默认是否选择自动更名
m_intRename			= 0

If m_strInstance = "" Then m_strInstance = "content"
m_strRootPath		= Newasp.InstallDir

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
		m_strRootPath = Newasp.InstallDir
	Case Else
		If sType = "FILE" Then
			UploadPath = "UploadFile/"
		Else
			UploadPath = "UploadPic/"
		End If
		sUploadDir = Newasp.InstallDir & Newasp.ChannelDir & UploadPath
		m_strRootPath = Newasp.InstallDir & Newasp.ChannelDir
End Select
%>
<html>
<head>
<title>文件上传</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<link rel="stylesheet" href="images/css/admin_style_<%=AdminSkin%>.css" type="text/css" media="all" />
<script type="text/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>
</head>
<body leftMargin="0" topMargin="0" marginwidth="0" marginheight="0">
<table style="width: 100%; height: 100%" cellspacing="0" cellpadding="0" align="center" border="0">
    <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,1,2,3
			Call UploadFile
		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
	SaveFilePath = UploadPath & SaveFilePath
	If m_strType = "NEWS" Then
		Call addUploadItem(m_strFileExt,m_strRootPath & SaveFilePath,SaveFilePath)
		Response.Write "<script type=""text/javascript"">" & vbCrLf
		Response.Write "doInterfaceUpload('" & SaveFilePath & "');" & vbCrLf
		Response.Write "</script>" & vbCrLf
	ElseIf m_strType = "INDEX" Then
		Call addUploadItem(m_strFileExt,m_strRootPath & SaveFilePath,SaveFilePath)
	Else
		If sType = "IMAGE" And m_intshow = 1 Then
			Call addUploadItem(m_strFileExt,m_strRootPath & SaveFilePath,SaveFilePath)
		Else
			If sType = "IMAGE" Then
				Call OutScript(SaveFilePath)
			Else
				Call OutFilesize(m_intMaxsize)
			End If
		End If
	End If
%>
<input type="text" name="file1" size="70" value="<%=m_strRootPath & SaveFilePath%>"> <input type="button" name="Submit4" onclick="javascript:history.go(-1)" value="继续上传文件" class="Button"><br>
<font color="blue">恭喜你!文件上传成功。<a href="<%=Request.ServerVariables("HTTP_REFERER")%>">点击此处继续上传</a></font>
<%
Else
	Call UploadMain
End If
%>
        </td>
    </tr>
</table>
</body>
</html>
<%
Sub UploadFile()
	Dim Upload,FilePath,sFilePath,FormName,File,F_FileName
	Dim PreviewSetting,DrawInfo,Previewpath,strPreviewPath
	Dim PreviewName,F_Viewname,MakePreview
	sFilePath = CreatePath(sUploadDir) '按日期生成目录
	FilePath = sUploadDir & sFilePath
	'-- 是否生成缩略图片
	MakePreview = True
	Previewpath = Newasp.InstallDir & Newasp.ChannelDir
	strPreviewPath = "UploadPic/" & sFilePath
	PreviewPath = Previewpath & strPreviewpath
	PreviewSetting = Split(Newasp.PreviewSetting, ",")
	If CInt(PreviewSetting(2)) = 1 Then
		DrawInfo = PreviewSetting(5)
	ElseIf CInt(PreviewSetting(2)) = 2 Then
		DrawInfo = Newasp.InstallDir & PreviewSetting(10)
	Else
		DrawInfo = ""
	End If
	If DrawInfo = "0" Then
		DrawInfo = ""
		PreviewSetting(2) = 0
	End If
	
	Set Upload					= New UpFile_Cls
	Upload.UploadType			= UploadObject						'设置上传组件类型
	Upload.UploadPath			= FilePath							'设置上传路径
	Upload.MaxSize				= AllowFileSize						'单位 KB
	Upload.InceptMaxFile		= 10								'每次上传文件个数上限
	Upload.InceptFileType		= AllowFileExt						'设置上传文件限制
	'Upload.ChkSessionName		= "uploadfile"
	'预览图片设置
	Upload.MakePreview			= MakePreview
	If sType = "IMAGE" Then
		Upload.PreviewType			= CInt(PreviewSetting(0))		'设置预览图片组件类型
	Else
		Upload.PreviewType			= 999							'设置预览图片组件类型

⌨️ 快捷键说明

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