?? upload.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("您提交的數(shù)據(jù)不合法,請不要從外部提交。")
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('對不起!您沒有上傳文件的權(quán)限')")
Response.End
End If
Select Case nUploadObject
Case 0,1,2,3
Call UploadFile
Case 999
Call OutScript("parent.UploadError('對不起系統(tǒng)已經(jīng)關(guān)閉上傳文件功能!')")
Response.End
Case Else
Call OutScript("parent.UploadError('對不起系統(tǒng)已經(jīng)關(guān)閉上傳文件功能!')")
Response.End
End Select
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 UploadFile()
Dim Upload,FilePath,sFilePath,FormName,File,F_FileName
Dim PreviewSetting,DrawInfo,Previewpath,strPreviewPath
Dim PreviewName,F_Viewname,MakePreview
'-- 是否生成縮略圖片
MakePreview = False
Previewpath = Newasp.InstallDir & Newasp.ChannelDir
strPreviewPath = "UploadPic/" & CreatePath(Previewpath & "UploadPic/")
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
sFilePath = CreatePath(sUploadDir) '按日期生成目錄
FilePath = sUploadDir & sFilePath
strUploadDir = sFilePath
sUploadDir = sUploadDir & strUploadDir
Set Upload = New UpFile_Cls
Upload.UploadType = nUploadObject '設(shè)置上傳組件類型
Upload.UploadPath = FilePath '設(shè)置上傳路徑
Upload.MaxSize = nAllowSize '單位 KB
Upload.InceptMaxFile = 10 '每次上傳文件個數(shù)上限
Upload.InceptFileType = Replace(sAllowExt, "|", ",") '設(shè)置上傳文件限制
'Upload.ChkSessionName = "uploadfile"
'預(yù)覽圖片設(shè)置
Upload.MakePreview = MakePreview
Upload.PreviewType = CInt(PreviewSetting(0)) '設(shè)置預(yù)覽圖片組件類型
Upload.PreviewImageWidth = CInt(PreviewSetting(3)) '設(shè)置預(yù)覽圖片寬度
Upload.PreviewImageHeight = CInt(PreviewSetting(4)) '設(shè)置預(yù)覽圖片高度
Upload.DrawImageWidth = CInt(PreviewSetting(13)) '設(shè)置水印圖片或文字區(qū)域?qū)挾? Upload.DrawImageHeight = CInt(PreviewSetting(14)) '設(shè)置水印圖片或文字區(qū)域高度
Upload.DrawGraph = CCur(PreviewSetting(11)) '設(shè)置水印透明度
Upload.DrawFontColor = PreviewSetting(7) '設(shè)置水印文字顏色
Upload.DrawFontFamily = PreviewSetting(8) '設(shè)置水印文字字體格式
Upload.DrawFontSize = CInt(PreviewSetting(6)) '設(shè)置水印文字字體大小
Upload.DrawFontBold = CInt(PreviewSetting(9)) '設(shè)置水印文字是否粗體
Upload.DrawInfo = DrawInfo '設(shè)置水印文字信息或圖片信息
Upload.DrawType = CInt(PreviewSetting(2)) '0=不加載水印 ,1=加載水印文字,2=加載水印圖片
Upload.DrawXYType = CInt(PreviewSetting(15)) '"0" =左上,"1"=左下,"2"=居中,"3"=右上,"4"=右下
Upload.DrawSizeType = CInt(PreviewSetting(1)) '"0"=固定縮小,"1"=等比例縮小
If PreviewSetting(12)<>"" Or PreviewSetting(12)<>"0" Then
Upload.TransitionColor = PreviewSetting(12) '透明度顏色設(shè)置
End If
'執(zhí)行上傳
Upload.SaveUpFile
If Upload.ErrCodes<>0 Then
Response.write ("<script>alert('錯誤:"& Upload.Description & "');history.go(-1)</script>")
Exit Sub
End If
If Upload.Count > 0 Then
For Each FormName In Upload.UploadFiles
Set File = Upload.UploadFiles(FormName)
sSaveFileName = File.FileName
F_FileName = FilePath & File.FileName
'創(chuàng)建預(yù)覽及水印圖片
If Upload.PreviewType<>999 and File.FileType=1 then
PreviewName = "p" & Replace(File.FileName,File.FileExt,"") & "jpg"
F_Viewname = Previewpath & PreviewName
'創(chuàng)建預(yù)覽圖片:Call CreateView(原始文件的路徑,預(yù)覽文件名及路徑,原文件后綴)
Upload.CreateView F_FileName,F_Viewname,File.FileExt
If CBool(MakePreview) Then
Call OutPreview(strPreviewPath & PreviewName)
End If
End If
Set File = Nothing
Next
Else
Call OutAlertScript("^_^哥們!請選擇一個有效的上傳文件。")
Exit Sub
End If
Set Upload = Nothing
End Sub
' 輸出客戶端腳本
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
' 初始化上傳限制數(shù)據(jù)
Sub InitUpload()
sType = UCase(Trim(Request.QueryString("type")))
sBaseUrl = "1" '路徑模式 --- 0=相對路徑,1=絕對根路徑,2絕對全路徑
nUploadObject = CInt(Newasp.UploadClass) '上傳文件對象 --- 0=無組件上傳,1=新云上傳組件,2=劉云峰上傳組件
nAllowSize = CLng(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" '遠程文件設(shè)置
UploadPath = "UploadPic/"
sUploadDir = sUploadDir & UploadPath '上傳文件路徑
sAllowExt = "gif|jpg|bmp|png|jpge" '上傳文件類型
Case "FILE" '上傳文件設(shè)置
UploadPath = "UploadFile/"
sUploadDir = sUploadDir & UploadPath '上傳文件路徑
Case "MEDIA" '上傳媒體設(shè)置
UploadPath = "UploadFile/"
sUploadDir = sUploadDir & UploadPath '上傳文件路徑
Case "FLASH" '上傳動畫設(shè)置
UploadPath = "UploadFile/"
sUploadDir = sUploadDir & UploadPath '上傳文件路徑
Case Else '上傳圖片設(shè)置
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格式,用于從數(shù)據(jù)庫中取出值填入輸入框時
' 注意:value="?"這邊一定要用雙引號
'================================================
Function inHTML(str)
Dim sTemp
sTemp = str
inHTML = ""
If IsNull(sTemp) = True Then
Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
inHTML = sTemp
End Function
%>
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -