<% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Forums(TM) '** http://www.webwizforums.com '** '** Copyright (C)2001-2008 Web Wiz(TM). All Rights Reserved. '** '** THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS UNDER LICENSE FROM 'WEB WIZ'. '** '** IF YOU DO NOT AGREE TO THE LICENSE AGREEMENT THEN 'WEB WIZ' IS UNWILLING TO LICENSE '** THE SOFTWARE TO YOU, AND YOU SHOULD DESTROY ALL COPIES YOU HOLD OF 'WEB WIZ' SOFTWARE '** AND DERIVATIVE WORKS IMMEDIATELY. '** '** If you have not received a copy of the license with this work then a copy of the latest '** license contract can be found at:- '** '** http://www.webwizguide.com/license '** '** For more information about this software and for licensing information please contact '** 'Web Wiz' at the address and website below:- '** '** Web Wiz, Unit 10E, Dawkins Road Industrial Estate, Poole, Dorset, BH15 4JD, England '** http://www.webwizguide.com '** '** Removal or modification of this copyright notice will violate the license contract. '** '**************************************************************************************** '*************************** SOFTWARE AND CODE MODIFICATIONS **************************** '** '** MODIFICATION OF THE FREE EDITIONS OF THIS SOFTWARE IS A VIOLATION OF THE LICENSE '** AGREEMENT AND IS STRICTLY PROHIBITED '** '** If you wish to modify any part of this software a license must be purchased '** '**************************************************************************************** '****************************************** '*** HTML to Forum Codes Function ***** '****************************************** 'Edit Post Function to convert posts back to forum codes Private Function EditPostConvertion(ByVal strMessage) Dim strTempMessage 'Temporary word hold for e-mail 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 'Extra error handling If isNull(strMessage) Then strMessage = "" strMessage = Replace(strMessage, " target=""_blank""", "", 1, -1, 1) strMessage = Replace(strMessage, " rel=""no follow""", "", 1, -1, 1) strMessage = Replace(strMessage, " border=""0""", "", 1, -1, 1) strMessage = Replace(strMessage, "", saryEmoticons(intLoop,2), 1, -1, 1) strMessage = Replace(strMessage, "", saryEmoticons(intLoop,2), 1, -1, 1) strMessage = Replace(strMessage, "", saryEmoticons(intLoop,2), 1, -1, 1) Next 'If the message has been edited remove who edited the post If InStr(1, strMessage, "", 1) Then strMessage = removeEditorAuthor(strMessage) 'Change the HTML codes back into my own codes for bold and italic strMessage = Replace(strMessage, "", "[B]", 1, -1, 1) strMessage = Replace(strMessage, "", "[/B]", 1, -1, 1) strMessage = Replace(strMessage, "", "[I]", 1, -1, 1) strMessage = Replace(strMessage, "", "[/I]", 1, -1, 1) strMessage = Replace(strMessage, "", "[U]", 1, -1, 1) strMessage = Replace(strMessage, "", "[/U]", 1, -1, 1) strMessage = Replace(strMessage, "

", "[HR]", 1, -1, 1) strMessage = Replace(strMessage, "

", "[HR]", 1, -1, 1) strMessage = Replace(strMessage, "

", "[HR]", 1, -1, 1) strMessage = Replace(strMessage, "

", "[LIST=1]", 1, -1, 1) strMessage = Replace(strMessage, "", "[/LIST=1]", 1, -1, 1) strMessage = Replace(strMessage, "

", "[LIST]", 1, -1, 1) strMessage = Replace(strMessage, "", "[/LIST]", 1, -1, 1) strMessage = Replace(strMessage, "

", "[LI]", 1, -1, 1) strMessage = Replace(strMessage, "

