<% Option Explicit %>
<%
Session("Editor_Original_CodePage") = Session.CodePage
Session.CodePage = 65001

%>
<!--#include file="config.asp"-->
<!--#include FILE="upfile_class.asp"-->

<%
Server.ScriptTimeOut = 1800

Dim sType, sStyleName, sLanguage
Dim sAllowExt, nAllowSize, sUploadDir, nUploadObject, nAutoDir, sBaseUrl, sContentPath, GetAutoDir
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 Else
	Call ShowForm()
End Select

Session.CodePage = Session("Editor_Original_CodePage")


Sub ShowForm()
%>
<HTML>
<HEAD>
<TITLE>Editor</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()

	' ASP-Upload and SA-FileUp are not available in trial version.
	Call DoUpload_Class()
	
	' Thumbnail image, textual watermark and image watermark are not available in trial version.
	Dim s_SmallImageFile, s_SmallImagePathFile, s_SmallImageScript
	s_SmallImagePathFile = ""
	s_SmallImageScript = ""
	s_SmallImageFile = ""

	sPathFileName = sContentPath & sSaveFileName
	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>Editor</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()
	' Automatically Create Directory is not available in trial version.
End Sub

Sub DoUpload_Class()
	On Error Resume Next
	Dim oUpload, oFile
	Set oUpload = New upfile_class
	oUpload.NoAllowExt="asp;exe;htm;html;aspx;cs;vb;js;"	'设置上传类型的黑名单
	oUpload.GetData nAllowSize*1024

	If oUpload.isErr>0 Then
		Select Case oUpload.isErr
		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(oUpload.File("uploadfile").FileExt)
	Call CheckValidExt(sFileExt)
	sOriginalFileName = oUpload.File("uploadfile").FileName
	sSaveFileName = GetRndFileName(sFileExt)
	
	CreatePath(Server.Mappath(sUploadDir))
	
	Dim str_Mappath
	str_Mappath = Server.Mappath(sUploadDir & sSaveFileName)
	sFileExt = LCase(Mid(str_Mappath, InstrRev(str_Mappath, ".") + 1))
	'Call CheckValidExt(sFileExt)

	oUpload.SaveToFile "uploadfile",str_Mappath
	
	Set oUpload = Nothing
End Sub

Function GetRndFileName(sExt)
	Dim sRnd
	Randomize
	sRnd = Int(900 * Rnd) + 100
	GetRndFileName = FormatMyDate(Now(),"{Y}{m}{d}_{h}{mi}{s}_") & sRnd & "." & sExt
End Function

