?? upload.asp
字號:
<!--#include file="Include/Startup.asp"-->
<!--#include file="Include/upfile_class.asp"-->
<%
'☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆
'★ ★
'☆ eWebEditor - eWebSoft在線編輯器 ☆
'★ ★
'☆ 版權(quán)所有: eWebSoft.com ☆
'★ ★
'☆ 程序制作: eWeb開發(fā)團(tuán)隊 ☆
'★ email:webmaster@webasp.net ★
'☆ QQ:589808 ☆
'★ ★
'☆ 相關(guān)網(wǎng)址: [產(chǎn)品介紹]http://www.eWebSoft.com/Product/eWebEditor/ ☆
'★ [支持論壇]http://bbs.eWebSoft.com/ ★
'☆ ☆
'★ 主頁地址: http://www.eWebSoft.com/ eWebSoft團(tuán)隊及產(chǎn)品 ★
'☆ http://www.webasp.net/ WEB技術(shù)及應(yīng)用資源網(wǎng)站 ☆
'★ http://bbs.webasp.net/ WEB技術(shù)交流論壇 ★
'★ ★
'☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆
%>
<%
If Not IsSelfRefer Then Response.Write "Include Error":Response.End
Server.ScriptTimeOut = 1800
' 參數(shù)變量
Dim sType, sStyleName
' 設(shè)置變量
Dim sAllowExt, nAllowSize, sUploadDir, nUploadObject, nAutoDir, sBaseUrl, sContentPath
' 接口變量
Dim sFileExt, sOriginalFileName, sSaveFileName, sPathFileName, nFileNum
Call DBConnBegin() ' 初始化數(shù)據(jù)庫連接
Call InitUpload() ' 初始化上傳變量
Call DBConnEnd() ' 斷開數(shù)據(jù)庫連接
Dim sAction
sAction = UCase(Trim(Request.QueryString("action")))
Select Case sAction
Case "REMOTE"
Call DoRemote() ' 遠(yuǎn)程自動獲取
Case "SAVE"
Call ShowForm() ' 顯示上傳表單
Call DoSave() ' 存文件
Case Else
Call ShowForm() ' 顯示上傳表單
End Select
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%>&style=<%=sStyleName%>" 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()
' 默認(rèn)無組件上傳類
Call DoUpload_Class
sPathFileName = sContentPath & sSaveFileName
Call OutScript("parent.UploadSaved('" & sPathFileName & "');var obj=parent.dialogArguments.dialogArguments;if (!obj) obj=parent.dialogArguments;try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){}")
End Sub
' 自動獲取遠(yuǎn)程文件
Sub DoRemote()
Dim sContent, i
For i = 1 To Request.Form("eWebEditor_UploadText").Count
sContent = sContent & Request.Form("eWebEditor_UploadText")(i)
Next
If sAllowExt <> "" Then
sContent = ReplaceRemoteUrl(sContent, sAllowExt)
End If
Response.Write "<HTML><HEAD><TITLE>遠(yuǎn)程上傳</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 & "', '" & sPathFileName & "');} catch(e){} parent.remoteUploadOK();")
End Sub
' 無組上傳類
Sub DoUpload_Class()
On Error Resume Next
Dim oUpload, oFile
' 建立上傳對象
Set oUpload = New upfile_class
' 取得上傳數(shù)據(jù),限制最大上傳
oUpload.GetData(nAllowSize*1024)
If oUpload.Err > 0 Then
Select Case oUpload.Err
Case 1
Call OutScript("parent.UploadError('請選擇有效的上傳文件！')")
Case 2
Call OutScript("parent.UploadError('你上傳的文件總大小超出了最大限制（" & nAllowSize & "KB）！')")
End Select
Response.End
End If
Set oFile = oUpload.File("uploadfile")
sFileExt = LCase(oFile.FileExt)
Call CheckValidExt(sFileExt)
sOriginalFileName = oFile.FileName
sSaveFileName = GetRndFileName(sFileExt)
oFile.SaveToFile Server.Mappath(sUploadDir & sSaveFileName)
Set oFile = Nothing
Set oUpload = Nothing
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 OutScript(str)
Response.Write "<script language=javascript>" & str & ";history.back()</script>"
End Sub
Sub OutScriptNoBack(str)
Response.Write "<script language=javascript>" & str & "</script>"
End Sub
' 檢測擴展名的有效性
Sub CheckValidExt(sExt)
Dim b, i, aExt
b = False
aExt = Split(sAllowExt, "|")
For i = 0 To UBound(aExt)
If LCase(aExt(i)) = sExt Then
b = True
Exit For
End If
Next
If b = False Then
OutScript("parent.UploadError('提示：\n\n請選擇一個有效的文件，\n支持的格式有（"+sAllowExt+"）！')")
Response.End
End If
End Sub
' 初始化上傳限制數(shù)據(jù)
Sub InitUpload()
sType = UCase(Trim(Request.QueryString("type")))
sStyleName = Get_SafeStr(Trim(Request.QueryString("style")))
sSql = "select * from ewebeditor_style where s_name='" & sStyleName & "'"
oRs.Open sSql, oConn, 0, 1
If Not oRs.Eof Then
sBaseUrl = oRs("S_BaseUrl")
nUploadObject = oRs("S_UploadObject")
nAutoDir = oRs("S_AutoDir")
sUploadDir = oRs("S_UploadDir")
'get year-month/day/filename
sUploadDir=sUploadDir&Year(Now())&"-"&Month(Now())
If Not CheckDir(sUploadDir) Then MakeNewsDir(sUploadDir)
sUploadDir=sUploadDir&"/"&Day(Now())&"/"
If Not CheckDir(sUploadDir) Then MakeNewsDir(sUploadDir)
Select Case sBaseUrl
Case "0"
sContentPath = oRs("S_ContentPath")
Case "1"
sContentPath = RelativePath2RootPath(sUploadDir)
Case "2"
sContentPath = RootPath2DomainPath(RelativePath2RootPath(sUploadDir))
End Select
Select Case sType
Case "REMOTE"
sAllowExt = oRs("S_RemoteExt")
nAllowSize = oRs("S_RemoteSize")
Case "FILE"
sAllowExt = oRs("S_FileExt")
nAllowSize = oRs("S_FileSize")
Case "MEDIA"
sAllowExt = oRs("S_MediaExt")
nAllowSize = oRs("S_MediaSize")
Case "FLASH"
sAllowExt = oRs("S_FlashExt")
nAllowSize = oRs("S_FlashSize")
Case Else
sAllowExt = oRs("S_ImageExt")
nAllowSize = oRs("S_ImageSize")
End Select
Else
OutScript("parent.UploadError('無效的樣式ID號，請通過頁面上的鏈接進(jìn)行操作！')")
End If
oRs.Close
' 任何情況下都不允許上傳asp腳本文件
sAllowExt = Replace(UCase(sAllowExt), "ASP", "")
'eason007新增腳本限制
sAllowExt = Replace(UCase(sAllowExt), "ASPX", "")
sAllowExt = Replace(UCase(sAllowExt), "PHP", "")
sAllowExt = Replace(UCase(sAllowExt), "CGI", "")
sAllowExt = Replace(UCase(sAllowExt), "ASA", "")
sAllowExt = Replace(UCase(sAllowExt), "CER", "")
sAllowExt = Replace(UCase(sAllowExt), "CDX", "")
sAllowExt = Replace(UCase(sAllowExt), "PL", "")
End Sub
' 轉(zhuǎn)為根路徑格式
Function RelativePath2RootPath(url)
Dim sTempUrl
sTempUrl = url
If Left(sTempUrl, 1) = "/" Then
RelativePath2RootPath = sTempUrl
Exit Function
End If
Dim sWebEditorPath
sWebEditorPath = Request.ServerVariables("SCRIPT_NAME")
sWebEditorPath = Left(sWebEditorPath, InstrRev(sWebEditorPath, "/") - 1)
Do While Left(sTempUrl, 3) = "../"
sTempUrl = Mid(sTempUrl, 4)
sWebEditorPath = Left(sWebEditorPath, InstrRev(sWebEditorPath, "/") - 1)
Loop
RelativePath2RootPath = sWebEditorPath & "/" & sTempUrl
End Function
' 根路徑轉(zhuǎn)為帶域名全路徑格式
Function RootPath2DomainPath(url)
Dim sHost, sPort
sHost = Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST")
sPort = Request.ServerVariables("SERVER_PORT")
If sPort <> "80" Then
sHost = sHost & ":" & sPort
End If
RootPath2DomainPath = sHost & url
End Function
'================================================
'作 用：替換字符串中的遠(yuǎn)程文件為本地文件并保存遠(yuǎn)程文件
'參 數(shù)：
' sHTML : 要替換的字符串
' sExt : 執(zhí)行替換的擴展名
'================================================
Function ReplaceRemoteUrl(sHTML, sExt)
Dim s_Content
s_Content = sHTML
If IsObjInstalled("Microsoft.XMLHTTP") = False then
ReplaceRemoteUrl = s_Content
Exit Function
End If
Dim re, RemoteFile, RemoteFileurl, SaveFileName, SaveFileType
Set re = new RegExp
re.IgnoreCase = True
re.Global = True
re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}(([A-Za-z0-9_-])+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(" & sExt & ")))"
Set RemoteFile = re.Execute(s_Content)
Dim a_RemoteUrl(), n, i, bRepeat
n = 0
' 轉(zhuǎn)入無重復(fù)數(shù)據(jù)
For Each RemoteFileurl in RemoteFile
If n = 0 Then
n = n + 1
Redim a_RemoteUrl(n)
a_RemoteUrl(n) = RemoteFileurl
Else
bRepeat = False
For i = 1 To UBound(a_RemoteUrl)
If UCase(RemoteFileurl) = UCase(a_RemoteUrl(i)) Then
bRepeat = True
Exit For
End If
Next
If bRepeat = False Then
n = n + 1
Redim Preserve a_RemoteUrl(n)
a_RemoteUrl(n) = RemoteFileurl
End If
End If
Next
' 開始替換操作
nFileNum = 0
For i = 1 To n
SaveFileType = Mid(a_RemoteUrl(i), InstrRev(a_RemoteUrl(i), ".") + 1)
SaveFileName = GetRndFileName(SaveFileType)
If SaveRemoteFile(SaveFileName, a_RemoteUrl(i)) = True Then
nFileNum = nFileNum + 1
If nFileNum > 0 Then
sOriginalFileName = sOriginalFileName & "|"
sSaveFileName = sSaveFileName & "|"
sPathFileName = sPathFileName & "|"
End If
sOriginalFileName = sOriginalFileName & Mid(a_RemoteUrl(i), InstrRev(a_RemoteUrl(i), "/") + 1)
sSaveFileName = sSaveFileName & SaveFileName
sPathFileName = sPathFileName & sContentPath & SaveFileName
s_Content = Replace(s_Content, a_RemoteUrl(i), sContentPath & SaveFileName, 1, -1, 1)
End If
Next
ReplaceRemoteUrl = s_Content
End Function
'================================================
'作 用：保存遠(yuǎn)程的文件到本地
'參 數(shù)：s_LocalFileName ------ 本地文件名
' s_RemoteFileUrl ------ 遠(yuǎn)程文件URL
'返回值：True ----成功
' False ----失敗
'================================================
Function SaveRemoteFile(s_LocalFileName, s_RemoteFileUrl)
Dim Ads, Retrieval, GetRemoteData
Dim bError
bError = False
SaveRemoteFile = False
'On Error Resume Next
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", s_RemoteFileUrl, False, "", ""
.Send
GetRemoteData = .ResponseBody
End With
Set Retrieval = Nothing
If LenB(GetRemoteData) > nAllowSize*1024 Then
bError = True
Else
Set Ads = Server.CreateObject("Adod" & "b.S" & "tream")
With Ads
.Type = 1
.Open
.Write GetRemoteData
.SaveToFile Server.MapPath(sUploadDir & s_LocalFileName), 2
.Cancel()
.Close()
End With
Set Ads=nothing
End If
If Err.Number = 0 And bError = False Then
SaveRemoteFile = True
Else
Err.Clear
End If
End Function
'================================================
'作 用：檢查組件是否已經(jīng)安裝
'參 數(shù)：strClassString ----組件名
'返回值：True ----已經(jīng)安裝
' False ----沒有安裝
'================================================
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
'------------------檢查某一目錄是否存在-------------------
Function CheckDir(Byref FolderPath)
Dim fso1
dim folderpath1
folderpath1=Server.MapPath(".")&"\"&folderpath
Set fso1 = CreateObject("Scripting.FileSystemObject")
If fso1.FolderExists(folderpath1) Then
'存在
CheckDir = True
Else
'不存在
CheckDir = False
End If
Set fso1 = Nothing
End Function
'-------------根據(jù)指定名稱生成目錄---------
Function MakeNewsDir(Byref foldername)
Dim fso1
Dim f,foldername1
foldername1=Server.MapPath(".")&"\"&foldername
Set fso1 = CreateObject("Scripting.FileSystemObject")
Set f = fso1.CreateFolder(foldername1)
MakeNewsDir = True
Set fso1 = Nothing
End Function
%>?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -