📄 functions_format_post.asp
字号:
<%
'****************************************************************************************
'** Copyright Notice
'**
'** Web Wiz Guide - Web Wiz Forums
'**
'** Copyright 2001-2005 Bruce Corkhill All Rights Reserved.
'**
'** This program is free software; you can modify (at your own risk) any part of it
'** under the terms of the License that accompanies this software and use it both
'** privately and commercially.
'**
'** All copyright notices must remain in tacked in the scripts and the
'** outputted HTML.
'**
'** You may use parts of this program in your own private work, but you may NOT
'** redistribute, repackage, or sell the whole or any part of this program even
'** if it is modified or reverse engineered in whole or in part without express
'** permission from the author.
'**
'** You may not pass the whole or any part of this application off as your own work.
'**
'** All links to Web Wiz Guide and powered by logo's must remain unchanged and in place
'** and must remain visible when the pages are viewed unless permission is first granted
'** by the copyright holder.
'**
'** This program is distributed in the hope that it will be useful,
'** but WITHOUT ANY WARRANTY; without even the implied warranty of
'** MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER
'** WARRANTIES WHETHER EXPRESSED OR IMPLIED.
'**
'** You should have received a copy of the License along with this program;
'** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom.
'**
'**
'** No official support is available for this program but you may post support questions at: -
'** http://www.webwizguide.info/forum
'**
'** Support questions are NOT answered by e-mail ever!
'**
'** For correspondence or non support questions contact: -
'** info@webwizguide.info
'**
'** or at: -
'**
'** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom
'**
'****************************************************************************************
'******************************************
'*** Strip entites from IE posts *****
'******************************************
Private Function WYSIWYGFormatPost(ByVal strMessage)
'Format messages that use the WYSIWYG Editor
strMessage = Replace(strMessage, " border=0>", ">", 1, -1, 1)
strMessage = Replace(strMessage, " target=_blank>", ">", 1, -1, 1)
strMessage = Replace(strMessage, " target=_top>", ">", 1, -1, 1)
strMessage = Replace(strMessage, " target=_self>", ">", 1, -1, 1)
strMessage = Replace(strMessage, " target=_parent>", ">", 1, -1, 1)
strMessage = Replace(strMessage, " style=""CURSOR: hand""", "", 1, -1, 1)
'Strip out add blocking injection code
'Strip out Norton Internet Security pop up add blocking injected code
strMessage = Replace(strMessage, "<SCRIPT> window.open=NS_ActualOpen; </SCRIPT>", "", 1, -1, 1)
strMessage = Replace(strMessage, "<SCRIPT language=javascript>postamble();</SCRIPT>", "", 1, -1, 1)
strMessage = Replace(strMessage, "<SCRIPT language=""javascript"">postamble();</SCRIPT>", "", 1, -1, 1)
'Strip out Zone Alarm Pro's pop up add blocking injected code (bloody pain in the arse crap software)
If Instr(1, strMessage, "<!-- ZoneLabs Popup Blocking Insertion -->", 1) Then
strMessage = Replace(strMessage, "<!-- ZoneLabs Popup Blocking Insertion -->", "", 1, -1, 1)
strMessage = Replace(strMessage, "<SCRIPT>" & vbCrLf & "window.open=NS_ActualOpen;" & vbCrLf & "orig_onload = window.onload;" & vbCrLf & "orig_onunload = window.onunload;" & vbCrLf & "window.onload = noopen_load;" & vbCrLf & "window.onunload = noopen_unload;" & vbCrLf & "</SCRIPT>", "", 1, -1, 1)
strMessage = Replace(strMessage, "window.open=NS_ActualOpen; orig_onload = window.onload; orig_onunload = window.onunload; window.onload = noopen_load; window.onunload = noopen_unload;", "", 1, -1, 1)
End If
'Strip out Norton Personal Firewall 2003's pop up add blocking injected code
strMessage = Replace(strMessage, "<!--" & vbCrLf & vbCrLf & "window.open = SymRealWinOpen;" & vbCrLf & vbCrLf & "//-->", "", 1, -1, 1)
strMessage = Replace(strMessage, "<!--" & vbCrLf & vbCrLf & "function SymError()" & vbCrLf & "{" & vbCrLf & " return true;" & vbCrLf & "}" & vbCrLf & vbCrLf & "window.onerror = SymError;" & vbCrLf & vbCrLf & "//-->", "", 1, -1, 1)
strMessage = Replace(strMessage, "<!--" & vbCrLf & vbCrLf & "function SymError()" & vbCrLf & "{" & vbCrLf & " return true;" & vbCrLf & "}" & vbCrLf & vbCrLf & "window.onerror = SymError;" & vbCrLf & vbCrLf & "var SymRealWinOpen = window.open;" & vbCrLf & vbCrLf & "function SymWinOpen(url, name, attributes)" & vbCrLf & "{" & vbCrLf & " return (new Object());" & vbCrLf & "}" & vbCrLf & vbCrLf & "window.open = SymWinOpen;" & vbCrLf & vbCrLf & "//-->", "", 1, -1, 1)
'Return the function
WYSIWYGFormatPost = strMessage
End Function
'******************************************
'*** Format Post Function *****
'******************************************
'Format Post Function to covert HTML tags into safe tags
Private Function FormatPost(ByVal strMessage)
'Format spaces and HTML
strMessage = Replace(strMessage, "<", "<", 1, -1, 1)
strMessage = Replace(strMessage, ">", ">", 1, -1, 1)
strMessage = Replace(strMessage, " ", " ", 1, -1, 1)
strMessage = Replace(strMessage, " ", " ", 1, -1, 1)
strMessage = Replace(strMessage, " ", " ", 1, -1, 1)
strMessage = Replace(strMessage, " ", " ", 1, -1, 1)
strMessage = Replace(strMessage, " ", " ", 1, -1, 1)
strMessage = Replace(strMessage, vbTab, " ", 1, -1, 1)
strMessage = Replace(strMessage, Chr(10), "<br />", 1, -1, 1)
'Return the function
FormatPost = strMessage
End Function
'******************************************
'*** Format Forum Codes Function *****
'******************************************
'Format Forum Codes Function to covert forum codes to HTML
Private Function FormatForumCodes(ByVal strMessage)
Dim strTempMessage 'Temporary word hold for e-mail, fonts, and url words
Dim strMessageLink 'Holds the new mesage link that needs converting back into code
Dim lngStartPos 'Holds the start position for a link
Dim lngEndPos 'Holds the end position for a word
Dim intLoop 'Loop counter
'If emoticons are on then change the emotion symbols for the path to the relative smiley icon
If blnEmoticons = True Then
'Loop through the emoticons array
For intLoop = 1 to UBound(saryEmoticons)
strMessage = Replace(strMessage, saryEmoticons(intLoop,2), "<img border=""0"" src=""" & saryEmoticons(intLoop,3) & """>", 1, -1, 1)
Next
End If
'Change forum codes for bold and italic HTML tags back to the normal satandard HTML tags
strMessage = Replace(strMessage, "[B]", "<strong>", 1, -1, 1)
strMessage = Replace(strMessage, "[/B]", "</strong>", 1, -1, 1)
strMessage = Replace(strMessage, "[STRONG]", "<strong>", 1, -1, 1)
strMessage = Replace(strMessage, "[/STRONG]", "</strong>", 1, -1, 1)
strMessage = Replace(strMessage, "[I]", "<em>", 1, -1, 1)
strMessage = Replace(strMessage, "[/I]", "</em>", 1, -1, 1)
strMessage = Replace(strMessage, "[EM]", "<em>", 1, -1, 1)
strMessage = Replace(strMessage, "[/EM]", "</em>", 1, -1, 1)
strMessage = Replace(strMessage, "[U]", "<u>", 1, -1, 1)
strMessage = Replace(strMessage, "[/U]", "</u>", 1, -1, 1)
strMessage = Replace(strMessage, "[HR]", "<hr />", 1, -1, 1)
strMessage = Replace(strMessage, "[LIST=1]", "<ol>", 1, -1, 1)
strMessage = Replace(strMessage, "[/LIST=1]", "</ol>", 1, -1, 1)
strMessage = Replace(strMessage, "[LIST]", "<ul>", 1, -1, 1)
strMessage = Replace(strMessage, "[/LIST]", "</ul>", 1, -1, 1)
strMessage = Replace(strMessage, "[LI]", "<li>", 1, -1, 1)
strMessage = Replace(strMessage, "[/LI]", "</li>", 1, -1, 1)
strMessage = Replace(strMessage, "[CENTER]", "<center>", 1, -1, 1)
strMessage = Replace(strMessage, "[/CENTER]", "</center>", 1, -1, 1)
strMessage = Replace(strMessage, "[BR]", "<br>", 1, -1, 1)
strMessage = Replace(strMessage, "[P]", "<p>", 1, -1, 1)
strMessage = Replace(strMessage, "[/P]", "</p>", 1, -1, 1)
strMessage = Replace(strMessage, "[P ALIGN=CENTER]", "<p align=center>", 1, -1, 1)
strMessage = Replace(strMessage, "[P ALIGN=LEFT]", "<p align=left>", 1, -1, 1)
strMessage = Replace(strMessage, "[P ALIGN=RIGHT]", "<p align=right>", 1, -1, 1)
strMessage = Replace(strMessage, "[DIV]", "<div>", 1, -1, 1)
strMessage = Replace(strMessage, "[/DIV]", "</div>", 1, -1, 1)
strMessage = Replace(strMessage, "[DIV ALIGN=CENTER]", "<div align=center>", 1, -1, 1)
strMessage = Replace(strMessage, "[DIV ALIGN=LEFT]", "<div align=left>", 1, -1, 1)
strMessage = Replace(strMessage, "[DIV ALIGN=RIGHT]", "<div align=right>", 1, -1, 1)
strMessage = Replace(strMessage, "[BLOCKQUOTE]", "<blockquote>", 1, -1, 1)
strMessage = Replace(strMessage, "[/BLOCKQUOTE]", "</blockquote>", 1, -1, 1)
strMessage = Replace(strMessage, "[SIZE=1]", "<font size=""1"">", 1, -1, 1)
strMessage = Replace(strMessage, "[SIZE=2]", "<font size=""2"">", 1, -1, 1)
strMessage = Replace(strMessage, "[SIZE=3]", "<font size=""3"">", 1, -1, 1)
strMessage = Replace(strMessage, "[SIZE=4]", "<font size=""4"">", 1, -1, 1)
strMessage = Replace(strMessage, "[SIZE=5]", "<font size=""5"">", 1, -1, 1)
strMessage = Replace(strMessage, "[SIZE=6]", "<font size=""6"">", 1, -1, 1)
strMessage = Replace(strMessage, "[/SIZE]", "</font>", 1, -1, 1)
strMessage = Replace(strMessage, "[FONT=Arial]", "<font face=""Arial, Helvetica, sans-serif"">", 1, -1, 1)
strMessage = Replace(strMessage, "[FONT=Courier]", "<font face=""Courier New, Courier, mono"">", 1, -1, 1)
strMessage = Replace(strMessage, "[FONT=Times]", "<font face=""Times New Roman, Times, serif"">", 1, -1, 1)
strMessage = Replace(strMessage, "[FONT=Verdana]", "<font face=""Verdana, Arial, Helvetica, sans-serif"">", 1, -1, 1)
strMessage = Replace(strMessage, "[/FONT]", "</font>", 1, -1, 1)
'These are for backward compatibility with old forum codes
strMessage = Replace(strMessage, "[BLACK]", "<font color=""black"">", 1, -1, 1)
strMessage = Replace(strMessage, "[WHITE]", "<font color=""white"">", 1, -1, 1)
strMessage = Replace(strMessage, "[BLUE]", "<font color=""blue"">", 1, -1, 1)
strMessage = Replace(strMessage, "[RED]", "<font color=""red"">", 1, -1, 1)
strMessage = Replace(strMessage, "[GREEN]", "<font color=""green"">", 1, -1, 1)
strMessage = Replace(strMessage, "[YELLOW]", "<font color=""yellow"">", 1, -1, 1)
strMessage = Replace(strMessage, "[ORANGE]", "<font color=""orange"">", 1, -1, 1)
strMessage = Replace(strMessage, "[BROWN]", "<font color=""brown"">", 1, -1, 1)
strMessage = Replace(strMessage, "[MAGENTA]", "<font color=""magenta"">", 1, -1, 1)
strMessage = Replace(strMessage, "[CYAN]", "<font color=""cyan"">", 1, -1, 1)
strMessage = Replace(strMessage, "[LIME GREEN]", "<font color=""limegreen"">", 1, -1, 1)
'Loop through the message till all or any images are turned into HTML images
Do While InStr(1, strMessage, "[IMG]", 1) > 0 AND InStr(1, strMessage, "[/IMG]", 1) > 0
'Find the start position in the message of the [IMG] code
lngStartPos = InStr(1, strMessage, "[IMG]", 1)
'Find the position in the message for the [/IMG]] closing code
lngEndPos = InStr(lngStartPos, strMessage, "[/IMG]", 1) + 6
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 6
'Read in the code to be converted into a hyperlink from the message
strMessageLink = Trim(Mid(strMessage, lngStartPos, (lngEndPos - lngStartPos)))
'Place the message link into the tempoary message variable
strTempMessage = strMessageLink
'Format the IMG tages into an HTML image tag
strTempMessage = Replace(strTempMessage, "[IMG]", "<img src=""", 1, -1, 1)
'If there is no tag shut off place a > at the end
If InStr(1, strTempMessage, "[/IMG]", 1) Then
strTempMessage = Replace(strTempMessage, "[/IMG]", """>", 1, -1, 1)
Else
strTempMessage = strTempMessage & ">"
End If
'Place the new fromatted hyperlink into the message string body
strMessage = Replace(strMessage, strMessageLink, strTempMessage, 1, -1, 1)
Loop
'Loop through the message till all or any hyperlinks are turned into HTML hyperlinks
Do While InStr(1, strMessage, "[URL=", 1) > 0 AND InStr(1, strMessage, "[/URL]", 1) > 0
'Find the start position in the message of the [URL= code
lngStartPos = InStr(1, strMessage, "[URL=", 1)
'Find the position in the message for the [/URL] closing code
lngEndPos = InStr(lngStartPos, strMessage, "[/URL]", 1) + 6
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 7
'Read in the code to be converted into a hyperlink from the message
strMessageLink = Trim(Mid(strMessage, lngStartPos, (lngEndPos - lngStartPos)))
'Place the message link into the tempoary message variable
strTempMessage = strMessageLink
'Format the link into an HTML hyperlink
strTempMessage = Replace(strTempMessage, "[URL=", "<a href=""", 1, -1, 1)
'If there is no tag shut off place a > at the end
If InStr(1, strTempMessage, "[/URL]", 1) Then
strTempMessage = Replace(strTempMessage, "[/URL]", "</a>", 1, -1, 1)
strTempMessage = Replace(strTempMessage, "]", """>", 1, -1, 1)
Else
strTempMessage = strTempMessage & ">"
End If
'Place the new fromatted hyperlink into the message string body
strMessage = Replace(strMessage, strMessageLink, strTempMessage, 1, -1, 1)
Loop
'Loop through the message till all or any hyperlinks are turned into HTML hyperlinks
Do While InStr(1, strMessage, "[URL]", 1) > 0 AND InStr(1, strMessage, "[/URL]", 1) > 0
'Find the start position in the message of the [URL] code
lngStartPos = InStr(1, strMessage, "[URL]", 1)
'Find the position in the message for the [/URL]] closing code
lngEndPos = InStr(lngStartPos, strMessage, "[/URL]", 1) + 6
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 6
'Read in the code to be converted into a hyperlink from the message
strMessageLink = Trim(Mid(strMessage, lngStartPos, (lngEndPos - lngStartPos)))
'Place the message link into the tempoary message variable
strTempMessage = strMessageLink
'Remove hyperlink BB codes
strTempMessage = Replace(strTempMessage, "[URL]", "", 1, -1, 1)
strTempMessage = Replace(strTempMessage, "[/URL]", "", 1, -1, 1)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -