www.gusucode.com > 全球营销软件站整站源码4月最新数据 4.0源码程序 > 801wyxqf\inc\cls_editor.asp
<%
'-----------------------------------------------------------------------
'--- 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, "&", "&")
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 + "&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 = "( )":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
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
%>