cls_editor.asp

来自「小游戏网站演示www.4399.io 拥有4万条游戏数据」· ASP 代码 · 共 339 行

ASP
339
字号
<%
'-----------------------------------------------------------------------
'--- HTML-UBB编辑器类模块
'--- Copyright (C) 2006,2007 NewAsp.Net. All rights reserved.
'--- Written by newasp.net Fssunwin
'--- 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 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
		Set oConfig = Server.CreateObject("Scripting.Dictionary")
	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 m_setEditMode = 0 Then
			FCKeditor()
		Else
			UBBeditor()
		End If
		Response.Write m_strHtmlEditor
	End Sub
	
	Public Function CreateEditor()
		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 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 = Server.CreateObject("Msxml2.XSLTemplate" & MsxmlVersion)
		Set XMLStyle = Server.CreateObject("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 = proc.output
			Set proc = Nothing
		Else
			m_strHtmlEditor = vbNullString
		End If
		Set XMLStyle = Nothing
		Set XSLT = Nothing:Set xmlNode = Nothing
		Set Node = Nothing:Set XMLDom = Nothing

	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
			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>"
		Else
			Dim sWidthCSS, sHeightCSS
			If InStr( sWidth, "%" ) > 0  Then
				sWidthCSS = m_strWidth
			Else
				sWidthCSS = m_strWidth & "px"
			End If
			If InStr( sHeight, "%" ) > 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()
		Dim sAgent
		sAgent = Request.ServerVariables("HTTP_USER_AGENT")
		Dim iVersion
		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) ) )
			IsCompatible = ( iVersion >= 5.5 )
		ElseIf InStr(sAgent, "Gecko/") > 0 Then
			iVersion = CLng( Mid( sAgent, InStr( sAgent, "Gecko/" ) + 6, 8 ) )
			IsCompatible = ( iVersion >= 20030210 )
		Else
			IsCompatible = 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()
		Dim sParams
		Dim bFirst
		bFirst = True
		Dim sKey
		For Each sKey in oConfig
			If bFirst = False Then
				sParams = sParams & "&amp;"
			Else
				bFirst = False
			End If
			sParams = sParams & EncodeConfig( sKey ) & "=" & EncodeConfig( oConfig(sKey) )
		Next
		GetConfigFieldString = sParams
	End Function

	Private Function EncodeConfig( valueToEncode )
		EncodeConfig = Replace( valueToEncode, "&", "%26" )
		EncodeConfig = Replace( EncodeConfig , "=", "%3D" )
		EncodeConfig = Replace( EncodeConfig , """", "%22" )
	End Function
	
	Private Function HtmlToUBB(ByVal str)
		If IsNull(str) Then
			HtmlToUBB = ""
			Exit Function
		End If
		str = Replace(str, Chr(0), "")
		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)&"$1"&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
	
End Class

%>
<script type="text/javascript" runat="server" language="javascript">
function HtmlToUBBCode(str) {
	str = str.replace(/\r/g,"");
	str = str.replace(/on(load|click|dbclick|mouseover|mousedown|mouseup)="[^"]+"/ig,"");
	//str = str.replace(/<s+cript[^>]*?>([\w\W]*?)<\/s+cript>/ig,"");
	str = str.replace(/<a[^>]+href="([^"]+)"[^>]*>(.*?)<\/a>/ig,"\n[url=$1]$2[/url]\n");
	str = str.replace(/<font[^>]+color="([^">]+)"[^>]*>(.*?)<\/font>/ig,"\n[color=$1]$2[/color]\n");
	str = str.replace(/<img[^>]+src="([^"]+)"[^>]*>/ig,"\n[img]$1[/img]\n");
	str = str.replace(/<([\/]?)b>/ig,"[$1b]");
	str = str.replace(/<([\/]?)strong>/ig,"[$1b]");
	str = str.replace(/<([\/]?)u>/ig,"[$1u]");
	str = str.replace(/<([\/]?)i>/ig,"[$1i]");
	str = str.replace(/&nbsp;/g," ");
	str = str.replace(/&amp;/g,"&");
	str = str.replace(/&quot;/g,"\"");
	str = str.replace(/&lt;/g,"<");
	str = str.replace(/&gt;/g,">");
	str = str.replace(/&#123;/g,"{");
	str = str.replace(/&#125;/g,"}");
	str = str.replace(/&#36;/g,"\$");
	str = str.replace(/<br>/ig,"\n");
	str = str.replace(/<[^>]*?>/g,"");
	str = str.replace(/\[url=([^\]]+)\]\n(\[img\]\1\[\/img\])\n\[\/url\]/g,"$2");
	str = str.replace(/\n+/g,"\n");
	return str;
}
</script>

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?