📄 upload.asp
字号:
<% Option Explicit %>
<%
Session("eWebEditor_Original_CodePage") = Session.CodePage
Session.CodePage = 65001
%>
<!--#include file="config.asp"-->
<!--#include file="upfileclass.asp"-->
<%
Server.ScriptTimeOut = 1800
Dim sType, sStyleName, sLanguage,pops
Dim sAllowExt, nAllowSize, sUploadDir, nUploadObject, nAutoDir, sBaseUrl, sContentPath
Dim sFileExt, sOriginalFileName, sSaveFileName, sPathFileName, nFileNum
Dim nSLTFlag, nSLTMinSize, nSLTOkSize, nSYFlag, sSYText, sSYFontColor, nSYFontSize, sSYFontName, sSYPicPath, nSLTSYObject, sSLTSYExt, nSYMinSize, sSYShadowColor, nSYShadowOffset
Call InitUpload()
Dim sAction
sAction = UCase(Trim(Request.QueryString("action")))
Select Case sAction
Case "REMOTE"
Call DoCreateNewDir()
Call DoRemote()
Case "SAVE"
Call ShowForm()
Call DoCreateNewDir()
Call DoSave()
Case "LOCAL"
Call DoCreateNewDir()
Call DoSaveword()
'Call DoRemote()
Case Else
Call ShowForm()
End Select
Session.CodePage = Session("eWebEditor_Original_CodePage")
Sub ShowForm()
%>
<HTML>
<HEAD>
<TITLE>eWebEditor</TITLE>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<script language="javascript" src="../dialog/dialog.js"></script>
<link href='../language/<%=sLanguage%>.css' type='text/css' rel='stylesheet'>
<link href='../dialog/dialog.css' type='text/css' rel='stylesheet'>
</head>
<body class=upload>
<form action="?action=save&type=<%=sType%>&style=<%=sStyleName%>&language=<%=sLanguage%>" 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('lang["ErrUploadInvalidExt"]+":'+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()
dim jpeg,jpeg1,path,waterpath,coverpath
Call DoUpload_Class()
Dim s_SmallImageFile, s_SmallImagePathFile, s_SmallImageScript
s_SmallImagePathFile = ""
s_SmallImageScript = ""
s_SmallImageFile = ""
sPathFileName = sContentPath & sSaveFileName
if nSLTFlag=1 then
On Error Resume Next
Set Jpeg = Server.CreateObject("Persits.Jpeg")
if Err then
Call OutScript("parent.UploadSaved('" & sPathFileName & "','" & s_SmallImagePathFile & "');var obj=parent.dialogArguments.dialogArguments;if (!obj) obj=parent.dialogArguments;try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} " & s_SmallImageScript)
end if
Path = Server.MapPath(sPathFileName)
Jpeg.Open Path
if Jpeg.Width > nSLTMinSize then
Jpeg.Width =nSLTOkSize
Jpeg.Height = nSLTOkSize*3/4
Jpeg.Save Server.MapPath(sContentPath&"small/"& sSaveFileName)
s_SmallImagePathFile = sContentPath&"small/"&sSaveFileName
s_SmallImageFile="small/"& sSaveFileName
s_SmallImageScript = "try{obj.addUploadFile('" & sOriginalFileName & "', '" & s_SmallImageFile & "', '" & s_SmallImagePathFile & "');} catch(e){} "
response.Write(s_SmallImageFile)
end if
Set Jpeg = Nothing
end if
if nSYFlag=1 then
waterpath=Server.MapPath(sPathFileName)
On Error Resume Next
Set Jpeg = Server.CreateObject("Persits.Jpeg")
if Err then
Call OutScript("parent.UploadSaved('" & sPathFileName & "','" & s_SmallImagePathFile & "');var obj=parent.dialogArguments.dialogArguments;if (!obj) obj=parent.dialogArguments;try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} " & s_SmallImageScript)
end if
Jpeg.Open waterpath
Jpeg.Canvas.Font.Color ="&H"&sSYFontColor
Jpeg.Canvas.Pen.Color ="&H"&sSYFontColor
Jpeg.Canvas.Font.Family = "'"& sSYFontName &"'"
Jpeg.Canvas.Font.Bold = True
Jpeg.Canvas.Font.Size = 15
Jpeg.Canvas.Font.BkColor=&H5FD211
Jpeg.Canvas.Font.Quality = 4 '0 (Default), 1 (Draft), 2 (Proof), 3 (Non-Antialiased), 4 (Antialiased)
Jpeg.Canvas.Font.BkMode = "Transparent" ' to make antialiasing work
Jpeg.Canvas.Print Jpeg.OriginalWidth-120, Jpeg.OriginalHeight-35, sSYText
Jpeg.Canvas.Pen.Color ="&H"&sSYShadowColor
Jpeg.Canvas.Pen.Width = nSYShadowOffset
Jpeg.Canvas.Brush.Solid = False
Jpeg.Canvas.DrawBar nSYShadowOffset, nSYShadowOffset, Jpeg.Width, Jpeg.Height
Jpeg.Save Server.MapPath(sPathFileName)
Set Jpeg=Nothing
end if
if nSYFlag=2 then
waterpath=Server.MapPath(sPathFileName)
coverpath=Server.MapPath(sSYPicPath)
On Error Resume Next
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Set Jpeg1 = Server.CreateObject("Persits.Jpeg")
if Err then
Call OutScript("parent.UploadSaved('" & sPathFileName & "','" & s_SmallImagePathFile & "');var obj=parent.dialogArguments.dialogArguments;if (!obj) obj=parent.dialogArguments;try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} " & s_SmallImageScript)
end if
Jpeg.Open waterpath
Jpeg1.Open coverpath
if Jpeg.height >= nSYMinSize then
Jpeg.Canvas.Pen.Color = &HFFFFFF
Jpeg.Canvas.Pen.Width = 0
Jpeg.Canvas.Brush.Solid = False
Jpeg.Canvas.Bar 0, 0, Jpeg.Width, Jpeg.Height
Jpeg.Width = Jpeg.Width
Jpeg.height = Jpeg.height
Jpeg.Sharpen 1, 120
Jpeg.DrawImage Jpeg.Width-Jpeg1.Width, Jpeg.Height-Jpeg1.Height, Jpeg1, 0.8, &HFFFFFF
Jpeg.Save Server.MapPath(sPathFileName)
end if
Set Jpeg=Nothing
Set Jpeg1=Nothing
end if
Call OutScript("parent.UploadSaved('" & sPathFileName & "','" & s_SmallImagePathFile & "');var obj=parent.dialogArguments.dialogArguments;if (!obj) obj=parent.dialogArguments;try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} " & s_SmallImageScript)
End Sub
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>eWebEditor</TITLE><meta http-equiv='Content-Type' content='text/html; charset=utf-8'></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 DoCreateNewDir()
End Sub
Sub DoUpload_Class()
On Error Resume Next
Dim oUpload, oFile
Set oUpload = New upfile_class
oUpload.GetData nAllowSize*1024
If oUpload.Err > 0 Then
Select Case oUpload.Err
Case 1
Call OutScript("parent.UploadError('lang[""ErrUploadInvalidFile""]')")
Case 2
Call OutScript("parent.UploadError('lang[""ErrUploadSizeLimit""]+"":" & nAllowSize & "KB""')")
End Select
End If
Set oFile = oUpload.File("uploadfile")
sFileExt = LCase(oFile.FileExt)
Call CheckValidExt(sFileExt)
sOriginalFileName = oFile.FileName
sSaveFileName = GetRndFileName(sFileExt)
Dim str_Mappath
str_Mappath = Server.Mappath(sUploadDir & sSaveFileName)
sFileExt = LCase(Mid(str_Mappath, InstrRev(str_Mappath, ".") + 1))
Call CheckValidExt(sFileExt)
oFile.SaveToFile str_Mappath
Set oFile = Nothing
Set oUpload = Nothing
End Sub
Function GetRndFileName(sExt)
Dim sRnd
Randomize
sRnd = Int(900 * Rnd) + 100
GetRndFileName = FormatTime(Now(), 5) & sRnd & "." & sExt
End Function
Sub OutScript(str)
Response.Write "<script language=javascript>" & str & ";history.back()</script>"
Session.CodePage = Session("eWebEditor_Original_CodePage")
Response.End
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
Call OutScript("parent.UploadError('lang[""ErrUploadInvalidExt""]+"":" & sAllowExt & """')")
End If
End Sub
Sub InitUpload()
sType = UCase(Trim(Request.QueryString("type")))
sStyleName = Trim(Request.QueryString("style"))
sLanguage = Trim(Request.QueryString("language"))
Dim i, aStyleConfig, bValidStyle
bValidStyle = False
For i = 1 To Ubound(aStyle)
aStyleConfig = Split(aStyle(i), "|||")
If Lcase(sStyleName) = Lcase(aStyleConfig(0)) Then
bValidStyle = True
Exit For
End If
Next
If bValidStyle = False Then
OutScript("parent.UploadError('lang[""ErrInvalidStyle""]')")
End If
sBaseUrl = aStyleConfig(19)
nUploadObject = Clng(aStyleConfig(20))
nAutoDir = CLng(aStyleConfig(21))
sUploadDir = aStyleConfig(3)
If Left(sUploadDir, 1) <> "/" Then
sUploadDir = "../" & sUploadDir
End If
'按月建立目录
Select Case nAutoDir
Case 0
sUploadDir = left(sUploadDir,InStrRev(LCase(sUploadDir), "/")-1)
Case 1
sUploadDir =sUploadDir & Year(Now)
Case 2
sUploadDir =sUploadDir & Year(Now) & "-" & Month(Now)
Case 3
sUploadDir =sUploadDir & Year(Now) & "-" & Month(Now) &"-"& Day(Now)
End Select
dim objFSO
Set objFSO = server.CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(Server.MapPath(sUploadDir)) = False Then
objFSO.CreateFolder(Server.MapPath(sUploadDir))
End If
If objFSO.FolderExists(Server.MapPath(sUploadDir&"/small")) = False Then
objFSO.CreateFolder(Server.MapPath(sUploadDir&"/small"))
End If
sUploadDir =sUploadDir &"/"
'目录建立结束
Select Case sBaseUrl
Case "0"
sContentPath = aStyleConfig(23)
Case "1"
sContentPath = RelativePath2RootPath(sUploadDir)
Case "2"
sContentPath = RootPath2DomainPath(RelativePath2RootPath(sUploadDir))
End Select
Select Case sType
Case "REMOTE"
sAllowExt = aStyleConfig(10)
nAllowSize = Clng(aStyleConfig(15))
Case "FILE"
sAllowExt = aStyleConfig(6)
nAllowSize = Clng(aStyleConfig(11))
Case "MEDIA"
sAllowExt = aStyleConfig(9)
nAllowSize = Clng(aStyleConfig(14))
Case "FLASH"
sAllowExt = aStyleConfig(7)
nAllowSize = Clng(aStyleConfig(12))
Case Else
sAllowExt = aStyleConfig(8)
nAllowSize = Clng(aStyleConfig(13))
End Select
nSLTFlag = Clng(aStyleConfig(29))
nSLTMinSize = Clng(aStyleConfig(30))
nSLTOkSize = Clng(aStyleConfig(31))
nSYFlag = Clng(aStyleConfig(32))
sSYText = aStyleConfig(33)
sSYFontColor = aStyleConfig(34)
nSYFontSize = Clng(aStyleConfig(35))
sSYFontName = aStyleConfig(36)
sSYPicPath = aStyleConfig(37)
nSLTSYObject = Clng(aStyleConfig(38))
sSLTSYExt = aStyleConfig(39)
nSYMinSize = Clng(aStyleConfig(40))
sSYShadowColor = aStyleConfig(41)
nSYShadowOffset = Clng(aStyleConfig(42))
End Sub
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
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
'======================================================
' е ļ ļ Զ ļ
'
' sHTML : Ҫ ַ
' sExt : չ
'======================================================
Function ReplaceRemoteUrl(sHTML, sExt)
' ----------------------------------------
' Զ̸ Զ
' ز IsOpenAutoSave1 = 㬴⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -