📄 upload.asp

📁 依蓝旅游网站管理系统Elan2008.SP2
💻 ASP
字号:
<%
Option Explicit
Response.Buffer = True
Server.ScriptTimeOut = 9999999
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1 
Response.CacheControl = "no-cache"
%>
<!--#Include File="../Conn.asp"-->
<!--#Include File="../Inc/ClassUpload.asp"-->
<!--#Include File="../Inc/ClassJpeg.asp"-->
<%
Function ReplaceBadChar(strChar)
    If strChar = "" Or IsNull(strChar) Then
        ReplaceBadChar = ""
        Exit Function
    End If
    Dim strBadChar, arrBadChar, tempChar, i
    strBadChar = "@,+,--,',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ""
    arrBadChar = Split(strBadChar, ",")
    tempChar = strChar
    For i = 0 To UBound(arrBadChar)
        tempChar = Replace(tempChar, arrBadChar(i), "")
    Next
    ReplaceBadChar = tempChar
End Function

Function EL_CLng(ByVal str1)
    If IsNumeric(str1) Then
        EL_CLng = CLng(str1)
    Else
        EL_CLng = 0
    End If
End Function

Function ObjectTest(strObj)
	On Error Resume Next	
	Dim TestObj, IsObj
	IsObj = False
	Set TestObj = Server.CreateObject(strObj)
	If -2147221005 <> Err then
		IsObj = True
	Else
	   IsObj = False
	   Err.Clear
	End If
	Set TestObj = Nothing
	ObjectTest = IsObj
End Function

Function CheckComefrom(StrComeURL, StrCurrentURL)
   If Trim(StrComeURL) = "" Then
      CheckComefrom = False
   Else
      If LCase(Left(StrComeURL, InStrRev(StrComeURL, "/"))) <> LCase(Left(StrCurrentURL, InStrRev(StrCurrentURL, "/"))) Then
	     CheckComefrom = False
	  Else
	     CheckComefrom = True
	  End If
   End If
End Function

Function EL_CreateFolder(StrPath, NewFolder)
   On Error Resume Next
   Dim FSO
   EL_CreateFolder = StrPath
   If ObjectTest(Object_FSO) = False Then Exit Function
   Set FSO = Server.CreateObject(Object_FSO)   
   IF NOT FSO.FolderExists(StrPath & NewFolder) Then
      FSO.CreateFolder(StrPath & NewFolder)
   End If
   Set FSO = Nothing
   If Err Then
      Err.Clear
   Else
      EL_CreateFolder = StrPath & NewFolder
   End If
End Function
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style>
body { 
   color:#444444; 
   font-size: 12px;
   margin-top: 0px;
   margin-right: 0px;
   margin-bottom: 0px;
   margin-left: 0px; 
   padding:0px;
}

td {  
   font-size:12px; 
   word-break:break all; 
   word-wrap:word-break;
   line-height: 150%; 
}

form { 
   margin:0px;
   padding:0px;
}
input { 
   height:20;
   font-size: 12px ;
   margin-left:5px;
}
div{
   font-size:xx-small; color:#FFFFFF; font-family:Arial, Helvetica, sans-serif;
}
.bar{
   width:335px; border:1px solid blue; margin-top:5px;margin-left:5px;margin-bottom:2px; height:10px;
}
</style>
<script language="javascript" src="../js/Common.js"></script>
</head>
<body style="background-color:transparent;margin:0px;">
<% If Action="Save" Then %>
<!--暂时解决由于页面处理大数据的延迟、小数据过快导致进度条不能实时反映状态的问题-->
<div id="progressbar" class="bar"><div style="width:100%; background: blue; text-indent:10px;">Completed ! Please wait for data processing ......</div></div>
<% 
Else 
%>
<div id="progressbar" class="bar"><div style="width:100%; background: #FFFFFF; color:blue; text-indent:10px;">Ready....</div></div>
<% End If %>
<script language="javascript" src="../js/UploadProgress.js"></script>
<%

