functions_format_post.asp

快速、可设定管理权限等级的论坛程序

		'Format the URL tages into an HTML hyperlinks
		strTempMessage = "<a href=""" & strTempMessage & """>" & strTempMessage & "</a>"
		
		'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 email links are turned into HTML mailto links
	Do While InStr(1, strMessage, "[EMAIL=", 1) > 0 AND InStr(1, strMessage, "[/EMAIL]", 1) > 0

		'Find the start position in the message of the [EMAIL= code
		lngStartPos = InStr(1, strMessage, "[EMAIL=", 1)

		'Find the position in the message for the [/EMAIL] closing code
		lngEndPos = InStr(lngStartPos, strMessage, "[/EMAIL]", 1) + 8

		'Make sure the end position is not in error
		If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 9

		'Read in the code to be converted into a email link 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 mailto link
		strTempMessage = Replace(strTempMessage, "[EMAIL=", "<a href=""mailto:", 1, -1, 1)
		'If there is no tag shut off place a > at the end
		If InStr(1, strTempMessage, "[/EMAIL]", 1) Then
			strTempMessage = Replace(strTempMessage, "[/EMAIL]", "</a>", 1, -1, 1)
			strTempMessage = Replace(strTempMessage, "]", """>", 1, -1, 1)
		Else
			strTempMessage = strTempMessage & ">"
		End If


		'Place the new fromatted HTML mailto into the message string body
		strMessage = Replace(strMessage, strMessageLink, strTempMessage, 1, -1, 1)
	Loop




	'Loop through the message till all or any files are turned into HTML hyperlinks
	Do While InStr(1, strMessage, "[FILE=", 1) > 0 AND InStr(1, strMessage, "[/FILE]", 1) > 0

		'Find the start position in the message of the [FILE= code
		lngStartPos = InStr(1, strMessage, "[FILE=", 1)

		'Find the position in the message for the [/FILE] closing code
		lngEndPos = InStr(lngStartPos, strMessage, "[/FILE]", 1) + 7

		'Make sure the end position is not in error
		If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 8

		'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, "[FILE=", "<a target=""_blank"" href=""", 1, -1, 1)
		'If there is no tag shut off place a > at the end
		If InStr(1, strTempMessage, "[/FILE]", 1) Then
			strTempMessage = Replace(strTempMessage, "[/FILE]", "</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 font colour codes are turned into fonts colours
	Do While InStr(1, strMessage, "[COLOR=", 1) > 0  AND InStr(1, strMessage, "[/COLOR]", 1) > 0

		'Find the start position in the message of the [COLOR= code
		lngStartPos = InStr(1, strMessage, "[COLOR=", 1)

		'Find the position in the message for the [/COLOR] closing code
		lngEndPos = InStr(lngStartPos, strMessage, "[/COLOR]", 1) + 8

		'Make sure the end position is not in error
		If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 9

		'Read in the code to be converted into a font colour from the message
		strMessageLink = Trim(Mid(strMessage, lngStartPos, (lngEndPos - lngStartPos)))

		'Place the message colour into the tempoary message variable
		strTempMessage = strMessageLink

		'Format the link into an font colour HTML tag
		strTempMessage = Replace(strTempMessage, "[COLOR=", "<font color=", 1, -1, 1)
		'If there is no tag shut off place a > at the end
		If InStr(1, strTempMessage, "[/COLOR]", 1) Then
			strTempMessage = Replace(strTempMessage, "[/COLOR]", "</font>", 1, -1, 1)
			strTempMessage = Replace(strTempMessage, "]", ">", 1, -1, 1)
		Else
			strTempMessage = strTempMessage & ">"
		End If

		'Place the new fromatted colour HTML tag into the message string body
		strMessage = Replace(strMessage, strMessageLink, strTempMessage, 1, -1, 1)
	Loop
	
	'Hear for backward compatability with old colour codes abive
	strMessage = Replace(strMessage, "[/COLOR]", "</font>", 1, -1, 1)


	'Return the function
	FormatForumCodes = strMessage
End Function





'******************************************
'***   	   Format User Quote		***
'******************************************

'This function formats quotes that contain usernames
Function formatUserQuote(ByVal strMessage)


	'Declare variables
	Dim strQuotedAuthor 	'Holds the name of the author who is being quoted
	Dim strQuotedMessage	'Hold the quoted message
	Dim lngStartPos		'Holds search start postions
	Dim lngEndPos		'Holds end start postions
	Dim strBuildQuote	'Holds the built quoted message
	Dim strOriginalQuote	'Holds the quote in original format

	'Loop through all the quotes in the message and convert them to formated quotes
	Do While InStr(1, strMessage, "[QUOTE=", 1) > 0 AND InStr(1, strMessage, "[/QUOTE]", 1) > 0

		'Get the start and end in the message of the author who is being quoted
		lngStartPos = InStr(1, strMessage, "[QUOTE=", 1) + 7
		lngEndPos = InStr(lngStartPos, strMessage, "]", 1)

		'If there is something returned get the authors name
		If lngStartPos > 6 AND lngEndPos > 0 Then
			strQuotedAuthor = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))
		End If



		'Get the start and end in the message of the message to quote
		lngStartPos = lngStartPos + Len(strQuotedAuthor) + 1
		lngEndPos = InStr(lngStartPos, strMessage, "[/QUOTE]", 1)

		'Make sure the end position is not in error
		If lngEndPos - lngStartPos =< 0 Then lngEndPos = lngStartPos + Len(strQuotedAuthor)

		'If there is something returned get message to quote
		If lngEndPos > lngStartPos Then

			'Get the message to be quoted
			strQuotedMessage = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))

			'Srip out any perenetis for those that are use to BBcodes that are different
			strQuotedAuthor = Replace(strQuotedAuthor, """", "", 1, -1, 1)

			'Build the HTML for the displying of the quoted message
			strBuildQuote = "<table width=""95%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"">"
			strBuildQuote = strBuildQuote & vbCrLf & "<tr><td class=""bold"">" & strQuotedAuthor & " " & strTxtWrote & ":<br />"
			strBuildQuote = strBuildQuote & vbCrLf & "   <table width=""100%"" border=""0"" cellpadding=""1"" cellspacing=""0"" bgcolor=""" & strTableQuoteBorderColour & """>"
			strBuildQuote = strBuildQuote & vbCrLf & "    <tr>"
			strBuildQuote = strBuildQuote & vbCrLf & "    <td><table width=""100%"" border=""0"" cellpadding=""2"" cellspacing=""0"" bgcolor=""" & strTableQuoteColour & """>"
			strBuildQuote = strBuildQuote & vbCrLf & "      <tr>"
			strBuildQuote = strBuildQuote & vbCrLf & "       <td class=""text"">" & strQuotedMessage & "</td>"
			strBuildQuote = strBuildQuote & vbCrLf & "      </tr>"
			strBuildQuote = strBuildQuote & vbCrLf & "     </table></td>"
			strBuildQuote = strBuildQuote & vbCrLf & "   </tr>"
			strBuildQuote = strBuildQuote & vbCrLf & "  </table></td>"
			strBuildQuote = strBuildQuote & vbCrLf & "</tr>"
			strBuildQuote = strBuildQuote & vbCrLf & "</table>"
		End If



		'Get the start and end position in the start and end position in the message of the quote
		lngStartPos = InStr(1, strMessage, "[QUOTE=", 1)
		lngEndPos = InStr(lngStartPos, strMessage, "[/QUOTE]", 1) + 8

		'Make sure the end position is not in error
		If lngEndPos - lngStartPos =< 7 Then lngEndPos = lngStartPos + Len(strQuotedAuthor) + 8

		'Get the original quote to be replaced in the message
		strOriginalQuote = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))

		'Replace the quote codes in the message with the new formated quote
		If strBuildQuote <> "" Then
			strMessage = Replace(strMessage, strOriginalQuote, strBuildQuote, 1, -1, 1)
		Else
			strMessage = Replace(strMessage, strOriginalQuote, Replace(strOriginalQuote, "[", "&#91;", 1, -1, 1), 1, -1, 1)
		End If
	Loop

	'Return the function
	formatUserQuote = strMessage

End Function




'******************************************
'***   	   Format Quote			***
'******************************************

'This function formats the quote
Function formatQuote(ByVal strMessage)


	'Declare variables
	Dim strQuotedMessage	'Hold the quoted message
	Dim lngStartPos		'Holds search start postions
	Dim lngEndPos		'Holds end start postions
	Dim strBuildQuote	'Holds the built quoted message
	Dim strOriginalQuote	'Holds the quote in original format

	'Loop through all the quotes in the message and convert them to formated quotes
	Do While InStr(1, strMessage, "[QUOTE]", 1) > 0 AND InStr(1, strMessage, "[/QUOTE]", 1) > 0

		'Get the start and end in the message of the author who is being quoted
		lngStartPos = InStr(1, strMessage, "[QUOTE]", 1) + 7
		lngEndPos = InStr(lngStartPos, strMessage, "[/QUOTE]", 1)

		'Make sure the end position is not in error
		If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 7

		'If there is something returned get message to quote
		If lngEndPos > lngStartPos Then

			'Get the message to be quoted
			strQuotedMessage = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))


			'Build the HTML for the displying of the quoted message
			strBuildQuote = "<table width=""95%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"">"
			strBuildQuote = strBuildQuote & vbCrLf & "<tr><td class=""bold"">" & strTxtQuote & ":<br>"
			strBuildQuote = strBuildQuote & vbCrLf & "   <table width=""100%"" border=""0"" cellpadding=""1"" cellspacing=""0"" bgcolor=""" & strTableQuoteBorderColour & """>"
			strBuildQuote = strBuildQuote & vbCrLf & "    <tr>"
			strBuildQuote = strBuildQuote & vbCrLf & "    <td><table width=""100%"" border=""0"" cellpadding=""2"" cellspacing=""0"" bgcolor=""" & strTableQuoteColour & """>"
			strBuildQuote = strBuildQuote & vbCrLf & "      <tr>"
			strBuildQuote = strBuildQuote & vbCrLf & "       <td class=""text"">" & strQuotedMessage & "</td>"
			strBuildQuote = strBuildQuote & vbCrLf & "      </tr>"
			strBuildQuote = strBuildQuote & vbCrLf & "     </table></td>"
			strBuildQuote = strBuildQuote & vbCrLf & "   </tr>"
			strBuildQuote = strBuildQuote & vbCrLf & "  </table></td>"
			strBuildQuote = strBuildQuote & vbCrLf & "</tr>"
			strBuildQuote = strBuildQuote & vbCrLf & "</table>"
		End If


		'Get the start and end position in the start and end position in the message of the quote
		lngStartPos = InStr(1, strMessage, "[QUOTE]", 1)
		lngEndPos = InStr(lngStartPos, strMessage, "[/QUOTE]", 1) + 8

		'Make sure the end position is not in error
		If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 7

		'Get the original quote to be replaced in the message
		strOriginalQuote = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))

		'Replace the quote codes in the message with the new formated quote
		If strBuildQuote <> "" Then
			strMessage = Replace(strMessage, strOriginalQuote, strBuildQuote, 1, -1, 1)
		Else
			strMessage = Replace(strMessage, strOriginalQuote, Replace(strOriginalQuote, "[", "&#91;", 1, -1, 1), 1, -1, 1)
		End If
	Loop

	'Return the function
	formatQuote = strMessage

End Function





'******************************************
'***   	   Format Code Block		***
'******************************************

'This function formats the code blocks
Function formatCode(ByVal strMessage)


	'Declare variables
	Dim strCodeMessage		'Hold the coded message
	Dim lngStartPos			'Holds search start postions
	Dim lngEndPos			'Holds end start postions
	Dim strBuildCodeBlock		'Holds the built coded message
	Dim strOriginalCodeBlock	'Holds the code block in original format

	'Loop through all the codes in the message and convert them to formated code block
	Do While InStr(1, strMessage, "[CODE]", 1) > 0 AND InStr(1, strMessage, "[/CODE]", 1) > 0