", 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]", "![]()
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=", " at the end
If InStr(1, strTempMessage, "[/URL]", 1) Then
strTempMessage = Replace(strTempMessage, "[/URL]", "", 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)
'Format the URL tages into an HTML hyperlinks
strTempMessage = "" & strTempMessage & ""
'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=", " at the end
If InStr(1, strTempMessage, "[/EMAIL]", 1) Then
strTempMessage = Replace(strTempMessage, "[/EMAIL]", "", 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=", " at the end
If InStr(1, strTempMessage, "[/FILE]", 1) Then
strTempMessage = Replace(strTempMessage, "[/FILE]", "", 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=", "", 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]", "", 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 = vbCrLf & "
"
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, "[", "[", 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 = vbCrLf & "
"
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, "[", "[", 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
'Get the start and end in the message of the author who is being coded
lngStartPos = InStr(1, strMessage, "[CODE]", 1) + 6
lngEndPos = InStr(lngStartPos, strMessage, "[/CODE]", 1)
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 6
'If there is something returned get message to code block
If lngEndPos > lngStartPos Then
'Get the message to be coded
strCodeMessage = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))
'Build the HTML for the displaying of the code
strBuildCodeBlock = vbCrLf & "
"
End If
'Get the start and end position in the start and end position in the message of the code block
lngStartPos = InStr(1, strMessage, "[CODE]", 1)
lngEndPos = InStr(lngStartPos, strMessage, "[/CODE]", 1) + 7
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 6
'Get the original code to be replaced in the message
strOriginalCodeBlock = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))
'Replace the code codes in the message with the new formated code block
If strBuildCodeBlock <> "" Then
strMessage = Replace(strMessage, strOriginalCodeBlock, strBuildCodeBlock, 1, -1, 1)
Else
strMessage = Replace(strMessage, strOriginalCodeBlock, Replace(strOriginalCodeBlock, "[", "[", 1, -1, 1), 1, -1, 1)
End If
Loop
'Return the function
formatCode = strMessage
End Function
'******************************************
'*** Format Signature ***
'******************************************
'This function formats falsh codes
Function formatSignature(ByVal strSignature)
Dim strSignatureArea
'Create signature
strSignatureArea = "" & _
vbCrLf & " " & _
vbCrLf & " ", 1) + 8
lngEndPos = InStr(1, strMessage, " ", 1)
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos
'If there is something returned get the authors name
strEditedAuthor = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))
'Get the start and end in the message of the date the message was edited
lngStartPos = InStr(1, strMessage, "", 1) + 10
lngEndPos = InStr(1, strMessage, " ", 1)
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos
'If there is something returned get the date the message was edited
dtmEditedDate = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))
'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 Then lngEndPos = lngStartPos
'If there is something returned strip the XML from the message
strMessage = Replace(strMessage, Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos)), "", 1, -1, 1)
'Place the name of the person who edited the post
If strEditedAuthor <> "" Then
'If there is a date and time display the author date and time the post was edited
If IsDate(dtmEditedDate) Then
dtmEditedDate = CDate(dtmEditedDate)
editedXMLParser = strMessage & "
" & strTxtEditBy & " " & strEditedAuthor & " - " & DateFormat(dtmEditedDate) & " " & strTxtAt & " " & TimeFormat(dtmEditedDate) & "" 'Just display the author name who edited the post Else editedXMLParser = strMessage & "
" & strTxtEditBy & " " & strEditedAuthor & "" End If End If End Function '****************************************** '*** Convert Post to Text Function *** '****************************************** 'Function to romove icons and colurs to just leave plain text Function ConvertToText(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 'Remove hyperlinks strMessage = Replace(strMessage, " target=""_blank""", "", 1, -1, 1) '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 If InStr(1, strTempMessage, "src=""", 1) Then strTempMessage = Replace(strTempMessage, "", " ", 1, -1, 1) Else strTempMessage = Replace(strTempMessage, "", 1, -1, 1) strTempMessage = Replace(strTempMessage, "", " ", 1, -1, 1) strTempMessage = Replace(strTempMessage, """>", " - ", 1, -1, 1) End If 'Place the new fromatted codes into the message string body strMessage = Replace(strMessage, strMessageLink, strTempMessage, 1, -1, 1) Loop 'Get any that may slip through (don't look as good but still has the same effect) strMessage = Replace(strMessage, "", 1) - lngMessagePosition) 'Place the HTML tag back into the tempary message store strTempMessage = strTempMessage & Mid(strMessage, lngMessagePosition, intHTMLTagLength) 'Add the length of the HTML tag to the post message position variable lngMessagePosition = lngMessagePosition + intHTMLTagLength End If 'Loop through the search words to see if they are in the message post For intHighlightLoopCounter = 0 to UBound(sarySearchWord) 'If there is a search word in the array position check it If sarySearchWord(intHighlightLoopCounter) <> "" Then 'Get the length of the search word intSearchWordLength = Len(sarySearchWord(intHighlightLoopCounter)) 'If the next XX characters are the same as the search word then highlight them If LCase(Mid(strMessage, lngMessagePosition, intSearchWordLength)) = LCase(sarySearchWord(intHighlightLoopCounter)) Then 'Highlight the search word strTempMessage = strTempMessage & "" & Mid(strMessage, lngMessagePosition, intSearchWordLength) & "" 'Add the length of the replaced search word to the post message position variable lngMessagePosition = lngMessagePosition + intSearchWordLength - 1 'Set the changed boolean to true blnTempUpdate = True End If End If Next 'If a search word is not highlighted then add the character from the post message being checked to the temp variable If blnTempUpdate = False Then strTempMessage = strTempMessage & Mid(strMessage, lngMessagePosition, 1) End If Next 'Return the function searchHighlighter = strTempMessage End Function %>
", 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]", "", 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) strMessage = Replace(strMessage, "[/FONT]", "", 1, -1, 1) 'These are for backward compatibility with old forum codes strMessage = Replace(strMessage, "[BLACK]", "", 1, -1, 1) strMessage = Replace(strMessage, "[WHITE]", "", 1, -1, 1) strMessage = Replace(strMessage, "[BLUE]", "", 1, -1, 1) strMessage = Replace(strMessage, "[RED]", "", 1, -1, 1) strMessage = Replace(strMessage, "[GREEN]", "", 1, -1, 1) strMessage = Replace(strMessage, "[YELLOW]", "", 1, -1, 1) strMessage = Replace(strMessage, "[ORANGE]", "", 1, -1, 1) strMessage = Replace(strMessage, "[BROWN]", "", 1, -1, 1) strMessage = Replace(strMessage, "[MAGENTA]", "", 1, -1, 1) strMessage = Replace(strMessage, "[CYAN]", "", 1, -1, 1) strMessage = Replace(strMessage, "[LIME GREEN]", "", 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]", "
| " & strTxtOriginallyPostedBy & " " & strQuotedAuthor & " " & strQuotedMessage & " |
| " & strQuotedMessage & " |
" & strCodeMessage & " |
" & _
vbCrLf & " " & strSignature & _
vbCrLf & "
" & _
vbCrLf & " "
'Return the function
formatSignature = strSignatureArea
End Function
'******************************************
'*** Format Flash File Support ***
'******************************************
'This function formats falsh codes
Function formatFlash(ByVal strMessage)
'Declare variables
Dim lngStartPos 'Holds search start postions
Dim lngEndPos 'Holds end start postions
Dim saryFlashAttributes 'Holds the features of the input flash file
Dim intAttrbuteLoop 'Holds the attribute loop counter
Dim strFlashWidth 'Holds the string value of the width of the Flash file
Dim intFlashWidth 'Holds the interger value of the width of the flash file
Dim strFlashHeight 'Holds the string value of the height of the Flash file
Dim intFlashHeight 'Holds the interger value of the height of the flash file
Dim strBuildFlashLink 'Holds the converted BBcode for the flash file
Dim strTempFlashMsg 'Tempoary store for the BBcode
Dim strFlashLink 'Holds the link to the flash file
'Loop through all the codes in the message and convert them to formated flash links
Do While InStr(1, strMessage, "[FLASH", 1) > 0 AND InStr(1, strMessage, "[/FLASH]", 1) > 0
'Initiliase variables
intFlashWidth = 250
intFlashHeight = 250
strFlashLink = ""
strBuildFlashLink = ""
strTempFlashMsg = ""
'Get the Flash BBcode from the message
lngStartPos = InStr(1, strMessage, "[FLASH", 1)
lngEndPos = InStr(lngStartPos, strMessage, "[/FLASH]", 1) + 8
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 6
'Get the original Flash BBcode from the message
strTempFlashMsg = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))
'Get the start and end in the message of the attributes of the Flash file
lngStartPos = InStr(1, strTempFlashMsg, "[FLASH", 1) + 6
lngEndPos = InStr(lngStartPos, strTempFlashMsg, "]", 1)
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos
'If there is something returned get the details (eg. dimensions) of the flash file
If strTempFlashMsg <> "" Then
'Place any attributes for the flash file in an array
saryFlashAttributes = Split(Trim(Mid(strTempFlashMsg, lngStartPos, lngEndPos-lngStartPos)), " ")
'Get the dimensions of the Flash file
'Loop through the array of atrributes that are for the falsh file to get the dimentions
For intAttrbuteLoop = 0 To UBound(saryFlashAttributes)
'If this is the width attribute then read in the width dimention
If InStr(1, saryFlashAttributes(intAttrbuteLoop), "WIDTH=", 1) Then
'Get the width dimention
strFlashWidth = Replace(saryFlashAttributes(intAttrbuteLoop), "WIDTH=", "", 1, -1, 1)
'Make sure we are left with a numeric number if so convert to an interger and place in an interger variable
If isNumeric(strFlashWidth) Then intFlashWidth = CInt(strFlashWidth)
End If
'If this is the height attribute then read in the height dimention
If InStr(1, saryFlashAttributes(intAttrbuteLoop), "HEIGHT=", 1) Then
'Get the height dimention
strFlashHeight = Replace(saryFlashAttributes(intAttrbuteLoop), "HEIGHT=", "", 1, -1, 1)
'Make sure we are left with a numeric number if so convert to an interger and place in an interger variable
If isNumeric(strFlashHeight) Then intFlashHeight = CInt(strFlashHeight)
End If
Next
'Get the link to the flash file
lngStartPos = InStr(1, strTempFlashMsg, "]", 1) + 1
lngEndPos = InStr(lngStartPos, strTempFlashMsg, "[/FLASH]", 1)
'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
strFlashLink = Trim(Mid(strTempFlashMsg, lngStartPos, (lngEndPos - lngStartPos)))
'Build the HTML for the displying of the flash file
If strFlashLink <> "" Then
strBuildFlashLink = ""
End If
End If
'Replace the flash codes in the message with the new formated flash link
If strBuildFlashLink <> "" Then
strMessage = Replace(strMessage, strTempFlashMsg, strBuildFlashLink, 1, -1, 1)
Else
strMessage = Replace(strMessage, strTempFlashMsg, Replace(strTempFlashMsg, "[", "[", 1, -1, 1), 1, -1, 1)
End If
Loop
'Return the function
formatFlash = strMessage
End Function
'******************************************
'*** YouTube Support ***
'******************************************
'This function formats YouTube
Function formatYouTube(ByVal strMessage)
'Declare variables
Dim strYouTubeLink 'Hold the You Tube Link
Dim lngStartPos 'Holds search start postions
Dim lngEndPos 'Holds end start postions
Dim strBuildYouTube 'Holds the built coded message
Dim strOriginalYouTube 'Holds the code block in original format
'Loop through all the BB codes in the message and convert to a link to the YouTube movie
Do While InStr(1, strMessage, "[TUBE]", 1) > 0 AND InStr(1, strMessage, "[/TUBE]", 1) > 0
'Get the start and end of the YouTube BBcode
lngStartPos = InStr(1, strMessage, "[TUBE]", 1) + 6
lngEndPos = InStr(lngStartPos, strMessage, "[/TUBE]", 1)
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 6
'If there is a YouTube link then process
If lngEndPos > lngStartPos Then
'Get the YouTube link
strYouTubeLink = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))
'Replace watch?v= with v/ for those copy and pasting links
strYouTubeLink = Replace(Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos)), "watch?v=", "v/")
'See if the YouTube link contains the whole URL or just the file name
If InStr(1, strYouTubeLink, "http://", 1) = 0 Then strYouTubeLink = "http://www.youtube.com/v/" & strYouTubeLink
'Insert youTube movie
strBuildYouTube = ""
End If
'Get the start and end position in the start and end position in the message of the BBcode YouTube
lngStartPos = InStr(1, strMessage, "[TUBE]", 1)
lngEndPos = InStr(lngStartPos, strMessage, "[/TUBE]", 1) + 7
'Make sure the end position is not in error
If lngEndPos < lngStartPos Then lngEndPos = lngStartPos + 6
'Get the original code to be replaced in the message
strOriginalYouTube = Trim(Mid(strMessage, lngStartPos, lngEndPos-lngStartPos))
'Replace the code codes in the message with the new formated code block
If strBuildYouTube <> "" Then
strMessage = Replace(strMessage, strOriginalYouTube, strBuildYouTube, 1, -1, 1)
Else
strMessage = Replace(strMessage, strOriginalYouTube, Replace(strOriginalYouTube, "[", "[", 1, -1, 1), 1, -1, 1)
End If
Loop
'Return the function
formatYouTube = strMessage
End Function
'******************************************
'*** Display edit author ***
'******************************************
'This function formats XML into the name of the author and edit date and time if a message has been edited
'XML is used so that the date can be stored as a double npresion number so that it can display the local edit time to the message reader
Function editedXMLParser(ByVal strMessage)
'Declare variables
Dim strEditedAuthor 'Holds the name of the author who is editing the post
Dim dtmEditedDate 'Holds the date the post was edited
Dim lngStartPos 'Holds search start postions
Dim lngEndPos 'Holds end start postions
'Get the start and end in the message of the author who edit the post
lngStartPos = InStr(1, strMessage, "" & strTxtEditBy & " " & strEditedAuthor & " - " & DateFormat(dtmEditedDate) & " " & strTxtAt & " " & TimeFormat(dtmEditedDate) & "" 'Just display the author name who edited the post Else editedXMLParser = strMessage & "
" & strTxtEditBy & " " & strEditedAuthor & "" End If End If End Function '****************************************** '*** Convert Post to Text Function *** '****************************************** 'Function to romove icons and colurs to just leave plain text Function ConvertToText(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 'Remove hyperlinks strMessage = Replace(strMessage, " target=""_blank""", "", 1, -1, 1) '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 If InStr(1, strTempMessage, "src=""", 1) Then strTempMessage = Replace(strTempMessage, "", " ", 1, -1, 1) Else strTempMessage = Replace(strTempMessage, "", 1, -1, 1) strTempMessage = Replace(strTempMessage, "", " ", 1, -1, 1) strTempMessage = Replace(strTempMessage, """>", " - ", 1, -1, 1) End If 'Place the new fromatted codes into the message string body strMessage = Replace(strMessage, strMessageLink, strTempMessage, 1, -1, 1) Loop 'Get any that may slip through (don't look as good but still has the same effect) strMessage = Replace(strMessage, "", 1) - lngMessagePosition) 'Place the HTML tag back into the tempary message store strTempMessage = strTempMessage & Mid(strMessage, lngMessagePosition, intHTMLTagLength) 'Add the length of the HTML tag to the post message position variable lngMessagePosition = lngMessagePosition + intHTMLTagLength End If 'Loop through the search words to see if they are in the message post For intHighlightLoopCounter = 0 to UBound(sarySearchWord) 'If there is a search word in the array position check it If sarySearchWord(intHighlightLoopCounter) <> "" Then 'Get the length of the search word intSearchWordLength = Len(sarySearchWord(intHighlightLoopCounter)) 'If the next XX characters are the same as the search word then highlight them If LCase(Mid(strMessage, lngMessagePosition, intSearchWordLength)) = LCase(sarySearchWord(intHighlightLoopCounter)) Then 'Highlight the search word strTempMessage = strTempMessage & "" & Mid(strMessage, lngMessagePosition, intSearchWordLength) & "" 'Add the length of the replaced search word to the post message position variable lngMessagePosition = lngMessagePosition + intSearchWordLength - 1 'Set the changed boolean to true blnTempUpdate = True End If End If Next 'If a search word is not highlighted then add the character from the post message being checked to the temp variable If blnTempUpdate = False Then strTempMessage = strTempMessage & Mid(strMessage, lngMessagePosition, 1) End If Next 'Return the function searchHighlighter = strTempMessage End Function %>