", "[/LI]", 1, -1, 1) strMessage = Replace(strMessage, "", "[CENTER]", 1, -1, 1) strMessage = Replace(strMessage, "", "[/CENTER]", 1, -1, 1) strMessage = Replace(strMessage, "~~", "[STRIKE]", 1, -1, 1) strMessage = Replace(strMessage, "~~", "[/STRIKE]", 1, -1, 1) strMessage = Replace(strMessage, "_{", "[SUB]", 1, -1, 1)
strMessage = Replace(strMessage, "}", "[/SUB]", 1, -1, 1) strMessage = Replace(strMessage, "^{", "[SUP]", 1, -1, 1)
strMessage = Replace(strMessage, "}", "[/SUP]", 1, -1, 1) strMessage = Replace(strMessage, "", "[B]", 1, -1, 1) strMessage = Replace(strMessage, "", "[/B]", 1, -1, 1) strMessage = Replace(strMessage, "", "[I]", 1, -1, 1) strMessage = Replace(strMessage, "", "[/I]", 1, -1, 1) strMessage = Replace(strMessage, "
", "", 1, -1, 1) strMessage = Replace(strMessage, "
", "", 1, -1, 1) strMessage = Replace(strMessage, "

", "[PRE]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[PRE]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[/PRE]", 1, -1, 1)
	
	strMessage = Replace(strMessage, "", "[P]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[/P]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[P ALIGN=CENTER]", 1, -1, 1)
	strMessage = Replace(strMessage, "
", "[P ALIGN=JUSTIFY]", 1, -1, 1)
	strMessage = Replace(strMessage, "
", "[P ALIGN=LEFT]", 1, -1, 1)
	strMessage = Replace(strMessage, "
", "[P ALIGN=RIGHT]", 1, -1, 1)
	
	strMessage = Replace(strMessage, "
", "[DIV]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[/DIV]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[DIV ALIGN=CENTER]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[DIV ALIGN=JUSTIFY]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[DIV ALIGN=LEFT]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[DIV ALIGN=RIGHT]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[DIV ALIGN=CENTER]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[DIV ALIGN=JUSTIFY]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[DIV ALIGN=LEFT]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[DIV ALIGN=RIGHT]", 1, -1, 1)
	
	strMessage = Replace(strMessage, "", "[BLOCKQUOTE]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[/BLOCKQUOTE]", 1, -1, 1)
	
	strMessage = Replace(strMessage, "", "[SIZE=1]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[SIZE=2]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[SIZE=3]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[SIZE=4]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[SIZE=5]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[SIZE=6]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[SIZE=6]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[SIZE=1]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[SIZE=2]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[SIZE=3]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[SIZE=4]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[SIZE=5]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[SIZE=6]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[FONT=Arial]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[FONT=Courier]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[FONT=Times]", 1, -1, 1)
	strMessage = Replace(strMessage, "", "[FONT=Verdana]", 1, -1, 1)
	
	
	
	'Loop through the message till all or any IMAGE links are converted back into BBcodes
	Do While InStr(1, strMessage, " 0
						    	
		'Find the start position in the image tag
		lngStartPos = InStr(1, strMessage, "", 1) + 3
		
		'Make sure the end position is not in error
		If lngEndPos - lngStartPos =< 10 Then lngEndPos = lngStartPos + 10
						
		'Read in the code to be converted back into the forum codes
		strMessageLink = Trim(Mid(strMessage, lngStartPos, (lngEndPos - lngStartPos)))	
		
		'Place the image tag into the tempoary message variable
		strTempMessage = strMessageLink
		
		'Format the HTML image tag back into forum codes
		strTempMessage = Replace(strTempMessage, "src=""", "", 1, -1, 1)
		strTempMessage = Replace(strTempMessage, "", "[/IMG]", 1, -1, 1)
		
		'Place the new fromatted codes into the message string body
		strMessage = Replace(strMessage, strMessageLink, strTempMessage, 1, -1, 1)		
	Loop
	
	
	
	
	'Loop through the message till all or any HTML email links are converted back into codes
	Do While InStr(1, strMessage, " 0 AND InStr(1, strMessage, "", 1) > 0
						    	
		'Find the start position in the message of the HTML e-mail mailto tag
		lngStartPos = InStr(1, strMessage, " closing code
		lngEndPos = InStr(lngStartPos, strMessage, "", 1) + 4
		
		'Make sure the end position is not in error
		If lngEndPos - lngStartPos =< 16 Then lngEndPos = lngStartPos + 16
						
		'Read in the code to be converted back into the forum codes
		strMessageLink = Trim(Mid(strMessage, lngStartPos, (lngEndPos - lngStartPos)))	
		
		'Place the message link into the tempoary message variable
		strTempMessage = strMessageLink
		
		'Format the HTML mailto link back into forum codes
		strTempMessage = Replace(strTempMessage, "", "[/EMAIL]", 1, -1, 1)
		strTempMessage = Replace(strTempMessage, """>", "]", 1, -1, 1)
		
		'Place the new fromatted codes 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 back into froum codes
	Do While InStr(1, strMessage, " 0 AND InStr(1, strMessage, "", 1) > 0
						    	
		'Find the start position in the message of the HTML hyperlink
		lngStartPos = InStr(1, strMessage, " closing code
		lngEndPos = InStr(lngStartPos, strMessage, "", 1) + 4
		
		'Make sure the end position is not in error
		If lngEndPos - lngStartPos =< 9 Then lngEndPos = lngStartPos + 9
						
		'Read in the code to be converted back into forum codes from the message
		strMessageLink = Trim(Mid(strMessage, lngStartPos, (lngEndPos - lngStartPos)))	
		
		'Place the message link into the tempoary message variable
		strTempMessage = strMessageLink
		
		'Format the HTML hyperlink back into forum codes
		strTempMessage = Replace(strTempMessage, "", "[/URL]", 1, -1, 1)
		strTempMessage = Replace(strTempMessage, """>", "]", 1, -1, 1)
		
		'Place the new fromatted codes into the message string body
		strMessage = Replace(strMessage, strMessageLink, strTempMessage, 1, -1, 1)		
	Loop
	
	
	
	'Loop through the message till all font colour tags are converted back to forum codes
	Do While InStr(1, strMessage, "", 1) > 0
						    	
		'Find the start position in the message of the HTML colour tag
		lngStartPos = InStr(1, strMessage, "", 1) + 8
		
		'Make sure the end position is not in error
		If lngEndPos - lngStartPos =< 12 Then lngEndPos = lngStartPos + 12
						
		'Read in the code to be converted back into the forum codes
		strMessageLink = Trim(Mid(strMessage, lngStartPos, (lngEndPos - lngStartPos)))	
		
		'Place the message link into the tempoary message variable
		strTempMessage = strMessageLink
		
		'Format the HTML colour tag back into forum codes
		strTempMessage = Replace(strTempMessage, "", "[/COLOR]", 1, -1, 1)
		strTempMessage = Replace(strTempMessage, ">", "]", 1, -1, 1)
		
		'Place the new fromatted codes into the message string body
		strMessage = Replace(strMessage, strMessageLink, strTempMessage, 1, -1, 1)
	
	Loop
	
	'Turn any left over font tages to forum codes
	strMessage = Replace(strMessage, "", "[/FONT]", 1, -1, 1)
	
	
	'Turn the HTML back into the charcaters entred by the user
	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), "", 1, -1, 1)
	
	
	
	'Return function
	EditPostConvertion = strMessage
	
End Function






'******************************************
'*** Remove Post Editor Text Function *****
'******************************************

'Format Post Function to covert forum codes to HTML
Private Function removeEditorAuthor(ByVal strMessage)

	Dim lngStartPos
	Dim lngEndPos
		
	'Get the start and end position in the string of the XML to remove
	lngStartPos = InStr(1, strMessage, "", 1)
	lngEndPos = InStr(1, strMessage, "", 1) + 9
	If lngEndPos - lngStartPos =< 8 Then lngEndPos = lngStartPos + 9

	'If there is something returned strip the XML from the message
	removeEditorAuthor = Replace(strMessage, Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos)), "", 1, -1, 1)
		
End Function
%>