If ComeURL = "" Then
   Response.Clear()
   Response.Write "<font color=red>禁止直接输入地址访问该页面</font>"
   Call CloseConn()
   Response.End()
Else
   Dim Current_URL
   Current_URL = "http://" & Trim(Request.ServerVariables("HTTP_HOST"))
   Current_URL = Current_URL & Trim(Request.ServerVariables("SCRIPT_NAME"))
   If CheckComefrom(ComeURL, Current_URL) = False Then
      Response.Clear()
      Response.Write "<font color=red>禁止从外部链接地址访问该页面</font>"
	  Call CloseConn()
      Response.End()
   End If
End If


Dim DialogType, ChannelID
Dim UserID, UserName, UserPassword, UserRndPassword

DialogType = LCase(request("DialogType"))
ChannelID = ReplaceBadChar(request("ChannelID"))

If ChannelID = "" Then
    response.write "频道参数丢失！"
    response.End
Else
    ChannelID = EL_CLng(ChannelID)
End If

If ChannelID = 0 Then
   Call CloseConn()
   Response.End()
End If

If ChannelID = 9 Then
   UserID = ReplaceBadChar(Trim(Request.Cookies("User_"& EL_Sn)("UserID")))
   UserName = ReplaceBadChar(Trim(Request.Cookies("User_"& EL_Sn)("UserName")))
   UserPassword = ReplaceBadChar(Trim(Request.Cookies("User_"& EL_Sn)("UserPassword")))
   UserRndPassword = ReplaceBadChar(Trim(Request.Cookies("User_"& EL_Sn)("UserRndPassword")))   
Else
   UserID = ReplaceBadChar(Trim(request.Cookies("Admin_"& EL_Sn)("AdminID"))) 
   UserName = ReplaceBadChar(Trim(request.Cookies("Admin_"& EL_Sn)("AdminName")))
   UserPassword = ReplaceBadChar(Trim(Request.Cookies("Admin_"& EL_Sn)("AdminPassword")))
   UserRndPassword = ReplaceBadChar(Trim(Request.Cookies("Admin_"& EL_Sn)("AdminRndPassword")))
End If

If UserID = "" Or UserName = "" Or UserPassword="" Or UserRndPassword="" Then
    Response.Write "请先登录后再使用此功能！"
    Response.End
End If


Select Case Action
   Case "Save": Call SaveFile()
   Case "": Call Main()
End Select
Call CloseConn()

