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 + "&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 & "&"
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 = "( )":str = re.Replace(str, " ")
re.Pattern = "(&)":str = re.Replace(str, "&")
re.Pattern = "(")":str = re.Replace(str, """")
re.Pattern = "(')":str = re.Replace(str, "'")
re.Pattern = "({)":str = re.Replace(Str,"{")
re.Pattern = "(})":str = re.Replace(Str,"}")
re.Pattern = "($)":str = re.Replace(Str,"$")
re.Pattern = "(<br[^>]*?>)":str = re.Replace(str, Chr(10))
re.Pattern = "((<p> </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 = "(<)":str = re.Replace(str, "<")
re.Pattern = "(>)":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(/ /g," ");
str = str.replace(/&/g,"&");
str = str.replace(/"/g,"\"");
str = str.replace(/</g,"<");
str = str.replace(/>/g,">");
str = str.replace(/{/g,"{");
str = str.replace(/}/g,"}");
str = str.replace(/$/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 + -
显示快捷键?