", 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 = ""
strBuildQuote = 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 = ""
strBuildQuote = 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))
'Format the message
strCodeMessage = Replace(strCodeMessage, " ", " ", 1, -1, 1)
strCodeMessage = Replace(strCodeMessage, " ", " ", 1, -1, 1)
strCodeMessage = Replace(strCodeMessage, " ", " ", 1, -1, 1)
strCodeMessage = Replace(strCodeMessage, " ", " ", 1, -1, 1)
strCodeMessage = Replace(strCodeMessage, " ", " ", 1, -1, 1)
strCodeMessage = Replace(strCodeMessage, vbTab, " ", 1, -1, 1)
strCodeMessage = Replace(strCodeMessage, chr(9), " ", 1, -1, 1)
'strCodeMessage = Replace(strCodeMessage, Chr(10), "
", 1, -1, 1) 'Build the HTML for the displying of the coded message strBuildCodeBlock = ""
strBuildCodeBlock = 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 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 = 50
intFlashHeight = 50
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
'******************************************
'*** 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, "", 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))
'If it is a date then read convert it to a date otherwise set the variable to 0
If isNumeric(dtmEditedDate) Then dtmEditedDate = CDate(dtmEditedDate) Else dtmEditedDate = 0
'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 date and time into the message for when the post was edited
If strEditedAuthor <> "" Then
editedXMLParser = strMessage & "
" & strTxtEditBy & " " & strEditedAuthor & " " & strTxtOn & " " & DateFormat(dtmEditedDate, saryDateTimeData) & " " & strTxtAt & " " & TimeFormat(dtmEditedDate, saryDateTimeData) & "" 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, " <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2003 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 '** '**************************************************************************************** 'Dimension variables Dim saryEmoticons(35,3) 'If you add more emoticons increase the first number to the number of emoticons you have in the array below saryEmoticons(1,1) = "Smile" 'Emoticon Name saryEmoticons(1,2) = "[:)]" 'Forum code saryEmoticons(1,3) = "smileys/smiley1.gif" 'URL/path to smiley saryEmoticons(2,1) = "Tongue" saryEmoticons(2,2) = "[:P]" saryEmoticons(2,3) = "smileys/smiley17.gif" saryEmoticons(3,1) = "Wink" saryEmoticons(3,2) = "[;)]" saryEmoticons(3,3) = "smileys/smiley2.gif" saryEmoticons(4,1) = "Star" saryEmoticons(4,2) = "[:*:]" saryEmoticons(4,3) = "smileys/smiley10.gif" saryEmoticons(5,1) = "Shocked" saryEmoticons(5,2) = "[:o]" saryEmoticons(5,3) = "smileys/smiley3.gif" saryEmoticons(6,1) = "Dead" saryEmoticons(6,2) = "[xx(]" saryEmoticons(6,3) = "smileys/smiley11.gif" saryEmoticons(7,1) = "Big smile" saryEmoticons(7,2) = "[:D]" saryEmoticons(7,3) = "smileys/smiley4.gif" saryEmoticons(8,1) = "Sleepy" saryEmoticons(8,2) = "[|)]" saryEmoticons(8,3) = "smileys/smiley12.gif" saryEmoticons(9,1) = "Confused" saryEmoticons(9,2) = "[:s]" saryEmoticons(9,3) = "smileys/smiley5.gif" saryEmoticons(10,1) = "Unhappy" saryEmoticons(10,2) = "[:(]" saryEmoticons(10,3) = "smileys/smiley6.gif" saryEmoticons(11,1) = "Cry" saryEmoticons(11,2) = "[:^(]" saryEmoticons(11,3) = "smileys/smiley19.gif" saryEmoticons(12,1) = "Approve" saryEmoticons(12,2) = "[:^:]" saryEmoticons(12,3) = "smileys/smiley14.gif" saryEmoticons(13,1) = "Cool" saryEmoticons(13,2) = "[8D]" saryEmoticons(13,3) = "smileys/smiley16.gif" saryEmoticons(14,1) = "Angry" saryEmoticons(14,2) = "[:x]" saryEmoticons(14,3) = "smileys/smiley7.gif" saryEmoticons(15,1) = "Clown" saryEmoticons(15,2) = "[:o)]" saryEmoticons(15,3) = "smileys/smiley8.gif" saryEmoticons(16,1) = "Ouch" saryEmoticons(16,2) = "[8(]" saryEmoticons(16,3) = "smileys/smiley18.gif" saryEmoticons(17,1) = "Embarrassed" saryEmoticons(17,2) = "[:$]" saryEmoticons(17,3) = "smileys/smiley9.gif" saryEmoticons(18,1) = "Evil Smile" saryEmoticons(18,2) = "[}:)]" saryEmoticons(18,3) = "smileys/smiley15.gif" saryEmoticons(19,1) = "Disapprove" saryEmoticons(19,2) = "[:V:]" saryEmoticons(19,3) = "smileys/smiley13.gif" saryEmoticons(20,1) = "Stern Smile" saryEmoticons(20,2) = "[:|]" saryEmoticons(20,3) = "smileys/smiley22.gif" saryEmoticons(21,1) = "Thumbs Up" saryEmoticons(21,2) = "[:Y:]" saryEmoticons(21,3) = "smileys/smiley20.gif" saryEmoticons(22,1) = "Thumbs Down" saryEmoticons(22,2) = "[:N:]" saryEmoticons(22,3) = "smileys/smiley21.gif" saryEmoticons(23,1) = "Geek" saryEmoticons(23,2) = "[:-B]" saryEmoticons(23,3) = "smileys/smiley23.gif" saryEmoticons(24,1) = "Ermm" saryEmoticons(24,2) = "[:[]" saryEmoticons(24,3) = "smileys/smiley24.gif" saryEmoticons(25,1) = "Question" saryEmoticons(25,2) = "[:?:]" saryEmoticons(25,3) = "smileys/smiley25.gif" saryEmoticons(26,1) = "Pinch" saryEmoticons(26,2) = "[><]" saryEmoticons(26,3) = "smileys/smiley26.gif" saryEmoticons(27,1) = "Heart" saryEmoticons(27,2) = "[L]" saryEmoticons(27,3) = "smileys/smiley27.gif" saryEmoticons(28,1) = "Broken Heart" saryEmoticons(28,2) = "[%(]" saryEmoticons(28,3) = "smileys/smiley28.gif" saryEmoticons(29,1) = "Wacko" saryEmoticons(29,2) = "[8-}]" saryEmoticons(29,3) = "smileys/smiley29.gif" saryEmoticons(30,1) = "Pig" saryEmoticons(30,2) = "[:@)]" saryEmoticons(30,3) = "smileys/smiley30.gif" saryEmoticons(31,1) = "Hug" saryEmoticons(31,2) = "[>:D<]" saryEmoticons(31,3) = "smileys/smiley31.gif" saryEmoticons(32,1) = "Clap" saryEmoticons(32,2) = "[=D>]" saryEmoticons(32,3) = "smileys/smiley32.gif" saryEmoticons(33,1) = "Ying Yang" saryEmoticons(33,2) = "[%]" saryEmoticons(33,3) = "smileys/smiley33.gif" saryEmoticons(34,1) = "Grabbing Hand" saryEmoticons(34,2) = "[ben1]" saryEmoticons(34,3) = "smileys/smiley34.gif" saryEmoticons(35,1) = "Hitchhiker" saryEmoticons(35,2) = "[ben2]" saryEmoticons(35,3) = "smileys/smiley35.gif" 'If you add more emoticons don't forget to increase the number in the Dim statement at the top! %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2003 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 '** '**************************************************************************************** Response.Buffer = True 'Make sure this page is not cached Response.Expires = -1 Response.ExpiresAbsolute = Now() - 2 Response.AddHeader "pragma","no-cache" Response.AddHeader "cache-control","private" Response.CacheControl = "No-Store" '****************************************** '*** Search Word Highlighter *** '****************************************** 'Function to highlight search words if coming from search page Private Function searchHighlighter(ByVal strMessage, ByVal sarySearchWord) Dim intHighlightLoopCounter 'Loop counter to loop through words and hightlight them Dim strTempMessage 'Temporary message store Dim lngMessagePosition 'Holds the message position Dim intHTMLTagLength 'Holds the length of the HTML tags Dim intSearchWordLength 'Holds the length of teh search word Dim blnTempUpdate 'Set to true if the temp message variable is updated 'Loop through each character in the post message For lngMessagePosition = 1 to Len(strMessage) 'Initilise for each pass blnTempUpdate = False 'If an HTML tag is found then move to the end of it so that no words in the HTML are highlighted If Mid(strMessage, lngMessagePosition, 1) = "<" Then 'Get the length of the HTML tag intHTMLTagLength = (InStr(lngMessagePosition, 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 'Dimension variables Dim rsTopic 'Holds the Database Recordset Variable for the topic details Dim rsPost 'Holds the database recordset variable for the thread Dim intForumID 'Holds the forum ID number Dim strForumName 'Holds the forum name Dim lngTopicID 'Holds the topic number Dim strSubject 'Holds the topic subject Dim strUsername 'Holds the Username of the thread Dim lngUserID 'Holds the ID number of the user Dim dtmTopicDate 'Holds the date the thread was made Dim strMessage 'Holds the message body of the thread Dim lngMessageID 'Holds the message ID number Dim strAuthorHomepage 'Holds the homepage of the Username if it is given Dim strAuthorLocation 'Holds the location of the user if given Dim strAuthorAvatar 'Holds the authors avatar Dim strAuthorSignature 'Holds the authors signature Dim lngAuthorNumOfPosts 'Holds the number of posts the user has made to the forum Dim dtmAuthorRegistration 'Holds the registration date of the user Dim lngNumberOfViews 'Holds the number of times the topic has been viewed to save back to the database Dim intStatus 'Holds the users interger status Dim strStatus 'Holds the users status Dim strMode 'Holds the mode of the page that is being passed Dim intTopicPageNumber 'Holds the topic page position to link back to Dim blnNoThread 'Set to true if there is no thread to view Dim blnIsModerator 'Set to true if the user who posted the message is a forum moderator Dim blnForumLocked 'Set to true if the forum is locked Dim blnTopicLocked 'set to true if the topic is locked Dim intThreadNo 'Holds the number of threads in the topic Dim intPriority 'Holds the priority level of the topic Dim strPostPage 'Holds the page the form is posted to Dim intRecordPositionPageNum 'Holds the recorset page number to show the Threads for Dim intTotalNumOfPages 'Holds the number of pages Dim intRecordLoopCounter 'Holds the loop counter numeber Dim intTopicPageLoopCounter 'Loop counter for other thread page link Dim intTotalNumOfThreads 'Holds the total number of therads in this topic Dim strAuthorIP 'Holds the authors IP Dim strSearchKeywords 'Holds the keywords to search for Dim sarySearchWord 'Array to hold the search words Dim strGroupName 'Holds the authors group name Dim intRankStars 'Holds the number of stars for the group Dim strRankCustomStars 'Holds custom stars for the user group Dim lngPollID 'Holds the poll ID Dim blnPollNoReply 'Set to true if users can't reply to a poll Dim blnBannedIP 'Set to true if the user is using a banned IP Dim dtmLastEntryDate 'Holds the date of the last post entry to the topic Dim intIndexPosition 'Holds the idex poistion in the emiticon array Dim intNumberOfOuterLoops 'Holds the outer loop number for rows Dim intLoop 'Holds the loop index position Dim intInnerLoop 'Holds the inner loop number for columns Dim strMemberTitle 'Holds the members title Dim blnTopicWatched 'Set to true if this topic is being watched 'Initialise variables strMode = "reply" lngMessageID = 0 intForumID = 0 lngTopicID = 0 intThreadNo = 0 blnNoThread = False blnIsModerator = False blnPollNoReply = False blnBannedIP = False blnTopicWatched = False 'See if the user is using a banned IP address If bannedIP() Then 'If the user is using a banned IP then set the banned IP variable to true and active member variable to false blnBannedIP = True End If 'If this is the first time the page is displayed then the Forum Thread record position is set to page 1 If Request.QueryString("TPN") = "" Then intRecordPositionPageNum = 1 'Else the page has been displayed before so the Forum Thread record postion is set to the Record Position number Else intRecordPositionPageNum = CInt(Request.QueryString("TPN")) End If 'Read in the Topic ID for the topic to display and page number lngTopicID = CLng(Request.QueryString("TID")) intTopicPageNumber = CInt(Request.QueryString("PN")) 'If there is no Topic ID then redirect the user to the main forum page If lngTopicID = 0 Then 'Clean up Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect Response.Redirect "default.asp" End If 'Read in the keywords if comming from a search strSearchKeywords = Trim(Mid(Request.QueryString("KW"), 1, 35)) 'Split up the keywords to be searched sarySearchWord = Split(Trim(strSearchKeywords), " ") 'Get the posts from the database 'Create a record set object to the Threads held in the database Set rsPost = Server.CreateObject("ADODB.Recordset") 'Initalise the strSQL variable with an SQL statement to query the database get the thread details If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ThreadDetails @lngTopicID = " & lngTopicID Else strSQL = "SELECT " & strDbTable & "Topic.*, " & strDbTable & "Thread.*, " & strDbTable & "Author.Username, " & strDbTable & "Author.Homepage, " & strDbTable & "Author.Location, " & strDbTable & "Author.No_of_posts, " & strDbTable & "Author.Join_date, " & strDbTable & "Author.Signature, " & strDbTable & "Author.Active, " & strDbTable & "Author.Avatar, " & strDbTable & "Author.Avatar_title, " & strDbTable & "Group.Name, " & strDbTable & "Group.Stars, " & strDbTable & "Group.Custom_stars " strSQL = strSQL & "FROM " & strDbTable & "Topic, " & strDbTable & "Thread, " & strDbTable & "Author, " & strDbTable & "Group " strSQL = strSQL & "WHERE " & strDbTable & "Topic.Topic_ID = " & strDbTable & "Thread.Topic_ID AND " & strDbTable & "Author.Author_ID = " & strDbTable & "Thread.Author_ID AND " & strDbTable & "Author.Group_ID = " & strDbTable & "Group.Group_ID AND " & strDbTable & "Topic.Topic_ID = " & lngTopicID & " " strSQL = strSQL & "ORDER BY " & strDbTable & "Thread.Message_date ASC;" End If 'Set the cursor type property of the record set to dynamic so we can naviagate through the record set rsPost.CursorType = 1 'Query the database rsPost.Open strSQL, adoCon 'Set the number of records to display on each page rsPost.PageSize = intThreadsPerPage 'If there is no topic in the database then display the appropraite mesasage If rsPost.EOF Then 'If there are no thread's to display then display the appropriate error message strSubject = strTxtNoThreads blnNoThread = True 'Else there are records returned by the database Else 'Count the number of pages there are in the recordset calculated by the PageSize attribute set by admin intTotalNumOfPages = rsPost.PageCount 'Get the total amount of threads in the topic intTotalNumOfThreads = rsPost.RecordCount 'Get the record poistion to display from 'If the page number to show from is higher than the last page number then the last page number is the highers page If (intRecordPositionPageNum > intTotalNumOfPages) OR (Request.QueryString("get") = "last") Then 'Set the page number to show from rsPost.AbsolutePage = intTotalNumOfPages 'Set the page position number to the highest page number intRecordPositionPageNum = intTotalNumOfPages 'Else the page number to show from is the requested page number Else rsPost.AbsolutePage = intRecordPositionPageNum End If 'Read in the number of views for the page form the database lngNumberOfViews = CLng(rsPost("No_of_views")) 'Add 1 to the number of views the Topic has had lngNumberOfViews = lngNumberOfViews + 1 'Write the number of times the Topic has been viewed back to the database 'Initalise the strSQL variable with the SQL string If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "UpdateViewPostCount @lngNumberOfViews = " & lngNumberOfViews & ", @lngTopicID= " & lngTopicID Else strSQL = "UPDATE " & strDbTable & "Topic SET " strSQL = strSQL & "" & strDbTable & "Topic.No_of_views=" & lngNumberOfViews strSQL = strSQL & " WHERE (((" & strDbTable & "Topic.Topic_ID)=" & lngTopicID & "));" End If 'Write to the database adoCon.Execute(strSQL) 'Read in the thread subject forum ID and where the topic is locked intForumID = Cint(rsPost("Forum_ID")) lngPollID = CLng(rsPost("Poll_ID")) strSubject = rsPost("Subject") blnTopicLocked = CBool(rsPost("Locked")) intPriority = CInt(rsPost("Priority")) dtmLastEntryDate = CDate(rsPost("Last_entry_date")) 'If this is a unread new post set a cookie so that it is not shown as a new post If(CDate(Session("dtmLastVisit")) < dtmLastEntryDate) AND (Request.Cookies("RT" & lngTopicID) = "") Then Response.Cookies("RT")("TID" & lngTopicID) = 1 End If End If 'If this is a top priority post across all forums then read in teh forum ID form the querystring and ingnore the real topic forum ID If Request.QueryString("PR") = "3" Then intForumID = Cint(Request.QueryString("FID")) 'Create a recordset to get the forum details Set rsTopic = Server.CreateObject("ADODB.Recordset") 'Read in the forum name and forum permssions from the database 'Initalise the strSQL variable with an SQL statement to query the database If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ForumsAllWhereForumIs @intForumID = " & intForumID Else strSQL = "SELECT " & strDbTable & "Forum.* FROM " & strDbTable & "Forum WHERE " & strDbTable & "Forum.Forum_ID = " & intForumID & ";" End If 'Query the database rsTopic.Open strSQL, adoCon 'If there is a record returned by the recordset then check to see if you need a password to enter it If NOT rsTopic.EOF Then 'Read in forum details from the database strForumName = rsTopic("Forum_name") 'Read in wether the forum is locked or not blnForumLocked = CBool(rsTopic("Locked")) 'Check the user is welcome in this forum Call forumPermisisons(intForumID, intGroupID, CInt(rsTopic("Read")), CInt(rsTopic("Post")), CInt(rsTopic("Reply_posts")), CInt(rsTopic("Edit_posts")), CInt(rsTopic("Delete_posts")), 0, CInt(rsTopic("Poll_create")), CInt(rsTopic("Vote")), CInt(rsTopic("Attachments")), CInt(rsTopic("Image_upload"))) 'If the user has no read writes then kick them If blnRead = False Then 'Reset Server Objects rsPost.Close Set rsPost = Nothing rsTopic.Close Set rsTopic = Nothing Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect to a page asking for the user to enter the forum password Response.Redirect "insufficient_permission.asp" End If 'If the forum requires a password and a logged in forum code is not found on the users machine then send them to a login page If rsTopic("Password") <> "" AND Request.Cookies(strCookieName)("Forum" & intForumID) <> rsTopic("Forum_code") Then 'Reset Server Objects rsPost.Close Set rsPost = Nothing rsTopic.Close Set rsTopic = Nothing Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect to a page asking for the user to enter the forum password Response.Redirect "forum_password_form.asp?RP=PT&FID=" & intForumID & "&TID=" & lngTopicID End If End If 'Write the HTML head of the page Response.Write("" & _ vbCrLf & "" & _ vbCrLf & "" & strMainForumName & ": " & strSubject & " " & _
vbCrLf & "" & _
vbCrLf & vbCrLf & "" & _
vbCrLf & vbCrLf & "")
%>
<%
Response.Write(vbCrLf & "" & _
vbCrLf & "
" & _
vbCrLf & " " & _
vbCrLf & "
")
'If there is a poll then display the poll include
If lngPollID > 0 Then
%> <%
'****************************************************************************************
'** Copyright Notice
'**
'** Web Wiz Guide - Web Wiz Forums
'**
'** Copyright 2001-2003 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
'**
'****************************************************************************************
'Declare variables
Dim strPollQuestion 'Holds the poll question
Dim intPollChoiceNumber 'Holds the poll choice number
Dim strPollChoice 'Holds the poll choice
Dim lngPollChoiceVotes 'Holds the choice number of votes
Dim lngTotalPollVotes 'Holds the total number of votes
Dim dblPollVotePercentage 'Holds the vote percentage for the vote choice
Dim lngLastVoteUserID 'Holds the IP address of the voter
Dim blnAlreadyVoted 'Set to true if the user has already voted
Dim blnMultipleVotes 'set to true if multiple votes are allowed
'Initlise variables
blnAlreadyVoted = False
'Get the poll from the database
'Initalise the strSQL variable with an SQL statement to query the database get the thread details
If strDatabaseType = "SQLServer" Then
strSQL = "EXECUTE " & strDbProc & "PollDetails @lngPollID = " & lngPollID
Else
strSQL = "SELECT " & strDbTable & "Poll.*, " & strDbTable & "PollChoice.* "
strSQL = strSQL & "FROM " & strDbTable & "Poll INNER JOIN " & strDbTable & "PollChoice ON " & strDbTable & "Poll.Poll_ID = " & strDbTable & "PollChoice.Poll_ID "
strSQL = strSQL & "WHERE (((" & strDbTable & "Poll.Poll_ID)=" & lngPollID & "));"
End If
'Query the database
rsCommon.Open strSQL, adoCon
'If there is a poll then display it
If NOT rsCommon.EOF Then
'Read in the poll question
strPollQuestion = rsCommon("Poll_question")
'Read the last voters ID
lngLastVoteUserID = rsCommon("Author_ID")
'See if multiple votes are allowed
blnMultipleVotes = CBool(rsCommon("Multiple_votes"))
'See if this is a poll only
blnPollNoReply = CBool(rsCommon("Reply"))
'If multiple votes are not allowed see if the user has voted before
If blnMultipleVotes = False Then
'Check to see if the last voted ID matches the ID of the current user unless the user is using the guest account
If lngLastVoteUserID = lngLoggedInUserID AND lngLoggedInUserID <> 2 Then blnAlreadyVoted = True
'Check the user has not already voted by reading in a cookie from there system
'Read in the Poll ID number of the last poll the user has voted in
If CInt(Request.Cookies(strCookieName)("PID" & lngPollID)) = lngPollID Then blnAlreadyVoted = True
End If
'Loop through and get the total number of votes
Do While NOT rsCommon.EOF
'Get the total number of votes
lngTotalPollVotes = lngTotalPollVotes + rsCommon("Votes")
'Move to the next record
rsCommon.MoveNext
Loop
'Go back to the begining of the recordset
rsCommon.MoveFirst
%>
<% End If 'Clean up rsCommon.Close 'Display a msg letting the user know if there vote has been cast or not Select Case Request.QueryString("RN") Case "1" Response.Write("") Case "2" Response.Write("") End Select %><% End If 'If there are threads display them If NOT rsPost.EOF Then 'Check to see if user is watching this topic or not If blnEmail AND intGroupID <> 2 Then 'Initalise the SQL string with a query to see if this person is watching the topic If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "TopicEmailNotify @lngAuthorID = " & lngLoggedInUserID & ", @lngTopicID= " & lngTopicID Else strSQL = "SELECT " & strDbTable & "EmailNotify.* " strSQL = strSQL & "FROM " & strDbTable & "EmailNotify " strSQL = strSQL & "WHERE " & strDbTable & "EmailNotify.Author_ID=" & lngLoggedInUserID & " AND " & strDbTable & "EmailNotify.Topic_ID=" & lngTopicID & ";" End If 'Query the database rsTopic.Open strSQL, adoCon 'If a record is return the user is watching this topic If NOT rsTopic.EOF Then blnTopicWatched = True blnReplyNotify = True End If 'Clean up rsTopic.Close End If 'Create the HTML for the top of the table Response.Write("" & _
vbCrLf & "
" & _
vbCrLf & "
" & _ vbCrLf & "
", 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]", "
| " & strQuotedAuthor & " " & strTxtWrote & ": " strBuildQuote = strBuildQuote & vbCrLf & "
| "
strBuildQuote = strBuildQuote & vbCrLf & "
| " & strTxtQuote & ": " strBuildQuote = strBuildQuote & vbCrLf & "
| "
strBuildQuote = strBuildQuote & vbCrLf & "
", 1, -1, 1) 'Build the HTML for the displying of the coded message strBuildCodeBlock = "
| " & strTxtCode & ": " strBuildCodeBlock = strBuildCodeBlock & vbCrLf & "
| "
strBuildCodeBlock = strBuildCodeBlock & vbCrLf & "
" & strTxtEditBy & " " & strEditedAuthor & " " & strTxtOn & " " & DateFormat(dtmEditedDate, saryDateTimeData) & " " & strTxtAt & " " & TimeFormat(dtmEditedDate, saryDateTimeData) & "" 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, " <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2003 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 '** '**************************************************************************************** 'Dimension variables Dim saryEmoticons(35,3) 'If you add more emoticons increase the first number to the number of emoticons you have in the array below saryEmoticons(1,1) = "Smile" 'Emoticon Name saryEmoticons(1,2) = "[:)]" 'Forum code saryEmoticons(1,3) = "smileys/smiley1.gif" 'URL/path to smiley saryEmoticons(2,1) = "Tongue" saryEmoticons(2,2) = "[:P]" saryEmoticons(2,3) = "smileys/smiley17.gif" saryEmoticons(3,1) = "Wink" saryEmoticons(3,2) = "[;)]" saryEmoticons(3,3) = "smileys/smiley2.gif" saryEmoticons(4,1) = "Star" saryEmoticons(4,2) = "[:*:]" saryEmoticons(4,3) = "smileys/smiley10.gif" saryEmoticons(5,1) = "Shocked" saryEmoticons(5,2) = "[:o]" saryEmoticons(5,3) = "smileys/smiley3.gif" saryEmoticons(6,1) = "Dead" saryEmoticons(6,2) = "[xx(]" saryEmoticons(6,3) = "smileys/smiley11.gif" saryEmoticons(7,1) = "Big smile" saryEmoticons(7,2) = "[:D]" saryEmoticons(7,3) = "smileys/smiley4.gif" saryEmoticons(8,1) = "Sleepy" saryEmoticons(8,2) = "[|)]" saryEmoticons(8,3) = "smileys/smiley12.gif" saryEmoticons(9,1) = "Confused" saryEmoticons(9,2) = "[:s]" saryEmoticons(9,3) = "smileys/smiley5.gif" saryEmoticons(10,1) = "Unhappy" saryEmoticons(10,2) = "[:(]" saryEmoticons(10,3) = "smileys/smiley6.gif" saryEmoticons(11,1) = "Cry" saryEmoticons(11,2) = "[:^(]" saryEmoticons(11,3) = "smileys/smiley19.gif" saryEmoticons(12,1) = "Approve" saryEmoticons(12,2) = "[:^:]" saryEmoticons(12,3) = "smileys/smiley14.gif" saryEmoticons(13,1) = "Cool" saryEmoticons(13,2) = "[8D]" saryEmoticons(13,3) = "smileys/smiley16.gif" saryEmoticons(14,1) = "Angry" saryEmoticons(14,2) = "[:x]" saryEmoticons(14,3) = "smileys/smiley7.gif" saryEmoticons(15,1) = "Clown" saryEmoticons(15,2) = "[:o)]" saryEmoticons(15,3) = "smileys/smiley8.gif" saryEmoticons(16,1) = "Ouch" saryEmoticons(16,2) = "[8(]" saryEmoticons(16,3) = "smileys/smiley18.gif" saryEmoticons(17,1) = "Embarrassed" saryEmoticons(17,2) = "[:$]" saryEmoticons(17,3) = "smileys/smiley9.gif" saryEmoticons(18,1) = "Evil Smile" saryEmoticons(18,2) = "[}:)]" saryEmoticons(18,3) = "smileys/smiley15.gif" saryEmoticons(19,1) = "Disapprove" saryEmoticons(19,2) = "[:V:]" saryEmoticons(19,3) = "smileys/smiley13.gif" saryEmoticons(20,1) = "Stern Smile" saryEmoticons(20,2) = "[:|]" saryEmoticons(20,3) = "smileys/smiley22.gif" saryEmoticons(21,1) = "Thumbs Up" saryEmoticons(21,2) = "[:Y:]" saryEmoticons(21,3) = "smileys/smiley20.gif" saryEmoticons(22,1) = "Thumbs Down" saryEmoticons(22,2) = "[:N:]" saryEmoticons(22,3) = "smileys/smiley21.gif" saryEmoticons(23,1) = "Geek" saryEmoticons(23,2) = "[:-B]" saryEmoticons(23,3) = "smileys/smiley23.gif" saryEmoticons(24,1) = "Ermm" saryEmoticons(24,2) = "[:[]" saryEmoticons(24,3) = "smileys/smiley24.gif" saryEmoticons(25,1) = "Question" saryEmoticons(25,2) = "[:?:]" saryEmoticons(25,3) = "smileys/smiley25.gif" saryEmoticons(26,1) = "Pinch" saryEmoticons(26,2) = "[><]" saryEmoticons(26,3) = "smileys/smiley26.gif" saryEmoticons(27,1) = "Heart" saryEmoticons(27,2) = "[L]" saryEmoticons(27,3) = "smileys/smiley27.gif" saryEmoticons(28,1) = "Broken Heart" saryEmoticons(28,2) = "[%(]" saryEmoticons(28,3) = "smileys/smiley28.gif" saryEmoticons(29,1) = "Wacko" saryEmoticons(29,2) = "[8-}]" saryEmoticons(29,3) = "smileys/smiley29.gif" saryEmoticons(30,1) = "Pig" saryEmoticons(30,2) = "[:@)]" saryEmoticons(30,3) = "smileys/smiley30.gif" saryEmoticons(31,1) = "Hug" saryEmoticons(31,2) = "[>:D<]" saryEmoticons(31,3) = "smileys/smiley31.gif" saryEmoticons(32,1) = "Clap" saryEmoticons(32,2) = "[=D>]" saryEmoticons(32,3) = "smileys/smiley32.gif" saryEmoticons(33,1) = "Ying Yang" saryEmoticons(33,2) = "[%]" saryEmoticons(33,3) = "smileys/smiley33.gif" saryEmoticons(34,1) = "Grabbing Hand" saryEmoticons(34,2) = "[ben1]" saryEmoticons(34,3) = "smileys/smiley34.gif" saryEmoticons(35,1) = "Hitchhiker" saryEmoticons(35,2) = "[ben2]" saryEmoticons(35,3) = "smileys/smiley35.gif" 'If you add more emoticons don't forget to increase the number in the Dim statement at the top! %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2003 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 '** '**************************************************************************************** Response.Buffer = True 'Make sure this page is not cached Response.Expires = -1 Response.ExpiresAbsolute = Now() - 2 Response.AddHeader "pragma","no-cache" Response.AddHeader "cache-control","private" Response.CacheControl = "No-Store" '****************************************** '*** Search Word Highlighter *** '****************************************** 'Function to highlight search words if coming from search page Private Function searchHighlighter(ByVal strMessage, ByVal sarySearchWord) Dim intHighlightLoopCounter 'Loop counter to loop through words and hightlight them Dim strTempMessage 'Temporary message store Dim lngMessagePosition 'Holds the message position Dim intHTMLTagLength 'Holds the length of the HTML tags Dim intSearchWordLength 'Holds the length of teh search word Dim blnTempUpdate 'Set to true if the temp message variable is updated 'Loop through each character in the post message For lngMessagePosition = 1 to Len(strMessage) 'Initilise for each pass blnTempUpdate = False 'If an HTML tag is found then move to the end of it so that no words in the HTML are highlighted If Mid(strMessage, lngMessagePosition, 1) = "<" Then 'Get the length of the HTML tag intHTMLTagLength = (InStr(lngMessagePosition, 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 'Dimension variables Dim rsTopic 'Holds the Database Recordset Variable for the topic details Dim rsPost 'Holds the database recordset variable for the thread Dim intForumID 'Holds the forum ID number Dim strForumName 'Holds the forum name Dim lngTopicID 'Holds the topic number Dim strSubject 'Holds the topic subject Dim strUsername 'Holds the Username of the thread Dim lngUserID 'Holds the ID number of the user Dim dtmTopicDate 'Holds the date the thread was made Dim strMessage 'Holds the message body of the thread Dim lngMessageID 'Holds the message ID number Dim strAuthorHomepage 'Holds the homepage of the Username if it is given Dim strAuthorLocation 'Holds the location of the user if given Dim strAuthorAvatar 'Holds the authors avatar Dim strAuthorSignature 'Holds the authors signature Dim lngAuthorNumOfPosts 'Holds the number of posts the user has made to the forum Dim dtmAuthorRegistration 'Holds the registration date of the user Dim lngNumberOfViews 'Holds the number of times the topic has been viewed to save back to the database Dim intStatus 'Holds the users interger status Dim strStatus 'Holds the users status Dim strMode 'Holds the mode of the page that is being passed Dim intTopicPageNumber 'Holds the topic page position to link back to Dim blnNoThread 'Set to true if there is no thread to view Dim blnIsModerator 'Set to true if the user who posted the message is a forum moderator Dim blnForumLocked 'Set to true if the forum is locked Dim blnTopicLocked 'set to true if the topic is locked Dim intThreadNo 'Holds the number of threads in the topic Dim intPriority 'Holds the priority level of the topic Dim strPostPage 'Holds the page the form is posted to Dim intRecordPositionPageNum 'Holds the recorset page number to show the Threads for Dim intTotalNumOfPages 'Holds the number of pages Dim intRecordLoopCounter 'Holds the loop counter numeber Dim intTopicPageLoopCounter 'Loop counter for other thread page link Dim intTotalNumOfThreads 'Holds the total number of therads in this topic Dim strAuthorIP 'Holds the authors IP Dim strSearchKeywords 'Holds the keywords to search for Dim sarySearchWord 'Array to hold the search words Dim strGroupName 'Holds the authors group name Dim intRankStars 'Holds the number of stars for the group Dim strRankCustomStars 'Holds custom stars for the user group Dim lngPollID 'Holds the poll ID Dim blnPollNoReply 'Set to true if users can't reply to a poll Dim blnBannedIP 'Set to true if the user is using a banned IP Dim dtmLastEntryDate 'Holds the date of the last post entry to the topic Dim intIndexPosition 'Holds the idex poistion in the emiticon array Dim intNumberOfOuterLoops 'Holds the outer loop number for rows Dim intLoop 'Holds the loop index position Dim intInnerLoop 'Holds the inner loop number for columns Dim strMemberTitle 'Holds the members title Dim blnTopicWatched 'Set to true if this topic is being watched 'Initialise variables strMode = "reply" lngMessageID = 0 intForumID = 0 lngTopicID = 0 intThreadNo = 0 blnNoThread = False blnIsModerator = False blnPollNoReply = False blnBannedIP = False blnTopicWatched = False 'See if the user is using a banned IP address If bannedIP() Then 'If the user is using a banned IP then set the banned IP variable to true and active member variable to false blnBannedIP = True End If 'If this is the first time the page is displayed then the Forum Thread record position is set to page 1 If Request.QueryString("TPN") = "" Then intRecordPositionPageNum = 1 'Else the page has been displayed before so the Forum Thread record postion is set to the Record Position number Else intRecordPositionPageNum = CInt(Request.QueryString("TPN")) End If 'Read in the Topic ID for the topic to display and page number lngTopicID = CLng(Request.QueryString("TID")) intTopicPageNumber = CInt(Request.QueryString("PN")) 'If there is no Topic ID then redirect the user to the main forum page If lngTopicID = 0 Then 'Clean up Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect Response.Redirect "default.asp" End If 'Read in the keywords if comming from a search strSearchKeywords = Trim(Mid(Request.QueryString("KW"), 1, 35)) 'Split up the keywords to be searched sarySearchWord = Split(Trim(strSearchKeywords), " ") 'Get the posts from the database 'Create a record set object to the Threads held in the database Set rsPost = Server.CreateObject("ADODB.Recordset") 'Initalise the strSQL variable with an SQL statement to query the database get the thread details If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ThreadDetails @lngTopicID = " & lngTopicID Else strSQL = "SELECT " & strDbTable & "Topic.*, " & strDbTable & "Thread.*, " & strDbTable & "Author.Username, " & strDbTable & "Author.Homepage, " & strDbTable & "Author.Location, " & strDbTable & "Author.No_of_posts, " & strDbTable & "Author.Join_date, " & strDbTable & "Author.Signature, " & strDbTable & "Author.Active, " & strDbTable & "Author.Avatar, " & strDbTable & "Author.Avatar_title, " & strDbTable & "Group.Name, " & strDbTable & "Group.Stars, " & strDbTable & "Group.Custom_stars " strSQL = strSQL & "FROM " & strDbTable & "Topic, " & strDbTable & "Thread, " & strDbTable & "Author, " & strDbTable & "Group " strSQL = strSQL & "WHERE " & strDbTable & "Topic.Topic_ID = " & strDbTable & "Thread.Topic_ID AND " & strDbTable & "Author.Author_ID = " & strDbTable & "Thread.Author_ID AND " & strDbTable & "Author.Group_ID = " & strDbTable & "Group.Group_ID AND " & strDbTable & "Topic.Topic_ID = " & lngTopicID & " " strSQL = strSQL & "ORDER BY " & strDbTable & "Thread.Message_date ASC;" End If 'Set the cursor type property of the record set to dynamic so we can naviagate through the record set rsPost.CursorType = 1 'Query the database rsPost.Open strSQL, adoCon 'Set the number of records to display on each page rsPost.PageSize = intThreadsPerPage 'If there is no topic in the database then display the appropraite mesasage If rsPost.EOF Then 'If there are no thread's to display then display the appropriate error message strSubject = strTxtNoThreads blnNoThread = True 'Else there are records returned by the database Else 'Count the number of pages there are in the recordset calculated by the PageSize attribute set by admin intTotalNumOfPages = rsPost.PageCount 'Get the total amount of threads in the topic intTotalNumOfThreads = rsPost.RecordCount 'Get the record poistion to display from 'If the page number to show from is higher than the last page number then the last page number is the highers page If (intRecordPositionPageNum > intTotalNumOfPages) OR (Request.QueryString("get") = "last") Then 'Set the page number to show from rsPost.AbsolutePage = intTotalNumOfPages 'Set the page position number to the highest page number intRecordPositionPageNum = intTotalNumOfPages 'Else the page number to show from is the requested page number Else rsPost.AbsolutePage = intRecordPositionPageNum End If 'Read in the number of views for the page form the database lngNumberOfViews = CLng(rsPost("No_of_views")) 'Add 1 to the number of views the Topic has had lngNumberOfViews = lngNumberOfViews + 1 'Write the number of times the Topic has been viewed back to the database 'Initalise the strSQL variable with the SQL string If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "UpdateViewPostCount @lngNumberOfViews = " & lngNumberOfViews & ", @lngTopicID= " & lngTopicID Else strSQL = "UPDATE " & strDbTable & "Topic SET " strSQL = strSQL & "" & strDbTable & "Topic.No_of_views=" & lngNumberOfViews strSQL = strSQL & " WHERE (((" & strDbTable & "Topic.Topic_ID)=" & lngTopicID & "));" End If 'Write to the database adoCon.Execute(strSQL) 'Read in the thread subject forum ID and where the topic is locked intForumID = Cint(rsPost("Forum_ID")) lngPollID = CLng(rsPost("Poll_ID")) strSubject = rsPost("Subject") blnTopicLocked = CBool(rsPost("Locked")) intPriority = CInt(rsPost("Priority")) dtmLastEntryDate = CDate(rsPost("Last_entry_date")) 'If this is a unread new post set a cookie so that it is not shown as a new post If(CDate(Session("dtmLastVisit")) < dtmLastEntryDate) AND (Request.Cookies("RT" & lngTopicID) = "") Then Response.Cookies("RT")("TID" & lngTopicID) = 1 End If End If 'If this is a top priority post across all forums then read in teh forum ID form the querystring and ingnore the real topic forum ID If Request.QueryString("PR") = "3" Then intForumID = Cint(Request.QueryString("FID")) 'Create a recordset to get the forum details Set rsTopic = Server.CreateObject("ADODB.Recordset") 'Read in the forum name and forum permssions from the database 'Initalise the strSQL variable with an SQL statement to query the database If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ForumsAllWhereForumIs @intForumID = " & intForumID Else strSQL = "SELECT " & strDbTable & "Forum.* FROM " & strDbTable & "Forum WHERE " & strDbTable & "Forum.Forum_ID = " & intForumID & ";" End If 'Query the database rsTopic.Open strSQL, adoCon 'If there is a record returned by the recordset then check to see if you need a password to enter it If NOT rsTopic.EOF Then 'Read in forum details from the database strForumName = rsTopic("Forum_name") 'Read in wether the forum is locked or not blnForumLocked = CBool(rsTopic("Locked")) 'Check the user is welcome in this forum Call forumPermisisons(intForumID, intGroupID, CInt(rsTopic("Read")), CInt(rsTopic("Post")), CInt(rsTopic("Reply_posts")), CInt(rsTopic("Edit_posts")), CInt(rsTopic("Delete_posts")), 0, CInt(rsTopic("Poll_create")), CInt(rsTopic("Vote")), CInt(rsTopic("Attachments")), CInt(rsTopic("Image_upload"))) 'If the user has no read writes then kick them If blnRead = False Then 'Reset Server Objects rsPost.Close Set rsPost = Nothing rsTopic.Close Set rsTopic = Nothing Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect to a page asking for the user to enter the forum password Response.Redirect "insufficient_permission.asp" End If 'If the forum requires a password and a logged in forum code is not found on the users machine then send them to a login page If rsTopic("Password") <> "" AND Request.Cookies(strCookieName)("Forum" & intForumID) <> rsTopic("Forum_code") Then 'Reset Server Objects rsPost.Close Set rsPost = Nothing rsTopic.Close Set rsTopic = Nothing Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect to a page asking for the user to enter the forum password Response.Redirect "forum_password_form.asp?RP=PT&FID=" & intForumID & "&TID=" & lngTopicID End If End If 'Write the HTML head of the page Response.Write("" & _ vbCrLf & "" & _ vbCrLf & "
| ")
'Display the forum name
Response.Write(strForumName)
'If the forum is locked show a locked pad lock icon
If blnForumLocked = True Then
Response.Write (" ( | " & _
vbCrLf & "|
| ")
'If the user is the forum admin or a moderator then give them admin functions on this topic
If blnAdmin OR blnModerator Then
Response.Write(vbCrLf & " | " & _
vbCrLf & "
<% End If 'Clean up rsCommon.Close 'Display a msg letting the user know if there vote has been cast or not Select Case Request.QueryString("RN") Case "1" Response.Write("") Case "2" Response.Write("") End Select %><% End If 'If there are threads display them If NOT rsPost.EOF Then 'Check to see if user is watching this topic or not If blnEmail AND intGroupID <> 2 Then 'Initalise the SQL string with a query to see if this person is watching the topic If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "TopicEmailNotify @lngAuthorID = " & lngLoggedInUserID & ", @lngTopicID= " & lngTopicID Else strSQL = "SELECT " & strDbTable & "EmailNotify.* " strSQL = strSQL & "FROM " & strDbTable & "EmailNotify " strSQL = strSQL & "WHERE " & strDbTable & "EmailNotify.Author_ID=" & lngLoggedInUserID & " AND " & strDbTable & "EmailNotify.Topic_ID=" & lngTopicID & ";" End If 'Query the database rsTopic.Open strSQL, adoCon 'If a record is return the user is watching this topic If NOT rsTopic.EOF Then blnTopicWatched = True blnReplyNotify = True End If 'Clean up rsTopic.Close End If 'Create the HTML for the top of the table Response.Write("
" & _
vbCrLf & "
|
" & _ vbCrLf & "
")
'Clean up
rsPost.Close
Set rsPost = Nothing
'Set up an achor
Response.Write("")
'Display a message if the users IP is banned
If blnBannedIP Then
Response.Write(vbCrLf & "
") 'See if the users browser is RTE enabled If RTEenabled() <> "false" AND blnRTEEditor AND blnWYSIWYGEditor Then 'Open the message form for RTE enabled browsers %><% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Rich Text Editor '** '** Copyright 2001-2003 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 '** '**************************************************************************************** Dim blnAbout 'Initiliase variables blnAbout = blnLCode 'The following enables and disables functions of the Rich Text Editor 'To disable or enable functions change the following to true of false Const blnBold = true Const blnUnderline = true Const blnItalic = true Const blnFontStyle = false Const blnFontType = true Const blnFontSize = true Const blnTextColour = true Const blnTextBackgroundColour = false Const blnCut = true Const blnCopy = true Const blnPaste = true Const blnUndo = true Const blnRedo = true Const blnLeftJustify = true Const blnCentre = true Const blnRightJustify = true Const blnFullJustify = false Const blnOrderList = true Const blnUnOrderList = true Const blnOutdent = true Const blnIndent = true Const blnAddHyperlink = true Const blnAddImage = true Const blnInsertTable = false Const blnHTMLView = false 'Best to leave the HTML view disabled to stop users entering malicious HTML code Const blnSpellCheck = true Const blnEmoticonPopUp = false %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2003 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 '** '**************************************************************************************** 'If a private message go to pm post message page otherwise goto post message page If strMode = "PM" Then strPostPage = "pm_post_message.asp" Else strPostPage = "post_message.asp?PN=" & Trim(Mid(Request.Form("PN"), 1, 8)) End If Response.Write(vbCrLf & "" & _ vbCrLf & "") %><% Else 'Open up the mesage form for non RTE enabled browsers %><% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2003 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 '** '**************************************************************************************** 'If a private message go to pm post message page otherwise goto post message page If strMode = "PM" Then strPostPage = "pm_post_message.asp" Else strPostPage = "post_message.asp?PN=" & Trim(Mid(Request.Form("PN"), 1, 8)) End If %> <% End If End If Response.Write(vbCrLf & "" & _
vbCrLf & "
" & _
vbCrLf & " " & _
vbCrLf & "
" & _
vbCrLf & "
") 'Clear server objects Set rsTopic = Nothing Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing '***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** If blnLCode Then If blnTextLinks Then Response.Write("Powered by Web Wiz Forums version " & strVersion & "") Else Response.Write("![]()
")
End If
Response.Write("
Copyright ©2001-2003 Web Wiz Guide") End If '***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** 'Display the process time If blnShowProcessTime Then Response.Write("
" & strTxtThisPageWasGeneratedIn & " " & FormatNumber(Timer() - dblStartTime, 4) & " " & strTxtSeconds & "") Response.Write("
")
'Display an alert message if the user is watching this topic for email notification
If Request.QueryString("EN") = "TS" Then
Response.Write("")
End If
'Display an alert message if the user is not watching this topic for email notification
If Request.QueryString("EN") = "TU" Then
Response.Write("")
End If
%>
" & strTxtSorryYouDoNotHavePerimssionToReplyIPBanned & "
") 'Display message if the users forum membership is suspended ElseIf blnActiveMember = False AND (intRecordPositionPageNum = intTotalNumOfPages) Then Response.Write(vbCrLf & "" & strTxtSorryNoReply & "
")
'If mem suspended display message
If InStr(1, strLoggedInUserCode, "N0act", vbTextCompare) Then
Response.Write(strTxtForumMemberSuspended)
'Else account not yet active
Else
Response.Write(strTxtForumMembershipNotAct)
End If
'If email is on then place a re-send activation email link
If InStr(1, strLoggedInUserCode, "N0act", vbTextCompare) = False AND blnEmailActivation AND blnLoggedInUserEmail Then Response.Write("
" & strTxtResendActivationEmail & "")
Response.Write("
" & strTxtSorryNoReply & "
" & strTxtThisForumIsLocked & "
" & strTxtSorryYouDoNotHavePerimssionToReplyToPostsInThisForum & "
") 'Display message if the topic is locked ElseIf (blnTopicLocked = True) AND (intRecordPositionPageNum = intTotalNumOfPages) Then Response.Write(vbCrLf & "" & strTxtSorryNoReply & "
" & strTxtThisTopicIsLocked & "
" & strTxtThisIsAPollOnlyYouCanNotReply & "
") 'Display message if the user is a guest or not logged in ElseIf blnReply = False AND (intRecordPositionPageNum = intTotalNumOfPages) Then Response.Write(vbCrLf & "" & strTxtPostAReplyRegister & " " & strTxtLoginSm & "
" & strTxtNeedToRegister & " " & strTxtSmRegister & "
") 'See if the users browser is RTE enabled If RTEenabled() <> "false" AND blnRTEEditor AND blnWYSIWYGEditor Then 'Open the message form for RTE enabled browsers %><% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Rich Text Editor '** '** Copyright 2001-2003 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 '** '**************************************************************************************** Dim blnAbout 'Initiliase variables blnAbout = blnLCode 'The following enables and disables functions of the Rich Text Editor 'To disable or enable functions change the following to true of false Const blnBold = true Const blnUnderline = true Const blnItalic = true Const blnFontStyle = false Const blnFontType = true Const blnFontSize = true Const blnTextColour = true Const blnTextBackgroundColour = false Const blnCut = true Const blnCopy = true Const blnPaste = true Const blnUndo = true Const blnRedo = true Const blnLeftJustify = true Const blnCentre = true Const blnRightJustify = true Const blnFullJustify = false Const blnOrderList = true Const blnUnOrderList = true Const blnOutdent = true Const blnIndent = true Const blnAddHyperlink = true Const blnAddImage = true Const blnInsertTable = false Const blnHTMLView = false 'Best to leave the HTML view disabled to stop users entering malicious HTML code Const blnSpellCheck = true Const blnEmoticonPopUp = false %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2003 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 '** '**************************************************************************************** 'If a private message go to pm post message page otherwise goto post message page If strMode = "PM" Then strPostPage = "pm_post_message.asp" Else strPostPage = "post_message.asp?PN=" & Trim(Mid(Request.Form("PN"), 1, 8)) End If Response.Write(vbCrLf & "" & _ vbCrLf & "") %><% Else 'Open up the mesage form for non RTE enabled browsers %><% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2003 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 '** '**************************************************************************************** 'If a private message go to pm post message page otherwise goto post message page If strMode = "PM" Then strPostPage = "pm_post_message.asp" Else strPostPage = "post_message.asp?PN=" & Trim(Mid(Request.Form("PN"), 1, 8)) End If %> <% End If End If Response.Write(vbCrLf & "
| ") 'Display a link to watch or un-watch this topic if email notification is enabled If blnEmail AND intGroupID <> 2 Then 'Create link Response.Write("") 'If topic is watched allow unwatch link display If blnTopicWatched Then Response.Write(strTxtUn) 'Display link to watch the topic Response.Write(strTxtWatchThisTopic & "") 'Display a non breaking space for Netscrape 4 bug Else Response.Write(" ") End If Response.Write(vbCrLf & " | " & _ vbCrLf & "")
'If the user is not suspened and can reply then have links to reply etc.
If blnReply AND blnActiveMember Then
'Only show the post reply link button on pages without the reply box as some people seem to think this button should actually post the forum!!!
If intRecordPositionPageNum <> intTotalNumOfPages Then
Response.Write (vbCrLf & " | " & _
vbCrLf & "
" & _
vbCrLf & "
| " & _
vbCrLf & " ") %><% Response.Write(" | " & _ vbCrLf & "
") 'Clear server objects Set rsTopic = Nothing Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing '***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** If blnLCode Then If blnTextLinks Then Response.Write("Powered by Web Wiz Forums version " & strVersion & "") Else Response.Write("
Copyright ©2001-2003 Web Wiz Guide") End If '***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** 'Display the process time If blnShowProcessTime Then Response.Write("
" & strTxtThisPageWasGeneratedIn & " " & FormatNumber(Timer() - dblStartTime, 4) & " " & strTxtSeconds & "") Response.Write("