Sub SaveFile()
   Response.Flush()
   Dim File_Ext, SavePath, Upload, FileName, arrUploadExt, SubFolder, ThumbFileName, JpegErrorCode
   Dim sChannelDir, sUploadDir, sUploadMaxSize, sUploadFileType
   Dim UploadCmd
   JpegErrorCode = 0
   Set UploadCmd = Server.CreateObject("ADODB.COMMAND")
   With UploadCmd
	.ActiveConnection = Conn
	.CommandText = "EL_SP_Upload"
	.CommandType = 4
	.Prepared = True
	.Parameters.Append .CreateParameter("RETURN", 2, 4)
	.Parameters.Append .CreateParameter("@ChannelID", 3, 1, 4, ChannelID)
	.Parameters.Append .CreateParameter("@ChannelDir", 200, 2, 20)
	.Parameters.Append .CreateParameter("@UploadDir", 200, 2, 20)
	.Parameters.Append .CreateParameter("@UploadMaxSize", 3, 2, 4)
	.Parameters.Append .CreateParameter("@UploadFileType", 200, 2, 255)
	.Execute()
   End With 
   If UploadCmd(0) = 4 Then
      Set UploadCmd = Nothing
	  Call CloseConn()
      Response.Write "频道参数错误"
	  Response.End()
   End If
   sChannelDir = UploadCmd(2)
   sUploadDir = UploadCmd(3)
   sUploadMaxSize = UploadCmd(4)
   sUploadFileType = UploadCmd(5)
   Set UploadCmd = Nothing
   If sUploadFileType = "" Then sUploadFileType = "$$$$"
   arrUploadExt = Split(sUploadFileType,"$")
   
   Select Case DialogType
     Case "pic":    File_Ext = arrUploadExt(0)
	 Case "flash":  File_Ext = arrUploadExt(1)
	 Case "media":  File_Ext = arrUploadExt(2)
	 Case "real":   File_Ext = arrUploadExt(3)
	 Case "fujian": File_Ext = arrUploadExt(4)
   End Select
   SavePath = Server.MapPath(InstallDir & sChannelDir &"/"& sUploadDir)
   SubFolder = Year(date()) & Right("0"& Month(date()), 2)
   SavePath = EL_CreateFolder(SavePath, "\"& SubFolder)
   Set Upload = New ClassUpload
   Upload.SetUploadMaxSize = EL_Clng(sUploadMaxSize) * 1000
   Upload.SetAllowFileExt = File_Ext
   Upload.SetSaveFilePath = SavePath
   Upload.SetChunkBytes = 1024 * 30
   Upload.Upload("filedata")
   If Upload.ErrorCode > 0 Then '上传过程有错误
     Select Case Upload.ErrorCode
	    Case 1: Response.Write "<scr" & "ipt>alert('没有数据上传');window.location.href='upload.asp?DialogType="& DialogType &"&ChannelID="& ChannelID &"';</scr" & "ipt>"
		Case 2: Response.Write "<scr" & "ipt>alert('上传文件大小超过限制"& sUploadMaxSize &"');window.location.href='upload.asp?DialogType="& DialogType &"&ChannelID="& ChannelID &"';</scr" & "ipt>"
		Case 3: Response.Write "<scr" & "ipt>alert('上传文件类型( "& Upload.GetFileExt() &" )错误');window.location.href='upload.asp?DialogType="& DialogType &"&ChannelID="& ChannelID &"';</scr" & "ipt>"
		Case 4: Response.Write "<scr" & "ipt>alert('上传路径错误"& Replace(SavePath, "\", "\\") &"');window.location.href='upload.asp?DialogType="& DialogType &"&ChannelID="& ChannelID &"';</scr" & "ipt>"
		Case 5: Response.Write "<scr" & "ipt>alert('该图片内容包含恶意木马信息');window.location.href='upload.asp?DialogType="& DialogType &"&ChannelID="& ChannelID &"';</scr" & "ipt>"
	 End Select
   End If
   FileName = SubFolder &"/"& Upload.GetFileName()
   Set Upload = Nothing   
   
   
   If DialogType = "pic" Then
      '----------添加水印---------------
	  Dim TempFlag, FileTruePath
	  FileTruePath = Server.MapPath(InstallDir & sChannelDir &"/"& sUploadDir &"/"& FileName)
	  TempFlag = False
      If EnableWatermark = True Then
         Dim JpegWatermark
	     Set JpegWatermark = New ClassJpeg
		 If JpegWatermark.ErrorCode = 0 Then
	        JpegWatermark.CreateWatermark FileTruePath 
	        If EnableCreateThumb = True Then
	           JpegWatermark.CreateThumb FileTruePath, 1 
			   ThumbFileName = SubFolder &"/"& JpegWatermark.ThumbFileName
			   JpegErrorCode = JpegWatermark.ErrorCode
		       TempFlag = True
	        End If
		 End If
	     Set JpegWatermark = Nothing
      End If
   
      '----------产生缩略图-------------
      If EnableCreateThumb = True And TempFlag = False Then
         Dim JpegThumb
	     Set JpegThumb = New ClassJpeg
	     JpegThumb.CreateThumb FileTruePath, 1 
		 ThumbFileName = SubFolder &"/"& JpegThumb.ThumbFileName
		 JpegErrorCode = JpegThumb.ErrorCode
	     Set JpegThumb = Nothing
      End If
   End If
   
   Select Case DialogType
     Case "pic":    
	      Response.Write "<scr" & "ipt>"
		  If EnableCreateThumb = True And JpegErrorCode = 0 Then 
		     Response.Write "parent.document.all.upfilename.value='2$$$"& FileName &"$$$"& ThumbFileName &"';"
		  Else
		     Response.Write "parent.document.all.upfilename.value='1$$$"& FileName &"';"
		  End If
		  Response.Write "parent.document.all.url.value='"& InstallDir & sChannelDir &"/"& sUploadDir &"/"& FileName &"';"
		  Response.Write "parent.Preview();"		  
		  Response.Write "window.location.href='upload.asp?DialogType="& DialogType &"&ChannelID="& ChannelID &"';"
		  Response.Write "</scr" & "ipt>"    
	 Case "flash":  
	      Response.Write "<scr" & "ipt>"
		  Response.Write "parent.document.all.UpFileName.value='"& FileName &"';"
		  Response.Write "parent.document.all.url.value='"& InstallDir & sChannelDir &"/"& sUploadDir &"/"& FileName &"';"
		  Response.Write "parent.swfModify();"
		  Response.Write "window.location.href='upload.asp?DialogType="& DialogType &"&ChannelID="& ChannelID &"';"
		  Response.Write "</scr" & "ipt>"    
	 Case "media":  
	      Response.Write "<scr" & "ipt>"
		  Response.Write "parent.document.all.UpFileName.value='"& FileName &"';"
		  Response.Write "parent.document.all.url.value='"& InstallDir & sChannelDir &"/"& sUploadDir &"/"& FileName &"';"
		  Response.Write "parent.windowplay();"
		  Response.Write "window.location.href='upload.asp?DialogType="& DialogType &"&ChannelID="& ChannelID &"';"
		  Response.Write "</scr" & "ipt>"    
	 Case "real":     
	      Response.Write "<scr" & "ipt>"
		  Response.Write "parent.document.all.UpFileName.value='"& FileName &"';"
		  Response.Write "parent.document.all.url.value='"& InstallDir & sChannelDir &"/"& sUploadDir &"/"& FileName &"';"
		  Response.Write "parent.ShowRm();"
		  Response.Write "window.location.href='upload.asp?DialogType="& DialogType &"&ChannelID="& ChannelID &"';"
		  Response.Write "</scr" & "ipt>"    
	 Case "fujian": 
	      Response.Write "<scr" & "ipt>"
		  Response.Write "parent.document.all.UpFileName.value='"& FileName &"';"
		  Response.Write "parent.document.all.url.value='"& InstallDir & sChannelDir &"/"& sUploadDir &"/"& FileName &"';"
		  Response.Write "window.location.href='upload.asp?DialogType="& DialogType &"&ChannelID="& ChannelID &"';"
		  Response.Write "</scr" & "ipt>"     
   End Select
   Response.Write "<script>progressbar.innerHTML=""<div style='width:100%; background: blue; text-indent:10px;'>Completed ! Please wait for data processing ......</div>""</script>"
End Sub
  
Sub Main()
%>
<table width="100%"  border="0" cellspacing="0" cellpadding="0">
  <form name="Upload" action="Upload.asp?Action=Save&ChannelID=<%=ChannelID%>&DialogType=<%=DialogType%>" method="post" enctype="multipart/form-data" onSubmit="SubmitOnce(this)">
  <tr>
    <td width="24%"><input name="filedata" type="file" id="filedata" size="34"></td>
    <td width="76%"><input name="Submit" type="submit" value=" 上传 " onClick="gop();" style="margin:0px; margin-left:3px; width:51px;"></td>
  </tr>
  </form>
</table>
<%
End Sub
%>
</body>
</html>
💿 文件大小 4678 K
👤 上传用户 libin2722
📂 所属分类企业管理
🏷️ 相关标签

#Elan #2008 #SP #旅游
⌨️ 快捷键说明

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