Sub OutScript(str)
	Response.Write "<script language=javascript>" & str & ";history.back()</script>"
	Session.CodePage = Session("Editor_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
	
	GetAutoDir = ""
	Select Case Clng(aStyleConfig(21))
		Case 1
			GetAutoDir = FormatMyDate(Now(),"{Y}")&"/"
		Case 2
			GetAutoDir = FormatMyDate(Now(),"{Y}-{m}")&"/"
		Case 3
			GetAutoDir = FormatMyDate(Now(),"{Y}-{m}-{d}")&"/"
		Case Else
			GetAutoDir = ""
	End Select
	
	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) & GetAutoDir
	If Left(sUploadDir, 1) <> "/" Then
		sUploadDir = "../" & sUploadDir
	End If

	Select Case sBaseUrl
	Case "0"
		sContentPath = aStyleConfig(23) & GetAutoDir
	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

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})([^ \f\n\r\t\v\""\'\>]*\/)(([^ \f\n\r\t\v\""\'\>])+[.]{1}(" & sExt & ")))"

	Set RemoteFile = re.Execute(s_Content)
	Dim a_RemoteUrl(), n, i, bRepeat
	n = 0
	' to no repeat array
	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
	' start replace
	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

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
	CreatePath(Server.Mappath(sUploadDir))
	If LenB(GetRemoteData) > nAllowSize*1024 Then
		bError = True
	Else
		Set Ads = Server.CreateObject("Adodb.Stream")
		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

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 inHTML(str)
	Dim sTemp
	sTemp = str
	inHTML = ""
	If IsNull(sTemp) = True Then
		Exit Function
	End If
	sTemp = Replace(sTemp, "&", "&amp;")
	sTemp = Replace(sTemp, "<", "&lt;")
	sTemp = Replace(sTemp, ">", "&gt;")
	sTemp = Replace(sTemp, Chr(34), "&quot;")
	inHTML = sTemp
End Function

Function FormatTime(s_Time, n_Flag)
	Dim y, m, d, h, mi, s
	FormatTime = ""
	If IsDate(s_Time) = False Then Exit Function
	y = cstr(year(s_Time))
	m = cstr(month(s_Time))
	If len(m) = 1 Then m = "0" & m
	d = cstr(day(s_Time))
	If len(d) = 1 Then d = "0" & d
	h = cstr(hour(s_Time))
	If len(h) = 1 Then h = "0" & h
	mi = cstr(minute(s_Time))
	If len(mi) = 1 Then mi = "0" & mi
	s = cstr(second(s_Time))
	If len(s) = 1 Then s = "0" & s
	Select Case n_Flag
	Case 1
		FormatTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
	Case 2
		FormatTime = y & "-" & m & "-" & d
	Case 3
		FormatTime = h & ":" & mi & ":" & s
	Case 4
		FormatTime = y & m & d
	Case 5
		FormatTime = y & m & d & h & mi & s
	End Select
End Function
'########################
Function CreatePath(sPath) '创建文件夹函数, sPath为文件夹绝对路径,可以是多层文件夹
'########################
Dim f,pos,aTmp,sNewPath,n
If Instr(sPath,"\")>0 Then
	Set f=Server.CreateObject("Scripting.FileSystemObject")
	If f.FolderExists(sPath) Then
		CreatePath=True
		set f = nothing
		Exit Function
	End If
	pos=Instr(3,sPath,"\",1)
	aTmp=Split(Mid(sPath,pos+1),"\")
	sNewPath=Left(sPath,pos-1)
	For n = 0 to Ubound(aTmp)
		On Error resume next 'Ignore permission problems on higher levels
		sNewPath = sNewPath & "\" & aTmp(n)
		If aTmp(n)<>"" AND NOT f.FolderExists(sNewPath) Then f.CreateFolder sNewPath
	Next
	If f.FolderExists(sPath) Then CreatePath=True Else CreatePath=False
	Set f=Nothing
End If
End Function

Function FormatMyDate(myDate, Template)
	If Not IsDate(myDate) Or Template = "" Then
		FormatMyDate = ""
		Exit Function
	End If

	Dim mYear, mMonth, mDay, mHour, mMin, mSec
		mYear = Year(myDate)
		mMonth = Month(myDate)
		mDay = Day(myDate)
		mHour = Hour(myDate)
		mMin = Minute(myDate)
		mSec = Second(myDate)
	FormatMyDate = Template
	FormatMyDate = Replace(FormatMyDate, "{Y}", Year(myDate))
	FormatMyDate = Replace(FormatMyDate, "{y}", Right(Year(myDate), 2))
	FormatMyDate = Replace(FormatMyDate, "{M}", Month(myDate))
	FormatMyDate = Replace(FormatMyDate, "{m}", Right("00" & Month(myDate), 2))
	FormatMyDate = Replace(FormatMyDate, "{D}", Day(myDate))
	FormatMyDate = Replace(FormatMyDate, "{d}", Right("00" & Day(myDate), 2))
	FormatMyDate = Replace(FormatMyDate, "{H}", Hour(myDate))
	FormatMyDate = Replace(FormatMyDate, "{h}", Right("00" & Hour(myDate), 2))
	FormatMyDate = Replace(FormatMyDate, "{MI}", Minute(myDate))
	FormatMyDate = Replace(FormatMyDate, "{mi}", Right("00" & Minute(myDate), 2))
	FormatMyDate = Replace(FormatMyDate, "{S}", Second(myDate))
	FormatMyDate = Replace(FormatMyDate, "{s}", Right("00" & Second(myDate), 2))
	'Template = Null
End Function
%>