<%
'-----------------------------------------------------------------------
'--- HTML-UBB±à¼­Æ÷ÀàÄ£¿é
'--- Copyright (C) 2006,2007 NewAsp.Net. All rights reserved.
'--- Website: http://www.newasp.net/,http://www.newasp.cn/
'--- Email: newasp@163.com
'--- Data: 2007-4-1
'-----------------------------------------------------------------------
Class Editor_Cls
	Private m_strBasePath
	Private m_strWidth
	Private m_strHeight
	Private m_strValue
	Private m_strToolbarSet
	Private m_strInstanceName
	Private m_blnUserMode
	Private m_setEditMode
	Private MsxmlVersion
	Private oConfig
	Private m_intChannelID
	Private m_strHtmlEditor
	Private IsBokecc

	Private Sub Class_Initialize()
		On Error Resume Next
		m_strBasePath		= "/editor/"
		m_strWidth		= "100%"
		m_strHeight		= "300"
		m_strToolbarSet		= "Default"
		m_strValue		= ""
		m_strInstanceName	= "textContent"
		m_blnUserMode		= False
		m_setEditMode		= 0
		MsxmlVersion		= ".3.0"
		m_intChannelID		= 0
		IsBokecc			= 1
		Set oConfig = NewAsp.CreateAXObject("Scripting.Dictionary")
		If NewAsp.PlusSetting(6) = "" Then NewAsp.PlusSetting(6) = "0"
		If NewAsp.PlusSetting(5) = "0" Then NewAsp.PlusSetting(5) = "0"
	End Sub

	Private Sub Class_Terminate()
		Set oConfig = Nothing
	End Sub

	Public Property Let BasePath( basePathValue )
		If ( IsNull( basePathValue ) OR IsEmpty( basePathValue ) ) Then
			m_strBasePath = "/editor/"
		Else
			m_strBasePath = basePathValue
		End If
	End Property

	Public Property Let InstanceName( instanceNameValue )
		If ( IsNull( instanceNameValue ) OR IsEmpty( instanceNameValue ) ) Then
			m_strInstanceName = "textContent"
		Else
			m_strInstanceName = instanceNameValue
		End If
	End Property

	Public Property Let Width( widthValue )
		If ( IsNull( widthValue ) OR widthValue = "0" ) Then
			m_strWidth = "100%"
		Else
			m_strWidth = widthValue
		End If
	End Property

	Public Property Let Height( heightValue )
		If ( IsNull( heightValue ) OR heightValue = "0" ) Then
			m_strHeight = "100%"
		Else
			m_strHeight = heightValue
		End If
	End Property

	Public Property Let ToolbarSet( toolbarSetValue )
		If ( IsNull( toolbarSetValue ) OR IsEmpty( toolbarSetValue ) ) Then
			m_strToolbarSet = "Default"
		Else
			m_strToolbarSet = toolbarSetValue
		End If
	End Property

	Public Property Let UserMode( userModeValue )
		m_blnUserMode = userModeValue
	End Property

	Public Property Let setEditMode( setModeValue )
		m_setEditMode = setModeValue
	End Property

	Public Property Let ChannelID( ChannelIDValue )
		m_IntChannelID = ChannelIDValue
	End Property

	Public Property Let Value( newValue )
		If ( IsNull( newValue ) OR IsEmpty( newValue ) ) Then
			m_strValue = ""
		Else
			m_strValue = newValue
		End If
	End Property

	Public Property Let Config( configKey, configValue )
		oConfig.Add configKey, configValue
	End Property

	Public Sub Execute()
		If Not IsArray(NewAsp.setUserEditor) Then NewAsp.setUserEditor = Array(1,0,560,350,1,1,1,1,1,1,1,1,1,0,1,600,0,1,1,1,1,1,1,1)
		IsBokecc = Trim(NewAsp.setUserEditor(18))
		If m_setEditMode = 0 Then
			FCKeditor()
		Else
			UBBeditor()
		End If
		Response.Write m_strHtmlEditor
	End Sub

	Public Function CreateEditor()
		If Not IsArray(NewAsp.setUserEditor) Then NewAsp.setUserEditor = Array(1,0,560,350,1,1,1,1,1,1,1,1,1,0,1,600,0,1,1,1,1,1,1,1)
		IsBokecc = Trim(NewAsp.setUserEditor(18))
		If m_setEditMode = 0 Then
			FCKeditor()
		Else
			UBBeditor()
		End If
		CreateEditor = m_strHtmlEditor
	End Function

	Private Sub UBBeditor()
		Dim XMLDom,Node,xmlNode,XSLT,XMLStyle,proc
		Dim sBasePath,strWidth,strHeight
		sBasePath = m_strBasePath & "ubbeditor/"
		If InStr( m_strWidth, "%" ) > 0  Then
			strWidth = m_strWidth
		Else
			strWidth = m_strWidth & "px"
		End If
		If InStr( m_strHeight, "%" ) > 0  Then
			strHeight = m_strHeight
		Else
			strHeight = m_strHeight-80 & "px"
		End If
		Set XMLDom=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		XMLDom.appendChild(XMLDom.createElement("xml"))
		Set Node=XMLDom.createNode(1,"setting","")
		Node.attributes.setNamedItem(XMLDom.createNode(2,"width","")).text = strWidth
		Node.attributes.setNamedItem(XMLDom.createNode(2,"height","")).text = strHeight
		Node.attributes.setNamedItem(XMLDom.createNode(2,"path","")).text = sBasePath
		Node.attributes.setNamedItem(XMLDom.createNode(2,"instancename","")).text = m_strInstanceName
		Node.attributes.setNamedItem(XMLDom.createNode(2,"toolbar","")).text = LCase(m_strToolbarSet)
		Node.attributes.setNamedItem(XMLDom.createNode(2,"value","")).text = Server.HTMLEncode(HtmlToUBB(m_strValue))
		Node.attributes.setNamedItem(XMLDom.createNode(2,"usermode","")).text = m_blnUserMode
		Node.attributes.setNamedItem(XMLDom.createNode(2,"setedit","")).text = m_setEditMode
		If NewAsp.PlusSetting(5) = "0" Or IsBokecc = "1" Then
			Node.attributes.setNamedItem(XMLDom.createNode(2,"isbokecc","")).text = 0
		Else
			Node.attributes.setNamedItem(XMLDom.createNode(2,"isbokecc","")).text = 1
		End If
		Node.attributes.setNamedItem(XMLDom.createNode(2,"bokeccid","")).text = NewAsp.PlusSetting(6)
		Node.attributes.setNamedItem(XMLDom.createNode(2,"ccplugin","")).text = NewAsp.PlusSetting(8)
		Node.attributes.setNamedItem(XMLDom.createNode(2,"ccwidth","")).text = NewAsp.PlusSetting(9)
		Node.attributes.setNamedItem(XMLDom.createNode(2,"ccheight","")).text = NewAsp.PlusSetting(10)
		If m_setEditMode = 2 Then
			Node.attributes.setNamedItem(XMLDom.createNode(2,"ubbmethod","")).text = "expert"
		Else
			Node.attributes.setNamedItem(XMLDom.createNode(2,"ubbmethod","")).text = "normal"
		End If
		XMLDom.documentElement.appendChild(Node)

		Set xmlNode = XMLDom.cloneNode(True)
		Set XSLT = NewAsp.CreateAXObject("Msxml2.XSLTemplate" & MsxmlVersion)
		Set XMLStyle = NewAsp.CreateAXObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		If XMLStyle.load(Server.MapPath(sBasePath & "ubbeditor.xslt")) Then
			XSLT.stylesheet = XMLStyle
			Set proc = XSLT.createProcessor()
			proc.input = xmlNode
			proc.transform()
			m_strHtmlEditor = Replace(proc.output, "&amp;", "&")
			Set proc = Nothing
		Else
			m_strHtmlEditor = vbNullString
		End If
		Set XMLStyle = Nothing
		Set XSLT = Nothing:Set xmlNode = Nothing
		Set Node = Nothing:Set XMLDom = Nothing
		If NewAsp.PlusSetting(5) = "1" And IsBokecc = "0" Then
			m_strHtmlEditor = m_strHtmlEditor & InsertCC_script
		End If
	End Sub

	Private Sub FCKeditor()
		Dim sBasePath
		sBasePath = m_strBasePath & "fckeditor/"
		m_strHtmlEditor = "<div>"
		If IsCompatible() Then
			Dim sFile
			If Request.QueryString( "fcksource" ) = "true" Then
				sFile = "fckeditor.original.html"
			Else
				If m_blnUserMode Then
					sFile = "fckeditors.html"
				Else
					sFile = "fckeditor.html"
				End If
			End If
			Dim sLink
			sLink = sBasePath & "editor/" & sFile & "?InstanceName=" + m_strInstanceName
			If (m_strToolbarSet & "") <> "" Then
				sLink = sLink + "&amp;Toolbar=" & m_strToolbarSet
			End If
			If NewAsp.PlusSetting(5) = "1" And IsBokecc = "0" Then
				Dim mBokeccValue
				mBokeccValue = "<object width=""" & NewAsp.PlusSetting(9) & """ height=""" & NewAsp.PlusSetting(10) & """>"
				mBokeccValue = mBokeccValue & "<param name=""wmode"" value=""transparent"" />"
				mBokeccValue = mBokeccValue & "<param name=""allowScriptAccess"" value=""always"" />"
				mBokeccValue = mBokeccValue & "<param name=""movie"" value=""http://union.bokecc.com/flash/plugin/" & NewAsp.PlusSetting(8) & "?userID=" & NewAsp.PlusSetting(6) & "&type=newasp"" />"
				mBokeccValue = mBokeccValue & "<embed src=""http://union.bokecc.com/flash/plugin/" & NewAsp.PlusSetting(8) & "?userID=" & NewAsp.PlusSetting(6) & "&type=newasp"" type=""application/x-shockwave-flash"" width=""" & NewAsp.PlusSetting(9) & """ height=""" & NewAsp.PlusSetting(10) & """ allowScriptAccess=""always""  wmode=""transparent""></embed>"
				mBokeccValue = mBokeccValue & "</object>"
				'm_strHtmlEditor = m_strHtmlEditor & "<input type=""hidden"" id=""Bokecc_Plugins"" value=""" & Server.HTMLEncode( mBokeccValue ) & """ style=""display:none"" />"
				m_strHtmlEditor = m_strHtmlEditor & "<span id=""Bokecc_Plugins"" style=""display:none"">" & mBokeccValue & "</span>"
			End If
			m_strHtmlEditor = m_strHtmlEditor & "<input type=""hidden"" id=""" & m_strInstanceName & """ name=""" & m_strInstanceName & """ value=""" & Server.HTMLEncode( m_strValue ) & """ style=""display:none"" />"
			m_strHtmlEditor = m_strHtmlEditor & "<input type=""hidden"" id=""" & m_strInstanceName & "___Config"" value=""" & GetConfigFieldString() & """ style=""display:none"" />"
			m_strHtmlEditor = m_strHtmlEditor & "<iframe id=""" & m_strInstanceName & "___Frame"" src=""" & sLink & """ width=""" & m_strWidth & """ height=""" & m_strHeight & """ frameborder=""0"" scrolling=""no""></iframe>"
			If NewAsp.PlusSetting(5) = "1" And IsBokecc = "0" Then
				m_strHtmlEditor = m_strHtmlEditor & InsertCC_script
			End If
		Else
			Dim sWidthCSS, sHeightCSS
			If InStr( m_strWidth, "%" ) > 0  Then
				sWidthCSS = m_strWidth
			Else
				sWidthCSS = m_strWidth & "px"
			End If
			If InStr( m_strHeight, "%" ) > 0  Then
				sHeightCSS = m_strHeight
			Else
				sHeightCSS = m_strHeight & "px"
			End If
			m_strHtmlEditor = m_strHtmlEditor & "<textarea name=""" & m_strInstanceName & """ rows=""4"" cols=""40"" style=""width: " & sWidthCSS & "; height: " & sHeightCSS & """>" & Server.HTMLEncode( m_strValue ) & "</textarea>"
		End If
		m_strHtmlEditor = m_strHtmlEditor & "</div>"
	End Sub

	Private Function IsCompatible()

		IsCompatible = IsCompatibleBrowser()

	End Function

	Private Function IsCompatibleBrowser()
		Dim sAgent
		sAgent = Request.ServerVariables("HTTP_USER_AGENT")

		Dim iVersion
		Dim re, Matches

		If InStr(sAgent, "MSIE") > 0 AND InStr(sAgent, "mac") <= 0  AND InStr(sAgent, "Opera") <= 0 Then
			iVersion = CInt( ToNumericFormat( Mid(sAgent, InStr(sAgent, "MSIE") + 5, 3) ) )
			IsCompatibleBrowser = ( iVersion >= 5.5 )
		ElseIf InStr(sAgent, "Gecko/") > 0 Then
			iVersion = CLng( Mid( sAgent, InStr( sAgent, "Gecko/" ) + 6, 8 ) )
			IsCompatibleBrowser = ( iVersion >= 20030210 )
		ElseIf InStr(sAgent, "Opera/") > 0 Then
			iVersion = CSng( ToNumericFormat( Mid( sAgent, InStr( sAgent, "Opera/" ) + 6, 4 ) ) )
			IsCompatibleBrowser = ( iVersion >= 9.5 )
		ElseIf InStr(sAgent, "AppleWebKit/") > 0 Then
			Set re = new RegExp
			re.IgnoreCase = true
			re.global = false
			re.Pattern = "AppleWebKit/(\d+)"
			Set Matches = re.Execute(sAgent)
			IsCompatibleBrowser = ( re.Replace(Matches.Item(0).Value, "$1") >= 522 )
		Else
			IsCompatibleBrowser = False
		End If

	End Function

	Private Function ToNumericFormat( numberStr )
		If IsNumeric( "5.5" ) Then
			ToNumericFormat = Replace( numberStr, ",", ".")
		Else
			ToNumericFormat = Replace( numberStr, ".", ",")
		End If
	End Function

	Private Function GetConfigFieldString()
		GetConfigFieldString = ""
	End Function

	Private Function EncodeConfig( valueToEncode )

		If vartype(valueToEncode) = vbBoolean then
			If valueToEncode=True Then
				EncodeConfig="True"
			Else
				EncodeConfig="False"
			End If
		Else
			EncodeConfig = Replace( valueToEncode, "&", "%26" )
			EncodeConfig = Replace( EncodeConfig , "=", "%3D" )
			EncodeConfig = Replace( EncodeConfig , """", "%22" )
		End if

	End Function

	Private Function HtmlToUBB(ByVal str)
		If IsNull(str) Then
			HtmlToUBB = ""
			Exit Function
		End If
		str = Replace(str, Chr(0), "")
		'str = Replace(str, Chr(13), "")
		Dim re
		Set re = New RegExp
		re.IgnoreCase = True
		re.Global = True
		re.Pattern = "([\f\n\r\t\v])"
		str = re.Replace(str,"")
		re.Pattern = "(on(load|click|dbclick|mouseover|mousedown|mouseup|mousewheel|keydown)=""[^""]+"")":str = re.Replace(str, "")
		re.Pattern = "(on(load|click|dbclick|mouseover|mousedown|mouseup|mousewheel|keydown)=\'[^""]+\')":str = re.Replace(str, "")
		're.Pattern = "(<[^>]+on(load|click|dbclick|mouseover|mousedown|mouseup|mousewheel)=([^""]+)[^>]*>)":str = re.Replace(str, "")
		re.Pattern = "(<s+cript[^>]*?>([\w\W]*?)<\/s+cript>)":str = re.Replace(str, "")
		re.Pattern = "(<a[^>]+href=""([^""]+)""[^>]*>(.*?)<\/a>)":str = re.Replace(str, Chr(10)&"[url=$2]$3[/url]"&Chr(10))
		re.Pattern = "(<font[^>]+color=""([^"">]+)""[^>]*>(.*?)<\/font>)":str = re.Replace(str, Chr(10)&"[color=$2]$3[/color]"&Chr(10))
		re.Pattern = "(<font[^>]+color=([^ >]+)[^>]*>(.*?)<\/font>)":str = re.Replace(str, Chr(10)&"[color=$2]$3[/color]"&Chr(10))
		re.Pattern = "(<p[^>]+align=""([^"">]+)""[^>]*>(.*?)<\/p>)":str = re.Replace(str, "[align=$2]$3[/align]")
		re.Pattern = "(<p[^>]+align=([^"">]+)[^>]*>(.*?)<\/p>)":str = re.Replace(str, "[align=$2]$3[/align]")
		re.Pattern = "(<img[^>]+src=""([^""]+)""[^>]*>)":str = re.Replace(str, Chr(10)&"[img]$2[/img]"&Chr(10))
		re.Pattern = "(<img[^>]+src='([^""]+)'[^>]*>)":str = re.Replace(str, Chr(10)&"[img]$2[/img]"&Chr(10))
		re.Pattern = "(<img[^>]+src=([^""]+)[^>]*>)":str = re.Replace(str, Chr(10)&"[img]$2[/img]"&Chr(10))
		re.Pattern = "(<([\/]?)strong>)":str = re.Replace(str, "[$2b]")
		re.Pattern = "(<([\/]?)b>)":str = re.Replace(str, "[$2b]")
		re.Pattern = "(<([\/]?)u>)":str = re.Replace(str, "[$2u]")
		re.Pattern = "(<([\/]?)i>)":str = re.Replace(str, "[$2i]")
		re.Pattern = "(<([\/]?)p>)":str = re.Replace(str, Chr(10))
		re.Pattern = "(&nbsp;)":str = re.Replace(str, " ")
		re.Pattern = "(&amp;)":str = re.Replace(str, "&")
		re.Pattern = "(&quot;)":str = re.Replace(str, """")
		re.Pattern = "(&#39;)":str = re.Replace(str, "'")
		re.Pattern = "(&#123;)":str = re.Replace(Str,"{")
		re.Pattern = "(&#125;)":str = re.Replace(Str,"}")
		re.Pattern = "(&#36;)":str = re.Replace(Str,"$")
		re.Pattern = "(<br[^>]*?>)":str = re.Replace(str, Chr(10))
		re.Pattern = "((<p>&nbsp;</p>)|(<p></p>))":str = re.Replace(str, Chr(10))
		re.Pattern = "((<p[^>]*?>)|(</p>))":str = re.Replace(str, Chr(10))
		re.Pattern = "(<[^>]*?>)":str = re.Replace(str, "")
		re.Pattern = "(\[url=([^\]]+)\]\n(\[img\]\1\[\/img\])\n\[\/url\])":str = re.Replace(str, "$2")
		're.Pattern = "(\n+)":str = re.Replace(str, Chr(10))
		re.Pattern = "(&lt;)":str = re.Replace(str, "<")
		re.Pattern = "(&gt;)":str = re.Replace(str, ">")
		Set re = Nothing
		HtmlToUBB = str
	End Function
	Private Function TrimNewline(ByVal strContent)
		If IsNull(strContent) Then
			TrimNewline = ""
			Exit Function
		End If
		strContent = Replace(strContent, Chr(13), "")
		If strContent = "" Then
			TrimNewline = ""
			Exit Function
		End If
		If Left(strContent,1) = Chr(10) Then
			strContent = Replace(strContent, Chr(10), vbNullString, 1, 1)
			strContent = TrimNewline(strContent)
		End If
		If Right(strContent,1) = Chr(10) Then
			strContent = Left(strContent,Len(strContent)-1)
			strContent = TrimNewline(strContent)
		End If
		'strContent = Replace(strContent, Chr(10), vbCrLf)
		TrimNewline = strContent
	End Function
	Private Function InsertCC_script()
		Dim strInsertCC
		strInsertCC = "<script language=""JavaScript"">"& vbCrLf &_
		"<!--"& vbCrLf &_
		"function InsertCC(s){"& vbCrLf &_
		"	try{"& vbCrLf &_
		"		var oEditors = FCKeditorAPI.GetInstance('" & m_strInstanceName & "');"& vbCrLf &_
		"		oEditors.InsertHtml(s);"& vbCrLf &_
		"	}"& vbCrLf &_
		"	catch(e){"& vbCrLf &_
		"		document.forms[0]." & m_strInstanceName & ".value+=s;"& vbCrLf &_
		"	}"& vbCrLf &_
		"}"& vbCrLf &_
		"//-->"& vbCrLf &_
		"</script>"& vbCrLf
		InsertCC_script = strInsertCC
	End Function

End Class

%>