| Author |
 Topic  |
|
MaGraham
Senior Member
USA
1297 Posts |
 Posted - 25 January 2014 : 02:31:07
|
Clicking on the "Bookmark" star icon and then on the "Ok" button is causing members to receive the error message below.
Microsoft OLE DB Provider for ODBC Drivers error '80040e14'
[MySQL][ODBC 5.1 Driver][mysqld-5.5.28]Unknown column 'B_TOPICID' in 'field list'
/fp/pop_user_space.asp, line 692
Here are lines 678 - 699. Any ideas as to what is causing the error message?
Function addBookmark(iMemId,sUrl,sTitle,sCat)
Dim bTmp,strSql
bTmp = False
Dim intTopicID
intTopicID = Request.QueryString("topic_id")
For i = 1 to len(chkUrl(sUrl))
If mid(chkUrl(sUrl),i,1) = "=" Then
strTopicID = mid(chkUrl(sUrl),i+1)
intTopicID = cLng(strTopicID)
End If
Next
strSql = "INSERT INTO " & strTablePrefix & "BOOKMARKS(B_URL, B_MEMBER, B_TITLE, B_CAT, B_DATE, B_TOPICID" & _
") VALUES (" & _
"'" & chkUrl(sUrl) & "', " & iMemID & ", '" & chkString(sTitle,"SQLString") & "', '" & chkString(sCat,"SQLString") & "', '" & DateToStr(strForumTimeAdjust) & "', " & intTopicID & ")"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If Err.Description <> "" Then
getErrMsg "There was an error = " & Err.Description
Else
bTmp = True
End If
addBookmark = bTmp
End Function
Here is the entire pop_user_space.asp.
<%
'###############################################################################
'##
'## Snitz Forums 2000 v3.4.07
'##
'###############################################################################
'##
'## Copyright © 2000-14 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free. You can redistribute and/or modify it under the
'## terms of the GNU General Public License as published by the Free Software
'## Foundation; either version 2 or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000 must remain intact in
'## the scripts and in the HTML output. The "powered by" text/logo with a
'## link back to http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful but
'## WITHOUT ANY WARRANTY; without even an implied warranty of MERCHANTABILITY
'## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
'## for more details.
'##
'## You should have received a copy of the GNU General Public License along
'## with this program; if not, write to:
'##
'## Free Software Foundation, Inc.
'## 59 Temple Place, Suite 330
'## Boston, MA 02111-1307
'##
'## Support can be obtained from our support forums at:
'##
'## http://forum.snitz.com
'##
'## Correspondence and marketing questions can be sent to:
'##
'## manderson@snitz.com
'##
'###############################################################################
'##
'## User Space v3.4.07
'## Author: Cripto9t
'##
'###############################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<!--#INCLUDE FILE="inc_header_short.asp"-->
<!--#INCLUDE FILE="inc_sha256.asp"-->
<%
Const blnLimit = True 'boolean holds member limits switch
Const intBookmarkMax = 100 'numeric holds max num of bookmarks a member can have
Const intFriendMax = 5000 'numeric holds max num of friends a member can have
Dim blnDel, memID, strEncodedPassword, Mode, intMode, strAction
blnDel = False
If mLev < 1 or MemberID < 1 Then
getErrMsg "You Must be logged in to view this page."
End If
strEncodedPassword = Trim(Request.Cookies(strUniqueID & "User")("Pword"))
Mode = ChkString(Trim(lCase(Request.QueryString("mode"))), "sqlstring")
If mLev > 3 and (Trim(Request.QueryString("memid")) <> "" and isNumeric(Request.QueryString("memid"))) = True Then
blnDel = True
memID = cLng(Request.QueryString("memid"))
Else
memID = MemberID
End If
Select Case Mode
Case "draft"
Call chkVariable (strUSDraftSwitch,"Drafts")
intMode = 2
Case "bookmark"
Call chkVariable (strUSBookmarkSwitch,"Bookmarks")
intMode = 3
intMax = intBookmarkMax
Case "friends"
Call chkVariable(strUSFriendSwitch,"Friends")
intMode = 4
intMax = intFriendMax
Case Else
Response.Redirect "default.asp"
End Select
Select Case intMode
Case 2
If Trim(Request.QueryString("draft_id")) <> "" and isNumeric(Request.QueryString("draft_id")) = True Then
DraftID = cLng(Request.QueryString("draft_id"))
Else
DraftID = ""
End If
If DraftID <> "" Then
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ name=""draft"" id=""draft"" method=""post"">" &vbNewLine & _
" <input type=""hidden"" name=""action"" value=""delete"">" & vbNewLine & _
" <input type=""hidden"" name=""draftid"" value=""" & DraftID & """>" & vbNewLine
If blnDel Then
Response.Write "<input type=""hidden"" name=""memid"" value=""" & memID & """>" & vbnewLine
End If
Response.Write " <p align=""center""><font color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>Are you sure you want to delete this draft?</b></font></p>" & vbNewLine & _
" <br /><input type=""Submit"" value=""Yes"" name=""draft"" id=""draft"">" & vbNewLine & _
"</form>" & vbNewLine
Else
If Trim(Request.Form("draftid")) <> "" Then
If isNumeric(Request.Form("draftid")) = True Then
DraftID = cLng(Request.Form("draftid"))
Else
getErrMsg "Do Not Edit URL to Access this Page! 1"
End If
Else
getErrMsg "Do Not Edit URL to Access this Page! 2"
End If
If mLev > 3 Then
If Trim(Request.Form("memid")) <> "" and isNumeric(Request.Form("memid")) Then
blnDel = True
memID = cLng(Request.Form("memid"))
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,2,DraftID)
memID = MemberID
End If
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,2,DraftID)
End If
If blnDel = True Then
strSql = "DELETE FROM " & strTablePrefix & "DRAFTS WHERE D_AUTHOR = " & memID & " AND DRAFT_ID = " & DraftID
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If Err.Description <> "" Then
getErrMsg "There was an error = " & Err.Description
Else
Response.Write " <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><b>Draft Deleted!</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
End If
Else
getErrMsg "You Have No Permissions to Delete this Draft!!"
End If
End If
Case 3
Dim strType
If Trim(Request.QueryString("action")) <> "" Then
strAction = Trim(lCase(Request.QueryString("action")))
If strAction = "add" Then
If chkFolderCnt(MemberID,intMax,intMode) Then
getErrMsg "Your Bookmark Folder is Currently Full.<br />Forum limits are " & intMax & " bookmarks."
End If
strType = Trim(lCase(Request.QueryString("type")))
If strType = "post" Then
If Trim(Request.QueryString("topic_id")) <> "" Then
If isNumeric(Request.QueryString("topic_id")) = True Then
Topic_ID = cLng(Request.QueryString("topic_id"))
Else
getErrMsg "Problem - not getting a numeric topic id"
End If
Else
getErrMsg "Problem - Not getting a topic id"
End If
If Trim(Request.QueryString("reply_id")) <> "" Then
If isNumeric(Request.QueryString("reply_id")) = True Then
Reply_ID = cLng(Request.QueryString("reply_id"))
Else
getErrMsg "Problem - not getting a numeric reply id"
End If
Else
Reply_ID = ""
End If
If Trim(Request.QueryString("archive")) = "true" Then
strActivePrefix = strTablePrefix & "A_"
ArchiveView = "true"
ArchiveLink = "ARCHIVE=true&"
Else
strActivePrefix = strTablePrefix
ArchiveView = ""
ArchiveLink = ""
End If
If inStr(strForumUrl,"default.asp/") Then
ForumLink = replace(strForumUrl,"default.asp/", "topic.asp")
Else
ForumLink = strForumUrl & "topic.asp"
End If
ArchiveLink = ""
PageLink = ""
AnchorLink = ""
If ArchiveView = "true" Then
ArchiveLink = "ARCHIVE=true&"
End If
If Reply_ID <> "" Then
PageLink = "whichpage=-1&"
TopicLink = "TOPIC_ID=" & Topic_ID & "&"
AnchorLink = "Reply_ID=" & Reply_ID
Else
TopicLink = "TOPIC_ID=" & Topic_ID
End If
QueryLink = "?" & ArchiveLink & PageLink & TopicLink & AnchorLink
strUrl = ForumLink & QueryLink
strSql = "SELECT T_SUBJECT, F_SUBJECT " & _
" FROM " & strActivePrefix & "TOPICS T, " & strTablePrefix & "FORUM F " & _
" WHERE TOPIC_ID = " & Topic_ID & " AND T.FORUM_ID = F.FORUM_ID"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF Then
getErrMsg "Do Not Edit the URL to gain access to this page!<br />Topic does not exist!"
Else
If Reply_ID <> "" Then
strTitle = chkString("Re-" & rs("T_SUBJECT"),"display")
Else
strTitle = chkString(rs("T_SUBJECT"),"display")
End If
ForumSubject = chkString(rs("F_SUBJECT"),"display")
rs.Close
End If
Set rs = Nothing
Else
If strType = "url" Then
strUrl = ""
strTitle = ""
Else
getErrMsg "Do Not Edit URL to access this page.<br />Type Missing."
End If
End If
strSql = "SELECT DISTINCT B_CAT FROM " & strTablePrefix & "BOOKMARKS WHERE B_MEMBER = " & MemberID & " ORDER BY B_CAT ASC;"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF Then
CatCnt = ""
Else
allCatData = rs.GetRows(adGetRowsRest)
CatCnt = UBound(allCatData,2)
rs.Close
End If
Set rs = Nothing
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ method=""post"" name=""bookmarks"" id=""bookmarks"">" & vbNewLine & _
"<input type=""hidden"" name=""action"" value=""add"">" & vbNewLine & _
" <table border=""0px"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center"" colspan=""2""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strDefaultFontColor & """><b>Bookmark</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
If strtype = "post" Then
Response.Write " <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Default Category: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""defaultcategory"" value=""" & ForumSubject & """ readonly /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
End If
If CatCnt <> "" Then
Response.Write " <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Your Categorys: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & vbNewLine & _
" <select size=""1"" name=""oldcategory"">" & vbNewLine & _
" <option value=""""></option>" & vbNewLine
NewCat = 1
For iCat = 0 to CatCnt
CatSubject = allCatData(0,iCat)
Response.Write " <option value=""" & chkString(CatSubject,"display") & """ "
If Trim(CatSubject) = Trim(ForumSubject) Then
Response.Write "selected"
NewCat = 0
End If
Response.Write ">" & chkString(CatSubject,"display") & "</option>" & vbNewLine
Next
Response.Write " </select></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
End If
Response.Write " <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>New Category: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""newcategory"" /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Title: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""title"" value=""" & strTitle & """ /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Url: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""url"" value=""" & strUrl & """"
If strType = "post" Then Response.Write "readonly"
Response.Write " /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td colspan=""2"" align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""Submit"" name=""bookmarks"" id=""bookmarks"" value="" OK "" /> <input type=""reset"" value=""Reset"" id=""reset1"" name=""reset1""></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
"</form>" & vbNewLine
Else
If strAction = "delete" Then
If Trim(Request.QueryString("id")) <> "" Then
If isNumeric(Request.QueryString("id")) = True Then
BookMark_ID = cLng(Request.QueryString("id"))
Else
getErrMsg "Do Not Edit URL to access this page.<br />BookmarkID is not numeric."
End If
Else
getErrMsg "Do Not Edit URL to access this page.<br />BookmarkID is missing."
End If
Else
getErrMsg "Do Not Edit URL to access this page.<br />Action is missing."
End If
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ name=""bookmark"" id=""bookmark"" method=""post"">" &vbNewLine & _
" <input type=""hidden"" name=""action"" value=""delete"">" & vbNewLine & _
" <input type=""hidden"" name=""id"" value=""" & Bookmark_ID & """>" & vbNewLine
If blnDel Then
Response.Write " <input type=""hidden"" name=""memid"" value=""" & memID & """>" & vbNewLine
End If
Response.Write " <p align=""center""><font color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>Are you sure you want to delete this bookmark?</b></font></p>" & vbNewLine & _
" <br /><input type=""Submit"" value=""Yes"" name=""bookmark"" id=""bookmark"">" & vbNewLine & _
"</form>" & vbNewLine
End If
Else
If Trim(Request.Form("action")) <> "" Then
strAction = Trim(lCase(Request.Form("action")))
If strAction = "add" Then
If Trim(Request.Form("url")) <> "" Then
If IsValidURL(Trim(Request.Form("url"))) Then
strUrl = Trim(Request.Form("url"))
Else
errMsg = "Invalid URL - " & strURLError
End If
Else
getErrMsg "You must enter a url."
End If
If Trim(Request.Form("title")) <> "" Then
strTitle = Trim(Request.Form("title"))
Else
getErrMsg "You must enter a title."
End If
If Trim(Request.Form("defaultcategory")) <> "" Then
strDefCat = Trim(Request.Form("defaultcategory"))
Else
strDefCat = ""
End If
If Trim(Request.Form("oldcategory")) <> "" Then
strOldCat = Trim(Request.Form("oldcategory"))
Else
strOldCat = ""
End If
If Trim(Request.Form("newcategory")) <> "" Then
strNewCat = Trim(Request.Form("newcategory"))
Else
strNewCat = ""
End If
If strNewCat <> "" Then
strCat = strNewCat
ElseIf strOldCat <> "" Then
strCat = strOldCat
Else
strCat = strDefCat
End If
If strCat = "" Then getErrMsg "You must enter a category."
If errMsg <> "" Then getErrMsg "" & errMsg & ""
If addBookmark(MemberID,strUrl,strTitle,strCat) Then
Response.Write " <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><b>Url was added to your bookmarks</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
End If
Else
If strAction = "delete" Then
If Trim(Request.Form("id")) <> "" Then
If isNumeric(Request.Form("id")) = True Then
BookmarkID = cLng(Request.Form("id"))
Else
getErrMsg "Problem - Not getting a numeric bookmark id"
End If
Else
getErrMsg "Problem - Not getting a bookmark id."
End If
If mLev > 3 Then
If Trim(Request.Form("memid")) <> "" and isNumeric(Request.Form("memid")) Then
blnDel = True
memID = cLng(Request.Form("memid"))
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,3,BookmarkID)
memID = MemberID
End If
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,3,BookmarkID)
memID = MemberID
End If
If blnDel = True Then
If delBookmark(memID,BookmarkID) Then
Response.Write " <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><b>Bookmark Deleted!</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
End If
Else
getErrMsg "You Have No Permissions to Delete this Bookmark!!"
End If
Else
getErrMsg "Do Not Edit URL to access this page.<br />Form action is not right."
End If
End If
Else
getErrMsg "Do Not Edit URL to access this page.<br />Form action is not right."
End If
End If
Case 4
If Trim(Request.QueryString("action")) <> "" Then
strAction = Trim(lCase(Request.QueryString("action")))
If Trim(Request.QueryString("id")) <> "" Then
If isNumeric(Request.QueryString("id")) = True Then
FriendID = cLng(Request.QueryString("id"))
Else
getErrMsg "Do not edit the URL to access this page"
End If
Else
getErrMsg "Do not edit the URL to access this page."
End If
Select Case strAction
Case "add"
If chkFolderCnt(MemberID,intFriendMax,intMode) Then
getErrMsg "Your Friends folder is Currently Full.<br />Forum limits are " & intMax & " friends."
End If
strInputAction = "add"
Case "delete"
strInputAction = "delete"
End Select
If strInputAction = "add" or strInputAction = "delete" Then
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ method=""post"" name=""friends"" id=""friends"">" & vbNewLine & _
"<input type=""hidden"" name=""id"" value=""" & FriendID & """ />" & vbNewLine & _
"<input type=""hidden"" name=""action"" value=""" & strInputAction & """ />" & vbNewLine
If Request.QueryString("Confirm")>"" Then Response.Write "<input type=""hidden"" name=""Confirm"" value=""1"" />"
If blnDel Then
Response.Write "<input type=""hidden"" name=""memid"" value=""" & memID & """>" & vbNewLine
End If
Response.Write " <table border=""0px"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strDefaultFontColor & """><b>Friends</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
If strInputAction = "add" Then
Response.Write " <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>"
Response.Write "<b>Level:</b> A. <input type=""radio"" name=""level"" value=""0"" checked /> B. <input type=""radio"" name=""level"" value=""1"" /> C. <input type=""radio"" name=""level"" value=""2"" /><br />"
Response.Write " </td>" & vbNewLine & _
" </tr>" & vbNewLine
End If
Response.Write " <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>" & uCase(strInputAction)
If strInputAction = "add" Then
Response.Write " to your friends list?"
Else
Response.Write " from your friends list?"
End If
Response.Write "</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""Submit"" name=""friends"" id=""friends"" value="" Confirm "" /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
"</form>" & vbNewLine
Else
getErrMsg "Do not edit the URL to access this page."
End If
Else
If Trim(Request.Form("action")) <> "" Then
strAction = Trim(lCase(Request.Form("action")))
If Trim(Request.Form("id")) <> "" and isNumeric(Request.Form("id")) = True Then
FriendID = cLng(Request.Form("id"))
Else
getErrMsg "Problem - Not getting needed form input - id."
End If
Select Case strAction
Case "add"
If MemberID = FriendID Then getErrMsg "Adding yourself to your friends list is not allowed.<br />Do not edit URL to access this page"
If Trim(Request.Form("level")) <> "" and isNumeric(Request.Form("level")) = True Then
FriendLevel = cLng(Request.Form("level"))
Else
getErrMsg "Problem - Not getting needed form input - level."
End If
strSql = "SELECT M_NAME, M_EMAIL FROM " & strMemberTablePrefix & "MEMBERS " & _
"WHERE MEMBER_ID = " & FriendID
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF or rs.BOF Then
Set rs=Nothing
getErrMsg "Member does not exist!"
Else
FriendName = rs("M_NAME")
FriendMail = rs("M_EMAIL")
rs.Close
If chkFriend(MemberID,FriendID) = True Then
If addFriend(MemberID,FriendID,FriendLevel) = True Then
getMsg FriendName & " has been added to your forum friends' folder.<br /><br /><a href=""active.asp"">Back</a><br />"
Else
getErrMsg "Friends Problem - Should not be able to get this far."
End If
End If
End If
Set rs=Nothing
Case "delete"
If mLev > 3 Then
If Trim(Request.Form("memid")) <> "" and isNumeric(Request.Form("memid")) Then
blnDel = True
memID = cLng(Request.Form("memid"))
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,4,FriendID)
memID = MemberID
End If
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,4,FriendID)
memID = MemberID
End If
strSql = "SELECT FRIEND_ID, M_NAME " & _
"FROM " & strTablePrefix & "FRIENDS, " & strMemberTablePrefix & "MEMBERS " & _
"WHERE F_MEMBER = " & memID & " AND FRIEND_ID = " & FriendID & " AND MEMBER_ID = F_FRIEND"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF or rs.BOF Then
Set rs=Nothing
getErrMsg "Either member is not in your friends' folder or member does not exist!<br /><br /><a href=""active.asp"">Community</a><br /><br />Do Not Edit URL to access this page!"
Else
fFriendID = rs("FRIEND_ID")
FriendName = rs("M_NAME")
rs.Close
If blnDel = True Then
If delFriend(memID,FriendID) = True Then
Response.Write " <p align=""center""><font size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """ face=""" & strDefaultFontFace & """><b>" & FriendName & " has been deleted from your forum friends folder.</b><br /><br /><b>Click on <font color=""#FF0000"">x</font> in top-right to close window.</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
Else
getErrMsg "Friends Problem - Should not be able to get this far."
End If
End If
End If
Set rs=Nothing
End Select
Else
getErrMsg "Do Not edit the URL to access this page.</font>"
End If
End If
Case Else
getErrMsg "Please do not edit the url to gain access to this page!!!!"
End Select
Response.Write " <p><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>Choose your friends wisely!</font></p>" & vbNewLine
WriteFooterShort
Response.End
Sub getMsg(msg)
Response.Write "<p align=""center""><font color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>" & msg & "</b></font></p>" & vbNewline
WriteFooterShort
Response.End
End Sub
Sub getErrMsg(msg)
Response.Write "<p align=""center""><font color=""" & strHiLiteFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>" & msg & "</b></font></p>" & vbNewline
WriteFooterShort
Response.End
End Sub
Function chkFolderCnt(mMemID,fMax,fType)
Dim bTmp
bTmp = False
If mLev < 3 or blnLimit = True Then
Dim strSql,rsChk
Dim strTable,strIDCol,strCol
Dim TotalFiles
Select Case cLng(fType)
Case 3
strTable = "BOOKMARKS"
strIDCol = "BOOKMARK_ID"
strCol = "B_MEMBER"
Case 4
strTable = "FRIENDS"
strIDCol = "FRIEND_ID"
strCol = "F_MEMBER"
End Select
strSql = "SELECT COUNT(" & strIDCol & ") AS TOTAL_FILES " & _
"FROM " & strTablePrefix & strTable & " " & _
"WHERE " & strCol & " = " & mMemID
Set rsChk = my_Conn.Execute (strSql)
If not rsChk.EOF Then
TotalFiles = rsChk(0).value
rsChk.Close
End If
Set rsChk = Nothing
If TotalFiles => fMax Then
bTmp = True
End If
End If
chkFolderCnt = bTmp
End Function
Function chkCanEdit(mName,mPassword,fType,fID)
Dim bTmp,strSql,rsChk
Dim strTable,strIDCol,strCol,strMsg
bTmp = False
Select Case cLng(fType)
Case 2
strTable = "DRAFTS"
strIDCol = "DRAFT_ID"
strCol = "D_AUTHOR"
Case 3
strTable = "BOOKMARKS"
strIDCol = "BOOKMARK_ID"
strCol = "B_MEMBER"
Case 4
strTable = "FRIENDS"
strIDCol = "FRIEND_ID"
strCol = "F_MEMBER"
Case Else
strMsg = "There has been an error.<br /><br /><a href=""javascript:history(-1)"">Back</a>"
If mLev > 3 Then
strMsg = strMsg & "Feature is out of range - Function chkCanEdit."
Else
strMsg = strMsg & "Please inform Amin."
End If
getErrMsg strMsg
End Select
strSql = "SELECT " & strCol & ", M.MEMBER_ID, M.M_LEVEL, M.M_NAME " & _
"FROM " & strMemberTablePrefix & "MEMBERS M, " & strTablePrefix & strTable & " " & _
"WHERE M." & strDBNTSQLName & " = '" & mName & "' "
If strAuthType="db" Then
strSql = strSql & " AND M.M_PASSWORD = '" & mPassword &"' "
End If
strSql = strSql & " AND " & strIDCol & " = " & fID & " "
strSql = strSql & " AND M.M_STATUS = " & 1
Set rsChk = my_Conn.Execute (strSql)
If not (rsChk.BOF or rsChk.EOF) Then
If cLng(rsChk("MEMBER_ID")) = cLng(rsChk(strCol)) Then
bTmp = True 'author
End If
rsChk.Close
End If
Set rsChk = Nothing
chkCanEdit = bTmp
End Function
Function IsValidURL(sValidate)
Dim sInvalidChars, bTemp, i
If Trim(sValidate) = "" Then IsValidURL = True : exit Function
sInvalidChars = """;+()*'<>"
For i = 1 To Len(sInvalidChars)
If InStr(sValidate, Mid(sInvalidChars, i, 1)) > 0 Then bTemp = True
If bTemp Then strURLError = "<br />• cannot contain any of the following characters: "" ; + ( ) * ' < > "
If bTemp Then Exit For
Next
If not bTemp Then
For i = 1 to Len(sValidate)
If Asc(Mid(sValidate, i, 1)) = 160 Then bTemp = True
If bTemp Then strURLError = "<br />• cannot contain any spaces "
If bTemp Then Exit For
Next
End If
If not bTemp Then
bTemp = (lCase(left(sValidate, 7)) <> "http://") and (lCase(left(sValidate, 8)) <> "https://")
If bTemp Then strURLError = "<br />• must begin with either http:// or https:// "
End If
If not bTemp Then
bTemp = len(sValidate) > 255
If bTemp Then strURLError = "<br />• cannot be more than 255 characters "
End If
If not bTemp Then
bTemp = InStr(sValidate, "..") > 0
If bTemp Then strURLError = "<br />• cannot contain consecutive periods "
End If
If not bTemp Then
bTemp = InStr(sValidate, " ") > 0
If bTemp Then strURLError = "<br />• cannot contain any spaces "
End If
If not bTemp Then
bTemp = (len(sValidate) <> len(Trim(sValidate)))
If bTemp Then strURLError = "<br />• cannot contain any spaces "
End If
IsValidURL = Not bTemp
End Function
Function chkUrl(fStr)
fStr = Replace(fStr,"#","#")
fStr = ChkString(fStr, "SQLString")
chkUrl = fStr
End Function
Sub chkVariable(strVar,strDesc)
If Trim(strVar) <> "" Then
If cLng(strVar) < 1 Then
If mLev > 2 Then
getErrMsg "Admin has " & strDesc & " turned off."
Else
Response.Redirect "default.asp"
End If
End If
Else
If mLev > 3 Then
getErrMsg strDesc & " could not be found in Database."
Else
Response.Redirect "default.asp"
End If
End If
End Sub
Function addBookmark(iMemId,sUrl,sTitle,sCat)
Dim bTmp,strSql
bTmp = False
Dim intTopicID
intTopicID = Request.QueryString("topic_id")
For i = 1 to len(chkUrl(sUrl))
If mid(chkUrl(sUrl),i,1) = "=" Then
strTopicID = mid(chkUrl(sUrl),i+1)
intTopicID = cLng(strTopicID)
End If
Next
strSql = "INSERT INTO " & strTablePrefix & "BOOKMARKS(B_URL, B_MEMBER, B_TITLE, B_CAT, B_DATE, B_TOPICID" & _
") VALUES (" & _
"'" & chkUrl(sUrl) & "', " & iMemID & ", '" & chkString(sTitle,"SQLString") & "', '" & chkString(sCat,"SQLString") & "', '" & DateToStr(strForumTimeAdjust) & "', " & intTopicID & ")"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If Err.Description <> "" Then
getErrMsg "There was an error = " & Err.Description
Else
bTmp = True
End If
addBookmark = bTmp
End Function
Function delBookmark(iMemID,iBookmarkID)
Dim bTmp,strSql
bTmp = False
strSql = "DELETE FROM " & strTablePrefix & "BOOKMARKS " & _
"WHERE B_MEMBER = " & iMemID & " AND BOOKMARK_ID = " & iBookmarkID
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If Err.Description <> "" Then
getErrMsg "There was an error = " & Err.Description
Else
bTmp = True
End If
delBookmark = bTmp
End Function
Function chkFriend(iMemID,iFriendID)
Dim bTemp,strSql,rsChk
bTemp = False
strSql = "SELECT F_FRIEND FROM " & strTablePrefix & "FRIENDS " & _
"WHERE F_MEMBER = " & iMemID & " AND F_FRIEND = " & iFriendID
Set rsChk = my_Conn.Execute (strSql)
If rsChk.EOF or rsChk.BOF Then
bTemp = True
chkFriend = bTemp
Set rsChk = Nothing
Else
rsChk.Close
Set rsChk = Nothing
getErrMsg "Member already exists in your friends' folder.<br /><br /><a href=""active.asp"">Community</a>"
End If
End Function
Function addFriend(iMemID,iFriendID,iLev)
Dim bTmp, strSql
bTmp = False
strSql = "INSERT INTO " & strTablePrefix & "FRIENDS " & _
"(F_MEMBER, F_FRIEND, F_LEVEL, F_DATE) VALUES " & _
"(" & iMemID & ", " & iFriendID & ", " & iLev & ", '" & DateToStr(strForumTimeAdjust) & "')"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If err.Description <> "" Then
getErrMsg err.Description, 0
Else
bTmp = True
End If
addFriend = bTmp
If strEmail = "1" Then
strRecipientsName = FriendName
strRecipients = FriendMail
strFrom = strSender
strFromName = strForumTitle
strSubject = strForumTitle & " Friends' List "
strMessage = "Hello " & FriendName & vbNewline & vbNewline
If Request("Confirm")>"" Then
strMessage = strMessage & "You received this message from " & strForumTitle & " because " & strDBNTUserName & " confirmed your request for friendship on the forums at " & strForumURL & vbNewline & vbNewline
Else
strMessage = strMessage & "You received this message from " & strForumTitle & " because " & strDBNTUserName & " wishes to befriend you on the forums at " & strForumURL & vbNewline & vbNewline
strMessage = strMessage & "To ignore " & strDBNTUserName & "'s request, simply do nothing." & vbNewline & vbNewline
strMessage = strMessage & "To confirm " & strDBNTUserName & "'s request, click on link below or copy and paste link into your browser: " & strForumURL & "pop_user_space.asp?mode=friends&Confirm=1&action=add&id=" & MemberID & vbNewline & vbNewline
strMessage = strMessage & "or, if you have already added " & strDBNTUserName & " as a friend, you can remove " & strDBNTUserName & " from your friends' list here: " & strForumURL & "pop_user_space.asp?mode=friends&action=delete&id=" & MemberID & vbNewline & vbNewline
End If
%>
<!--#INCLUDE FILE="inc_mail.asp" -->
<%
End If
End Function
Function delFriend(iMemID,iFriendID)
Dim bTmp, strSql
bTmp = False
strSql = "DELETE FROM " & strTablePrefix & "FRIENDS " & _
"WHERE F_MEMBER = " & iMemID & " AND FRIEND_ID = " & iFriendID
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If err.Description <> "" Then
getErrMsg err.Description, 0
Else
bTmp = True
End If
delFriend = bTmp
End Function
%>
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
Edited by - MaGraham on 25 January 2014 02:32:58 |
|
|
Carefree
Advanced Member
Philippines
4207 Posts |
Posted - 25 January 2014 : 03:42:32
|
An unknown column error only means one thing, don't need to look further. The field wasn't created in the database, either you ignored an error message during the dbs file process or it was left out. I suspect this was a compatibility issue with MySQL. To fix it, we'll make a stand-alone file to add the field so you don't mess up database content by re-running the original. This should do it.
"admin_btopic.asp"
|
 |
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 25 January 2014 : 05:53:52
|
That fixed it! 
You're incredible, Carefree! 
Thank you so much! 
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Carefree
Advanced Member
Philippines
4207 Posts |
Posted - 25 January 2014 : 09:35:51
|
| You're welcome. |
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 17 February 2014 : 04:17:34
|
I am now receiving a different error message when clicking on the "Bookmark" star icon and then on the "Ok" button.
Microsoft VBScript runtime error '800a000d'
Type mismatch: 'cLng'
/fp/pop_user_space.asp, line 686
Here are lines 678 - 699
Function addBookmark(iMemId,sUrl,sTitle,sCat)
Dim bTmp,strSql
bTmp = False
Dim intTopicID
intTopicID = Request.QueryString("topic_id")
For i = 1 to len(chkUrl(sUrl))
If mid(chkUrl(sUrl),i,1) = "=" Then
strTopicID = mid(chkUrl(sUrl),i+1)
intTopicID = cLng(strTopicID)
End If
Next
strSql = "INSERT INTO " & strTablePrefix & "BOOKMARKS(B_URL, B_MEMBER, B_TITLE, B_CAT, B_DATE, B_TOPICID" & _
") VALUES (" & _
"'" & chkUrl(sUrl) & "', " & iMemID & ", '" & chkString(sTitle,"SQLString") & "', '" & chkString(sCat,"SQLString") & "', '" & DateToStr(strForumTimeAdjust) & "', " & intTopicID & ")"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If Err.Description <> "" Then
getErrMsg "There was an error = " & Err.Description
Else
bTmp = True
End If
addBookmark = bTmp
End Function
Here's my entire pop_user_space.asp.
<%
'###############################################################################
'##
'## Snitz Forums 2000 v3.4.07
'##
'###############################################################################
'##
'## Copyright © 2000-14 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free. You can redistribute and/or modify it under the
'## terms of the GNU General Public License as published by the Free Software
'## Foundation; either version 2 or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000 must remain intact in
'## the scripts and in the HTML output. The "powered by" text/logo with a
'## link back to http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful but
'## WITHOUT ANY WARRANTY; without even an implied warranty of MERCHANTABILITY
'## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
'## for more details.
'##
'## You should have received a copy of the GNU General Public License along
'## with this program; if not, write to:
'##
'## Free Software Foundation, Inc.
'## 59 Temple Place, Suite 330
'## Boston, MA 02111-1307
'##
'## Support can be obtained from our support forums at:
'##
'## http://forum.snitz.com
'##
'## Correspondence and marketing questions can be sent to:
'##
'## manderson@snitz.com
'##
'###############################################################################
'##
'## User Space v3.4.07
'## Author: Cripto9t
'##
'###############################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<!--#INCLUDE FILE="inc_header_short.asp"-->
<!--#INCLUDE FILE="inc_sha256.asp"-->
<%
Const blnLimit = True 'boolean holds member limits switch
Const intBookmarkMax = 100 'numeric holds max num of bookmarks a member can have
Const intFriendMax = 5000 'numeric holds max num of friends a member can have
Dim blnDel, memID, strEncodedPassword, Mode, intMode, strAction
blnDel = False
If mLev < 1 or MemberID < 1 Then
getErrMsg "You Must be logged in to view this page."
End If
strEncodedPassword = Trim(Request.Cookies(strUniqueID & "User")("Pword"))
Mode = ChkString(Trim(lCase(Request.QueryString("mode"))), "sqlstring")
If mLev > 3 and (Trim(Request.QueryString("memid")) <> "" and isNumeric(Request.QueryString("memid"))) = True Then
blnDel = True
memID = cLng(Request.QueryString("memid"))
Else
memID = MemberID
End If
Select Case Mode
Case "draft"
Call chkVariable (strUSDraftSwitch,"Drafts")
intMode = 2
Case "bookmark"
Call chkVariable (strUSBookmarkSwitch,"Bookmarks")
intMode = 3
intMax = intBookmarkMax
Case "friends"
Call chkVariable(strUSFriendSwitch,"Friends")
intMode = 4
intMax = intFriendMax
Case Else
Response.Redirect "default.asp"
End Select
Select Case intMode
Case 2
If Trim(Request.QueryString("draft_id")) <> "" and isNumeric(Request.QueryString("draft_id")) = True Then
DraftID = cLng(Request.QueryString("draft_id"))
Else
DraftID = ""
End If
If DraftID <> "" Then
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ name=""draft"" id=""draft"" method=""post"">" &vbNewLine & _
" <input type=""hidden"" name=""action"" value=""delete"">" & vbNewLine & _
" <input type=""hidden"" name=""draftid"" value=""" & DraftID & """>" & vbNewLine
If blnDel Then
Response.Write "<input type=""hidden"" name=""memid"" value=""" & memID & """>" & vbnewLine
End If
Response.Write " <p align=""center""><font color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>Are you sure you want to delete this draft?</b></font></p>" & vbNewLine & _
" <br /><input type=""Submit"" value=""Yes"" name=""draft"" id=""draft"">" & vbNewLine & _
"</form>" & vbNewLine
Else
If Trim(Request.Form("draftid")) <> "" Then
If isNumeric(Request.Form("draftid")) = True Then
DraftID = cLng(Request.Form("draftid"))
Else
getErrMsg "Do Not Edit URL to Access this Page! 1"
End If
Else
getErrMsg "Do Not Edit URL to Access this Page! 2"
End If
If mLev > 3 Then
If Trim(Request.Form("memid")) <> "" and isNumeric(Request.Form("memid")) Then
blnDel = True
memID = cLng(Request.Form("memid"))
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,2,DraftID)
memID = MemberID
End If
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,2,DraftID)
End If
If blnDel = True Then
strSql = "DELETE FROM " & strTablePrefix & "DRAFTS WHERE D_AUTHOR = " & memID & " AND DRAFT_ID = " & DraftID
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If Err.Description <> "" Then
getErrMsg "There was an error = " & Err.Description
Else
Response.Write " <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><b>Draft Deleted!</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
End If
Else
getErrMsg "You Have No Permissions to Delete this Draft!!"
End If
End If
Case 3
Dim strType
If Trim(Request.QueryString("action")) <> "" Then
strAction = Trim(lCase(Request.QueryString("action")))
If strAction = "add" Then
If chkFolderCnt(MemberID,intMax,intMode) Then
getErrMsg "Your Bookmark Folder is Currently Full.<br />Forum limits are " & intMax & " bookmarks."
End If
strType = Trim(lCase(Request.QueryString("type")))
If strType = "post" Then
If Trim(Request.QueryString("topic_id")) <> "" Then
If isNumeric(Request.QueryString("topic_id")) = True Then
Topic_ID = cLng(Request.QueryString("topic_id"))
Else
getErrMsg "Problem - not getting a numeric topic id"
End If
Else
getErrMsg "Problem - Not getting a topic id"
End If
If Trim(Request.QueryString("reply_id")) <> "" Then
If isNumeric(Request.QueryString("reply_id")) = True Then
Reply_ID = cLng(Request.QueryString("reply_id"))
Else
getErrMsg "Problem - not getting a numeric reply id"
End If
Else
Reply_ID = ""
End If
If Trim(Request.QueryString("archive")) = "true" Then
strActivePrefix = strTablePrefix & "A_"
ArchiveView = "true"
ArchiveLink = "ARCHIVE=true&"
Else
strActivePrefix = strTablePrefix
ArchiveView = ""
ArchiveLink = ""
End If
If inStr(strForumUrl,"default.asp/") Then
ForumLink = replace(strForumUrl,"default.asp/", "topic.asp")
Else
ForumLink = strForumUrl & "topic.asp"
End If
ArchiveLink = ""
PageLink = ""
AnchorLink = ""
If ArchiveView = "true" Then
ArchiveLink = "ARCHIVE=true&"
End If
If Reply_ID <> "" Then
PageLink = "whichpage=-1&"
TopicLink = "TOPIC_ID=" & Topic_ID & "&"
AnchorLink = "Reply_ID=" & Reply_ID
Else
TopicLink = "TOPIC_ID=" & Topic_ID
End If
QueryLink = "?" & ArchiveLink & PageLink & TopicLink & AnchorLink
strUrl = ForumLink & QueryLink
strSql = "SELECT T_SUBJECT, F_SUBJECT " & _
" FROM " & strActivePrefix & "TOPICS T, " & strTablePrefix & "FORUM F " & _
" WHERE TOPIC_ID = " & Topic_ID & " AND T.FORUM_ID = F.FORUM_ID"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF Then
getErrMsg "Do Not Edit the URL to gain access to this page!<br />Topic does not exist!"
Else
If Reply_ID <> "" Then
strTitle = chkString("Re-" & rs("T_SUBJECT"),"display")
Else
strTitle = chkString(rs("T_SUBJECT"),"display")
End If
ForumSubject = chkString(rs("F_SUBJECT"),"display")
rs.Close
End If
Set rs = Nothing
Else
If strType = "url" Then
strUrl = ""
strTitle = ""
Else
getErrMsg "Do Not Edit URL to access this page.<br />Type Missing."
End If
End If
strSql = "SELECT DISTINCT B_CAT FROM " & strTablePrefix & "BOOKMARKS WHERE B_MEMBER = " & MemberID & " ORDER BY B_CAT ASC;"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF Then
CatCnt = ""
Else
allCatData = rs.GetRows(adGetRowsRest)
CatCnt = UBound(allCatData,2)
rs.Close
End If
Set rs = Nothing
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ method=""post"" name=""bookmarks"" id=""bookmarks"">" & vbNewLine & _
"<input type=""hidden"" name=""action"" value=""add"">" & vbNewLine & _
" <table border=""0px"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center"" colspan=""2""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strDefaultFontColor & """><b>Bookmark</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
If strtype = "post" Then
Response.Write " <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Default Category: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""defaultcategory"" value=""" & ForumSubject & """ readonly /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
End If
If CatCnt <> "" Then
Response.Write " <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Your Categorys: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & vbNewLine & _
" <select size=""1"" name=""oldcategory"">" & vbNewLine & _
" <option value=""""></option>" & vbNewLine
NewCat = 1
For iCat = 0 to CatCnt
CatSubject = allCatData(0,iCat)
Response.Write " <option value=""" & chkString(CatSubject,"display") & """ "
If Trim(CatSubject) = Trim(ForumSubject) Then
Response.Write "selected"
NewCat = 0
End If
Response.Write ">" & chkString(CatSubject,"display") & "</option>" & vbNewLine
Next
Response.Write " </select></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
End If
Response.Write " <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>New Category: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""newcategory"" /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Title: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""title"" value=""" & strTitle & """ /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Url: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""url"" value=""" & strUrl & """"
If strType = "post" Then Response.Write "readonly"
Response.Write " /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td colspan=""2"" align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""Submit"" name=""bookmarks"" id=""bookmarks"" value="" OK "" /> <input type=""reset"" value=""Reset"" id=""reset1"" name=""reset1""></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
"</form>" & vbNewLine
Else
If strAction = "delete" Then
If Trim(Request.QueryString("id")) <> "" Then
If isNumeric(Request.QueryString("id")) = True Then
BookMark_ID = cLng(Request.QueryString("id"))
Else
getErrMsg "Do Not Edit URL to access this page.<br />BookmarkID is not numeric."
End If
Else
getErrMsg "Do Not Edit URL to access this page.<br />BookmarkID is missing."
End If
Else
getErrMsg "Do Not Edit URL to access this page.<br />Action is missing."
End If
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ name=""bookmark"" id=""bookmark"" method=""post"">" &vbNewLine & _
" <input type=""hidden"" name=""action"" value=""delete"">" & vbNewLine & _
" <input type=""hidden"" name=""id"" value=""" & Bookmark_ID & """>" & vbNewLine
If blnDel Then
Response.Write " <input type=""hidden"" name=""memid"" value=""" & memID & """>" & vbNewLine
End If
Response.Write " <p align=""center""><font color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>Are you sure you want to delete this bookmark?</b></font></p>" & vbNewLine & _
" <br /><input type=""Submit"" value=""Yes"" name=""bookmark"" id=""bookmark"">" & vbNewLine & _
"</form>" & vbNewLine
End If
Else
If Trim(Request.Form("action")) <> "" Then
strAction = Trim(lCase(Request.Form("action")))
If strAction = "add" Then
If Trim(Request.Form("url")) <> "" Then
If IsValidURL(Trim(Request.Form("url"))) Then
strUrl = Trim(Request.Form("url"))
Else
errMsg = "Invalid URL - " & strURLError
End If
Else
getErrMsg "You must enter a url."
End If
If Trim(Request.Form("title")) <> "" Then
strTitle = Trim(Request.Form("title"))
Else
getErrMsg "You must enter a title."
End If
If Trim(Request.Form("defaultcategory")) <> "" Then
strDefCat = Trim(Request.Form("defaultcategory"))
Else
strDefCat = ""
End If
If Trim(Request.Form("oldcategory")) <> "" Then
strOldCat = Trim(Request.Form("oldcategory"))
Else
strOldCat = ""
End If
If Trim(Request.Form("newcategory")) <> "" Then
strNewCat = Trim(Request.Form("newcategory"))
Else
strNewCat = ""
End If
If strNewCat <> "" Then
strCat = strNewCat
ElseIf strOldCat <> "" Then
strCat = strOldCat
Else
strCat = strDefCat
End If
If strCat = "" Then getErrMsg "You must enter a category."
If errMsg <> "" Then getErrMsg "" & errMsg & ""
If addBookmark(MemberID,strUrl,strTitle,strCat) Then
Response.Write " <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><b>Url was added to your bookmarks</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
End If
Else
If strAction = "delete" Then
If Trim(Request.Form("id")) <> "" Then
If isNumeric(Request.Form("id")) = True Then
BookmarkID = cLng(Request.Form("id"))
Else
getErrMsg "Problem - Not getting a numeric bookmark id"
End If
Else
getErrMsg "Problem - Not getting a bookmark id."
End If
If mLev > 3 Then
If Trim(Request.Form("memid")) <> "" and isNumeric(Request.Form("memid")) Then
blnDel = True
memID = cLng(Request.Form("memid"))
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,3,BookmarkID)
memID = MemberID
End If
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,3,BookmarkID)
memID = MemberID
End If
If blnDel = True Then
If delBookmark(memID,BookmarkID) Then
Response.Write " <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><b>Bookmark Deleted!</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
End If
Else
getErrMsg "You Have No Permissions to Delete this Bookmark!!"
End If
Else
getErrMsg "Do Not Edit URL to access this page.<br />Form action is not right."
End If
End If
Else
getErrMsg "Do Not Edit URL to access this page.<br />Form action is not right."
End If
End If
Case 4
If Trim(Request.QueryString("action")) <> "" Then
strAction = Trim(lCase(Request.QueryString("action")))
If Trim(Request.QueryString("id")) <> "" Then
If isNumeric(Request.QueryString("id")) = True Then
FriendID = cLng(Request.QueryString("id"))
Else
getErrMsg "Do not edit the URL to access this page"
End If
Else
getErrMsg "Do not edit the URL to access this page."
End If
Select Case strAction
Case "add"
If chkFolderCnt(MemberID,intFriendMax,intMode) Then
getErrMsg "Your Friends folder is Currently Full.<br />Forum limits are " & intMax & " friends."
End If
strInputAction = "add"
Case "delete"
strInputAction = "delete"
End Select
If strInputAction = "add" or strInputAction = "delete" Then
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ method=""post"" name=""friends"" id=""friends"">" & vbNewLine & _
"<input type=""hidden"" name=""id"" value=""" & FriendID & """ />" & vbNewLine & _
"<input type=""hidden"" name=""action"" value=""" & strInputAction & """ />" & vbNewLine
If Request.QueryString("Confirm")>"" Then Response.Write "<input type=""hidden"" name=""Confirm"" value=""1"" />"
If blnDel Then
Response.Write "<input type=""hidden"" name=""memid"" value=""" & memID & """>" & vbNewLine
End If
Response.Write " <table border=""0px"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strDefaultFontColor & """><b>Friends</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
If strInputAction = "add" Then
Response.Write " <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>"
Response.Write "<b>Level:</b> A. <input type=""radio"" name=""level"" value=""0"" checked /> B. <input type=""radio"" name=""level"" value=""1"" /> C. <input type=""radio"" name=""level"" value=""2"" /><br />"
Response.Write " </td>" & vbNewLine & _
" </tr>" & vbNewLine
End If
Response.Write " <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>" & uCase(strInputAction)
If strInputAction = "add" Then
Response.Write " to your friends list?"
Else
Response.Write " from your friends list?"
End If
Response.Write "</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""Submit"" name=""friends"" id=""friends"" value="" Confirm "" /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
"</form>" & vbNewLine
Else
getErrMsg "Do not edit the URL to access this page."
End If
Else
If Trim(Request.Form("action")) <> "" Then
strAction = Trim(lCase(Request.Form("action")))
If Trim(Request.Form("id")) <> "" and isNumeric(Request.Form("id")) = True Then
FriendID = cLng(Request.Form("id"))
Else
getErrMsg "Problem - Not getting needed form input - id."
End If
Select Case strAction
Case "add"
If MemberID = FriendID Then getErrMsg "Adding yourself to your friends list is not allowed.<br />Do not edit URL to access this page"
If Trim(Request.Form("level")) <> "" and isNumeric(Request.Form("level")) = True Then
FriendLevel = cLng(Request.Form("level"))
Else
getErrMsg "Problem - Not getting needed form input - level."
End If
strSql = "SELECT M_NAME, M_EMAIL FROM " & strMemberTablePrefix & "MEMBERS " & _
"WHERE MEMBER_ID = " & FriendID
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF or rs.BOF Then
Set rs=Nothing
getErrMsg "Member does not exist!"
Else
FriendName = rs("M_NAME")
FriendMail = rs("M_EMAIL")
rs.Close
If chkFriend(MemberID,FriendID) = True Then
If addFriend(MemberID,FriendID,FriendLevel) = True Then
getMsg FriendName & " has been added to your forum friends' folder.<br /><br /><a href=""active.asp"">Back</a><br />"
Else
getErrMsg "Friends Problem - Should not be able to get this far."
End If
End If
End If
Set rs=Nothing
Case "delete"
If mLev > 3 Then
If Trim(Request.Form("memid")) <> "" and isNumeric(Request.Form("memid")) Then
blnDel = True
memID = cLng(Request.Form("memid"))
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,4,FriendID)
memID = MemberID
End If
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,4,FriendID)
memID = MemberID
End If
strSql = "SELECT FRIEND_ID, M_NAME " & _
"FROM " & strTablePrefix & "FRIENDS, " & strMemberTablePrefix & "MEMBERS " & _
"WHERE F_MEMBER = " & memID & " AND FRIEND_ID = " & FriendID & " AND MEMBER_ID = F_FRIEND"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF or rs.BOF Then
Set rs=Nothing
getErrMsg "Either member is not in your friends' folder or member does not exist!<br /><br /><a href=""active.asp"">Community</a><br /><br />Do Not Edit URL to access this page!"
Else
fFriendID = rs("FRIEND_ID")
FriendName = rs("M_NAME")
rs.Close
If blnDel = True Then
If delFriend(memID,FriendID) = True Then
Response.Write " <p align=""center""><font size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """ face=""" & strDefaultFontFace & """><b>" & FriendName & " has been deleted from your forum friends folder.</b><br /><br /><b>Click on <font color=""#FF0000"">x</font> in top-right to close window.</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
Else
getErrMsg "Friends Problem - Should not be able to get this far."
End If
End If
End If
Set rs=Nothing
End Select
Else
getErrMsg "Do Not edit the URL to access this page.</font>"
End If
End If
Case Else
getErrMsg "Please do not edit the url to gain access to this page!!!!"
End Select
Response.Write " <p><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>Choose your friends wisely!</font></p>" & vbNewLine
WriteFooterShort
Response.End
Sub getMsg(msg)
Response.Write "<p align=""center""><font color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>" & msg & "</b></font></p>" & vbNewline
WriteFooterShort
Response.End
End Sub
Sub getErrMsg(msg)
Response.Write "<p align=""center""><font color=""" & strHiLiteFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>" & msg & "</b></font></p>" & vbNewline
WriteFooterShort
Response.End
End Sub
Function chkFolderCnt(mMemID,fMax,fType)
Dim bTmp
bTmp = False
If mLev < 3 or blnLimit = True Then
Dim strSql,rsChk
Dim strTable,strIDCol,strCol
Dim TotalFiles
Select Case cLng(fType)
Case 3
strTable = "BOOKMARKS"
strIDCol = "BOOKMARK_ID"
strCol = "B_MEMBER"
Case 4
strTable = "FRIENDS"
strIDCol = "FRIEND_ID"
strCol = "F_MEMBER"
End Select
strSql = "SELECT COUNT(" & strIDCol & ") AS TOTAL_FILES " & _
"FROM " & strTablePrefix & strTable & " " & _
"WHERE " & strCol & " = " & mMemID
Set rsChk = my_Conn.Execute (strSql)
If not rsChk.EOF Then
TotalFiles = rsChk(0).value
rsChk.Close
End If
Set rsChk = Nothing
If TotalFiles => fMax Then
bTmp = True
End If
End If
chkFolderCnt = bTmp
End Function
Function chkCanEdit(mName,mPassword,fType,fID)
Dim bTmp,strSql,rsChk
Dim strTable,strIDCol,strCol,strMsg
bTmp = False
Select Case cLng(fType)
Case 2
strTable = "DRAFTS"
strIDCol = "DRAFT_ID"
strCol = "D_AUTHOR"
Case 3
strTable = "BOOKMARKS"
strIDCol = "BOOKMARK_ID"
strCol = "B_MEMBER"
Case 4
strTable = "FRIENDS"
strIDCol = "FRIEND_ID"
strCol = "F_MEMBER"
Case Else
strMsg = "There has been an error.<br /><br /><a href=""javascript:history(-1)"">Back</a>"
If mLev > 3 Then
strMsg = strMsg & "Feature is out of range - Function chkCanEdit."
Else
strMsg = strMsg & "Please inform Amin."
End If
getErrMsg strMsg
End Select
strSql = "SELECT " & strCol & ", M.MEMBER_ID, M.M_LEVEL, M.M_NAME " & _
"FROM " & strMemberTablePrefix & "MEMBERS M, " & strTablePrefix & strTable & " " & _
"WHERE M." & strDBNTSQLName & " = '" & mName & "' "
If strAuthType="db" Then
strSql = strSql & " AND M.M_PASSWORD = '" & mPassword &"' "
End If
strSql = strSql & " AND " & strIDCol & " = " & fID & " "
strSql = strSql & " AND M.M_STATUS = " & 1
Set rsChk = my_Conn.Execute (strSql)
If not (rsChk.BOF or rsChk.EOF) Then
If cLng(rsChk("MEMBER_ID")) = cLng(rsChk(strCol)) Then
bTmp = True 'author
End If
rsChk.Close
End If
Set rsChk = Nothing
chkCanEdit = bTmp
End Function
Function IsValidURL(sValidate)
Dim sInvalidChars, bTemp, i
If Trim(sValidate) = "" Then IsValidURL = True : exit Function
sInvalidChars = """;+()*'<>"
For i = 1 To Len(sInvalidChars)
If InStr(sValidate, Mid(sInvalidChars, i, 1)) > 0 Then bTemp = True
If bTemp Then strURLError = "<br />• cannot contain any of the following characters: "" ; + ( ) * ' < > "
If bTemp Then Exit For
Next
If not bTemp Then
For i = 1 to Len(sValidate)
If Asc(Mid(sValidate, i, 1)) = 160 Then bTemp = True
If bTemp Then strURLError = "<br />• cannot contain any spaces "
If bTemp Then Exit For
Next
End If
If not bTemp Then
bTemp = (lCase(left(sValidate, 7)) <> "http://") and (lCase(left(sValidate, 8)) <> "https://")
If bTemp Then strURLError = "<br />• must begin with either http:// or https:// "
End If
If not bTemp Then
bTemp = len(sValidate) > 255
If bTemp Then strURLError = "<br />• cannot be more than 255 characters "
End If
If not bTemp Then
bTemp = InStr(sValidate, "..") > 0
If bTemp Then strURLError = "<br />• cannot contain consecutive periods "
End If
If not bTemp Then
bTemp = InStr(sValidate, " ") > 0
If bTemp Then strURLError = "<br />• cannot contain any spaces "
End If
If not bTemp Then
bTemp = (len(sValidate) <> len(Trim(sValidate)))
If bTemp Then strURLError = "<br />• cannot contain any spaces "
End If
IsValidURL = Not bTemp
End Function
Function chkUrl(fStr)
fStr = Replace(fStr,"#","&#")
fStr = ChkString(fStr, "SQLString")
chkUrl = fStr
End Function
Sub chkVariable(strVar,strDesc)
If Trim(strVar) <> "" Then
If cLng(strVar) < 1 Then
If mLev > 2 Then
getErrMsg "Admin has " & strDesc & " turned off."
Else
Response.Redirect "default.asp"
End If
End If
Else
If mLev > 3 Then
getErrMsg strDesc & " could not be found in Database."
Else
Response.Redirect "default.asp"
End If
End If
End Sub
Function addBookmark(iMemId,sUrl,sTitle,sCat)
Dim bTmp,strSql
bTmp = False
Dim intTopicID
intTopicID = Request.QueryString("topic_id")
For i = 1 to len(chkUrl(sUrl))
If mid(chkUrl(sUrl),i,1) = "=" Then
strTopicID = mid(chkUrl(sUrl),i+1)
intTopicID = cLng(strTopicID)
End If
Next
strSql = "INSERT INTO " & strTablePrefix & "BOOKMARKS(B_URL, B_MEMBER, B_TITLE, B_CAT, B_DATE, B_TOPICID" & _
") VALUES (" & _
"'" & chkUrl(sUrl) & "', " & iMemID & ", '" & chkString(sTitle,"SQLString") & "', '" & chkString(sCat,"SQLString") & "', '" & DateToStr(strForumTimeAdjust) & "', " & intTopicID & ")"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If Err.Description <> "" Then
getErrMsg "There was an error = " & Err.Description
Else
bTmp = True
End If
addBookmark = bTmp
End Function
Function delBookmark(iMemID,iBookmarkID)
Dim bTmp,strSql
bTmp = False
strSql = "DELETE FROM " & strTablePrefix & "BOOKMARKS " & _
"WHERE B_MEMBER = " & iMemID & " AND BOOKMARK_ID = " & iBookmarkID
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If Err.Description <> "" Then
getErrMsg "There was an error = " & Err.Description
Else
bTmp = True
End If
delBookmark = bTmp
End Function
Function chkFriend(iMemID,iFriendID)
Dim bTemp,strSql,rsChk
bTemp = False
strSql = "SELECT F_FRIEND FROM " & strTablePrefix & "FRIENDS " & _
"WHERE F_MEMBER = " & iMemID & " AND F_FRIEND = " & iFriendID
Set rsChk = my_Conn.Execute (strSql)
If rsChk.EOF or rsChk.BOF Then
bTemp = True
chkFriend = bTemp
Set rsChk = Nothing
Else
rsChk.Close
Set rsChk = Nothing
getErrMsg "Member already exists in your friends' folder.<br /><br /><a href=""active.asp"">Community</a>"
End If
End Function
Function addFriend(iMemID,iFriendID,iLev)
Dim bTmp, strSql
bTmp = False
strSql = "INSERT INTO " & strTablePrefix & "FRIENDS " & _
"(F_MEMBER, F_FRIEND, F_LEVEL, F_DATE) VALUES " & _
"(" & iMemID & ", " & iFriendID & ", " & iLev & ", '" & DateToStr(strForumTimeAdjust) & "')"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If err.Description <> "" Then
getErrMsg err.Description, 0
Else
bTmp = True
End If
addFriend = bTmp
If strEmail = "1" Then
strRecipientsName = FriendName
strRecipients = FriendMail
strFrom = strSender
strFromName = strForumTitle
strSubject = strForumTitle & " Friends' List "
strMessage = "Hello " & FriendName & vbNewline & vbNewline
If Request("Confirm")>"" Then
strMessage = strMessage & "You received this message from " & strForumTitle & " because " & strDBNTUserName & " confirmed your request for friendship on the forums at " & strForumURL & vbNewline & vbNewline
Else
strMessage = strMessage & "You received this message from " & strForumTitle & " because " & strDBNTUserName & " wishes to befriend you on the forums at " & strForumURL & vbNewline & vbNewline
strMessage = strMessage & "To ignore " & strDBNTUserName & "'s request, simply do nothing." & vbNewline & vbNewline
strMessage = strMessage & "To confirm " & strDBNTUserName & "'s request, click on link below or copy and paste link into your browser: " & strForumURL & "pop_user_space.asp?mode=friends&Confirm=1&action=add&id=" & MemberID & vbNewline & vbNewline
strMessage = strMessage & "or, if you have already added " & strDBNTUserName & " as a friend, you can remove " & strDBNTUserName & " from your friends' list here: " & strForumURL & "pop_user_space.asp?mode=friends&action=delete&id=" & MemberID & vbNewline & vbNewline
End If
%>
<!--#INCLUDE FILE="inc_mail.asp" -->
<%
End If
End Function
Function delFriend(iMemID,iFriendID)
Dim bTmp, strSql
bTmp = False
strSql = "DELETE FROM " & strTablePrefix & "FRIENDS " & _
"WHERE F_MEMBER = " & iMemID & " AND FRIEND_ID = " & iFriendID
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If err.Description <> "" Then
getErrMsg err.Description, 0
Else
bTmp = True
End If
delFriend = bTmp
End Function
%>
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Carefree
Advanced Member
Philippines
4207 Posts |
Posted - 18 February 2014 : 01:19:06
|
Delete these lines, see if your issue isn't resolved.
|
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 18 February 2014 : 01:40:40
|
That produced this error, Carefree.
Microsoft OLE DB Provider for ODBC Drivers error '80040e14'
[MySQL][ODBC 5.1 Driver][mysqld-5.5.28]You have an error in your SQL syntax; check the manual that corresponds to your MySQL server version for the right syntax to use near ')' at line 1
/fp/pop_user_space.asp, line 691
Here are lines 678 - 698 below.
Function addBookmark(iMemId,sUrl,sTitle,sCat)
Dim bTmp,strSql
bTmp = False
Dim intTopicID
intTopicID = Request.QueryString("topic_id")
For i = 1 to len(chkUrl(sUrl))
If mid(chkUrl(sUrl),i,1) = "=" Then
strTopicID = mid(chkUrl(sUrl),i+1)
End If
Next
strSql = "INSERT INTO " & strTablePrefix & "BOOKMARKS(B_URL, B_MEMBER, B_TITLE, B_CAT, B_DATE, B_TOPICID" & _
") VALUES (" & _
"'" & chkUrl(sUrl) & "', " & iMemID & ", '" & chkString(sTitle,"SQLString") & "', '" & chkString(sCat,"SQLString") & "', '" & DateToStr(strForumTimeAdjust) & "', " & intTopicID & ")"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If Err.Description <> "" Then
getErrMsg "There was an error = " & Err.Description
Else
bTmp = True
End If
addBookmark = bTmp
End Function
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Carefree
Advanced Member
Philippines
4207 Posts |
Posted - 18 February 2014 : 05:01:10
|
You didn't follow instructions. I said to delete the lines above, you only deleted one of them. It should look like this:
|
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 18 February 2014 : 06:02:59
|
OOPS!  Sorry about that, Carefree!
Okay, replaced those lines with yours. But now, I am receiving this error below.
Microsoft OLE DB Provider for ODBC Drivers error '80040e14'
[MySQL][ODBC 5.1 Driver][mysqld-5.5.28]You have an error in your SQL syntax; check the manual that corresponds to your MySQL server version for the right syntax to use near ')' at line 1
/fp/pop_user_space.asp, line 686
Lines 678 - 693
Function addBookmark(iMemId,sUrl,sTitle,sCat)
Dim bTmp,strSql
bTmp = False
Dim intTopicID
intTopicID = Request.QueryString("topic_id")
strSql = "INSERT INTO " & strTablePrefix & "BOOKMARKS(B_URL, B_MEMBER, B_TITLE, B_CAT, B_DATE, B_TOPICID" & _
") VALUES (" & _
"'" & chkUrl(sUrl) & "', " & iMemID & ", '" & chkString(sTitle,"SQLString") & "', '" & chkString(sCat,"SQLString") & "', '" & DateToStr(strForumTimeAdjust) & "', " & intTopicID & ")"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If Err.Description <> "" Then
getErrMsg "There was an error = " & Err.Description
Else
bTmp = True
End If
addBookmark = bTmp
End Function
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Davio
Development Team Member
Jamaica
12217 Posts |
Posted - 18 February 2014 : 06:59:12
|
Seems something not right with intTopicID.
Carefree, make sure to put in some checks to ensure intTopicID is a number as well before inserting into the database. |
Support Snitz Forums
|
|
|
|
Carefree
Advanced Member
Philippines
4207 Posts |
Posted - 18 February 2014 : 11:04:50
|
Here, Ma, try this. If there's an issue with the value, it'll display an error message.
<%
'###############################################################################
'##
'## Snitz Forums 2000 v3.4.07
'##
'###############################################################################
'##
'## Copyright © 2000-14 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free. You can redistribute and/or modify it under the
'## terms of the GNU General Public License as published by the Free Software
'## Foundation; either version 2 or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000 must remain intact in
'## the scripts and in the HTML output. The "powered by" text/logo with a
'## link back to http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful but
'## WITHOUT ANY WARRANTY; without even an implied warranty of MERCHANTABILITY
'## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
'## for more details.
'##
'## You should have received a copy of the GNU General Public License along
'## with this program; if not, write to:
'##
'## Free Software Foundation, Inc.
'## 59 Temple Place, Suite 330
'## Boston, MA 02111-1307
'##
'## Support can be obtained from our support forums at:
'##
'## http://forum.snitz.com
'##
'## Correspondence and marketing questions can be sent to:
'##
'## manderson@snitz.com
'##
'###############################################################################
'##
'## User Space v3.4.07
'## Author: Cripto9t
'##
'###############################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<!--#INCLUDE FILE="inc_header_short.asp"-->
<!--#INCLUDE FILE="inc_sha256.asp"-->
<%
Const blnLimit = True 'boolean holds member limits switch
Const intBookmarkMax = 100 'numeric holds max num of bookmarks a member can have
Const intFriendMax = 5000 'numeric holds max num of friends a member can have
Dim blnDel, memID, strEncodedPassword, Mode, intMode, strAction
blnDel = False
If mLev < 1 or MemberID < 1 Then
getErrMsg "You Must be logged in to view this page."
End If
strEncodedPassword = Trim(Request.Cookies(strUniqueID & "User")("Pword"))
Mode = ChkString(Trim(lCase(Request.QueryString("mode"))), "sqlstring")
If mLev > 3 and (Trim(Request.QueryString("memid")) <> "" and isNumeric(Request.QueryString("memid"))) = True Then
blnDel = True
memID = cLng(Request.QueryString("memid"))
Else
memID = MemberID
End If
Select Case Mode
Case "draft"
Call chkVariable (strUSDraftSwitch,"Drafts")
intMode = 2
Case "bookmark"
Call chkVariable (strUSBookmarkSwitch,"Bookmarks")
intMode = 3
intMax = intBookmarkMax
Case "friends"
Call chkVariable(strUSFriendSwitch,"Friends")
intMode = 4
intMax = intFriendMax
Case Else
Response.Redirect "default.asp"
End Select
Select Case intMode
Case 2
If Trim(Request.QueryString("draft_id")) <> "" and isNumeric(Request.QueryString("draft_id")) = True Then
DraftID = cLng(Request.QueryString("draft_id"))
Else
DraftID = ""
End If
If DraftID <> "" Then
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ name=""draft"" id=""draft"" method=""post"">" &vbNewLine & _
" <input type=""hidden"" name=""action"" value=""delete"">" & vbNewLine & _
" <input type=""hidden"" name=""draftid"" value=""" & DraftID & """>" & vbNewLine
If blnDel Then
Response.Write "<input type=""hidden"" name=""memid"" value=""" & memID & """>" & vbnewLine
End If
Response.Write " <p align=""center""><font color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>Are you sure you want to delete this draft?</b></font></p>" & vbNewLine & _
" <br /><input type=""Submit"" value=""Yes"" name=""draft"" id=""draft"">" & vbNewLine & _
"</form>" & vbNewLine
Else
If Trim(Request.Form("draftid")) <> "" Then
If isNumeric(Request.Form("draftid")) = True Then
DraftID = cLng(Request.Form("draftid"))
Else
getErrMsg "Do Not Edit URL to Access this Page! 1"
End If
Else
getErrMsg "Do Not Edit URL to Access this Page! 2"
End If
If mLev > 3 Then
If Trim(Request.Form("memid")) <> "" and isNumeric(Request.Form("memid")) Then
blnDel = True
memID = cLng(Request.Form("memid"))
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,2,DraftID)
memID = MemberID
End If
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,2,DraftID)
End If
If blnDel = True Then
strSql = "DELETE FROM " & strTablePrefix & "DRAFTS WHERE D_AUTHOR = " & memID & " AND DRAFT_ID = " & DraftID
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If Err.Description <> "" Then
getErrMsg "There was an error = " & Err.Description
Else
Response.Write " <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><b>Draft Deleted!</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
End If
Else
getErrMsg "You Have No Permissions to Delete this Draft!!"
End If
End If
Case 3
Dim strType
If Trim(Request.QueryString("action")) <> "" Then
strAction = Trim(lCase(Request.QueryString("action")))
If strAction = "add" Then
If chkFolderCnt(MemberID,intMax,intMode) Then
getErrMsg "Your Bookmark Folder is Currently Full.<br />Forum limits are " & intMax & " bookmarks."
End If
strType = Trim(lCase(Request.QueryString("type")))
If strType = "post" Then
If Trim(Request.QueryString("topic_id")) <> "" Then
If isNumeric(Request.QueryString("topic_id")) = True Then
Topic_ID = cLng(Request.QueryString("topic_id"))
Else
getErrMsg "Problem - not getting a numeric topic id"
End If
Else
getErrMsg "Problem - Not getting a topic id"
End If
If Trim(Request.QueryString("reply_id")) <> "" Then
If isNumeric(Request.QueryString("reply_id")) = True Then
Reply_ID = cLng(Request.QueryString("reply_id"))
Else
getErrMsg "Problem - not getting a numeric reply id"
End If
Else
Reply_ID = ""
End If
If Trim(Request.QueryString("archive")) = "true" Then
strActivePrefix = strTablePrefix & "A_"
ArchiveView = "true"
ArchiveLink = "ARCHIVE=true&"
Else
strActivePrefix = strTablePrefix
ArchiveView = ""
ArchiveLink = ""
End If
If inStr(strForumUrl,"default.asp/") Then
ForumLink = replace(strForumUrl,"default.asp/", "topic.asp")
Else
ForumLink = strForumUrl & "topic.asp"
End If
ArchiveLink = ""
PageLink = ""
AnchorLink = ""
If ArchiveView = "true" Then
ArchiveLink = "ARCHIVE=true&"
End If
If Reply_ID <> "" Then
PageLink = "whichpage=-1&"
TopicLink = "TOPIC_ID=" & Topic_ID & "&"
AnchorLink = "Reply_ID=" & Reply_ID
Else
TopicLink = "TOPIC_ID=" & Topic_ID
End If
QueryLink = "?" & ArchiveLink & PageLink & TopicLink & AnchorLink
strUrl = ForumLink & QueryLink
strSql = "SELECT T_SUBJECT, F_SUBJECT " & _
" FROM " & strActivePrefix & "TOPICS T, " & strTablePrefix & "FORUM F " & _
" WHERE TOPIC_ID = " & Topic_ID & " AND T.FORUM_ID = F.FORUM_ID"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF Then
getErrMsg "Do Not Edit the URL to gain access to this page!<br />Topic does not exist!"
Else
If Reply_ID <> "" Then
strTitle = chkString("Re-" & rs("T_SUBJECT"),"display")
Else
strTitle = chkString(rs("T_SUBJECT"),"display")
End If
ForumSubject = chkString(rs("F_SUBJECT"),"display")
rs.Close
End If
Set rs = Nothing
Else
If strType = "url" Then
strUrl = ""
strTitle = ""
Else
getErrMsg "Do Not Edit URL to access this page.<br />Type Missing."
End If
End If
strSql = "SELECT DISTINCT B_CAT FROM " & strTablePrefix & "BOOKMARKS WHERE B_MEMBER = " & MemberID & " ORDER BY B_CAT ASC;"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF Then
CatCnt = ""
Else
allCatData = rs.GetRows(adGetRowsRest)
CatCnt = UBound(allCatData,2)
rs.Close
End If
Set rs = Nothing
Response.Write "<form action=""pop_user_space.asp?topic_id=" & Request.QueryString("topic_id") & "&mode=" & Mode & """ method=""post"" name=""bookmarks"" id=""bookmarks"">" & vbNewLine & _
"<input type=""hidden"" name=""action"" value=""add"">" & vbNewLine & _
" <table border=""0px"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center"" colspan=""2""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strDefaultFontColor & """><b>Bookmark</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
If strtype = "post" Then
Response.Write " <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Default Category: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""defaultcategory"" value=""" & ForumSubject & """ readonly /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
End If
If CatCnt <> "" Then
Response.Write " <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Your Categorys: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & vbNewLine & _
" <select size=""1"" name=""oldcategory"">" & vbNewLine & _
" <option value=""""></option>" & vbNewLine
NewCat = 1
For iCat = 0 to CatCnt
CatSubject = allCatData(0,iCat)
Response.Write " <option value=""" & chkString(CatSubject,"display") & """ "
If Trim(CatSubject) = Trim(ForumSubject) Then
Response.Write "selected"
NewCat = 0
End If
Response.Write ">" & chkString(CatSubject,"display") & "</option>" & vbNewLine
Next
Response.Write " </select></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
End If
Response.Write " <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>New Category: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""newcategory"" /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Title: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""title"" value=""" & strTitle & """ /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Url: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""url"" value=""" & strUrl & """"
If strType = "post" Then Response.Write "readonly"
Response.Write " /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td colspan=""2"" align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""Submit"" name=""bookmarks"" id=""bookmarks"" value="" OK "" /> <input type=""reset"" value=""Reset"" id=""reset1"" name=""reset1""></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
"</form>" & vbNewLine
Else
If strAction = "delete" Then
If Trim(Request.QueryString("id")) <> "" Then
If isNumeric(Request.QueryString("id")) = True Then
BookMark_ID = cLng(Request.QueryString("id"))
Else
getErrMsg "Do Not Edit URL to access this page.<br />BookmarkID is not numeric."
End If
Else
getErrMsg "Do Not Edit URL to access this page.<br />BookmarkID is missing."
End If
Else
getErrMsg "Do Not Edit URL to access this page.<br />Action is missing."
End If
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ name=""bookmark"" id=""bookmark"" method=""post"">" &vbNewLine & _
" <input type=""hidden"" name=""action"" value=""delete"">" & vbNewLine & _
" <input type=""hidden"" name=""id"" value=""" & Bookmark_ID & """>" & vbNewLine
If blnDel Then
Response.Write " <input type=""hidden"" name=""memid"" value=""" & memID & """>" & vbNewLine
End If
Response.Write " <p align=""center""><font color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>Are you sure you want to delete this bookmark?</b></font></p>" & vbNewLine & _
" <br /><input type=""Submit"" value=""Yes"" name=""bookmark"" id=""bookmark"">" & vbNewLine & _
"</form>" & vbNewLine
End If
Else
If Trim(Request.Form("action")) <> "" Then
strAction = Trim(lCase(Request.Form("action")))
If strAction = "add" Then
If Trim(Request.Form("url")) <> "" Then
If IsValidURL(Trim(Request.Form("url"))) Then
strUrl = Trim(Request.Form("url"))
Else
errMsg = "Invalid URL - " & strURLError
End If
Else
getErrMsg "You must enter a url."
End If
If Trim(Request.Form("title")) <> "" Then
strTitle = Trim(Request.Form("title"))
Else
getErrMsg "You must enter a title."
End If
If Trim(Request.Form("defaultcategory")) <> "" Then
strDefCat = Trim(Request.Form("defaultcategory"))
Else
strDefCat = ""
End If
If Trim(Request.Form("oldcategory")) <> "" Then
strOldCat = Trim(Request.Form("oldcategory"))
Else
strOldCat = ""
End If
If Trim(Request.Form("newcategory")) <> "" Then
strNewCat = Trim(Request.Form("newcategory"))
Else
strNewCat = ""
End If
If strNewCat <> "" Then
strCat = strNewCat
ElseIf strOldCat <> "" Then
strCat = strOldCat
Else
strCat = strDefCat
End If
If strCat = "" Then getErrMsg "You must enter a category."
If errMsg <> "" Then getErrMsg "" & errMsg & ""
If addBookmark(MemberID,strUrl,strTitle,strCat) Then
Response.Write " <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><b>Url was added to your bookmarks</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
End If
Else
If strAction = "delete" Then
If Trim(Request.Form("id")) <> "" Then
If isNumeric(Request.Form("id")) = True Then
BookmarkID = cLng(Request.Form("id"))
Else
getErrMsg "Problem - Not getting a numeric bookmark id"
End If
Else
getErrMsg "Problem - Not getting a bookmark id."
End If
If mLev > 3 Then
If Trim(Request.Form("memid")) <> "" and isNumeric(Request.Form("memid")) Then
blnDel = True
memID = cLng(Request.Form("memid"))
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,3,BookmarkID)
memID = MemberID
End If
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,3,BookmarkID)
memID = MemberID
End If
If blnDel = True Then
If delBookmark(memID,BookmarkID) Then
Response.Write " <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><b>Bookmark Deleted!</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
End If
Else
getErrMsg "You Have No Permissions to Delete this Bookmark!!"
End If
Else
getErrMsg "Do Not Edit URL to access this page.<br />Form action is not right."
End If
End If
Else
getErrMsg "Do Not Edit URL to access this page.<br />Form action is not right."
End If
End If
Case 4
If Trim(Request.QueryString("action")) <> "" Then
strAction = Trim(lCase(Request.QueryString("action")))
If Trim(Request.QueryString("id")) <> "" Then
If isNumeric(Request.QueryString("id")) = True Then
FriendID = cLng(Request.QueryString("id"))
Else
getErrMsg "Do not edit the URL to access this page"
End If
Else
getErrMsg "Do not edit the URL to access this page."
End If
Select Case strAction
Case "add"
If chkFolderCnt(MemberID,intFriendMax,intMode) Then
getErrMsg "Your Friends folder is Currently Full.<br />Forum limits are " & intMax & " friends."
End If
strInputAction = "add"
Case "delete"
strInputAction = "delete"
End Select
If strInputAction = "add" or strInputAction = "delete" Then
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ method=""post"" name=""friends"" id=""friends"">" & vbNewLine & _
"<input type=""hidden"" name=""id"" value=""" & FriendID & """ />" & vbNewLine & _
"<input type=""hidden"" name=""action"" value=""" & strInputAction & """ />" & vbNewLine
If Request.QueryString("Confirm")>"" Then Response.Write "<input type=""hidden"" name=""Confirm"" value=""1"" />"
If blnDel Then
Response.Write "<input type=""hidden"" name=""memid"" value=""" & memID & """>" & vbNewLine
End If
Response.Write " <table border=""0px"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strDefaultFontColor & """><b>Friends</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
If strInputAction = "add" Then
Response.Write " <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>"
Response.Write "<b>Level:</b> A. <input type=""radio"" name=""level"" value=""0"" checked /> B. <input type=""radio"" name=""level"" value=""1"" /> C. <input type=""radio"" name=""level"" value=""2"" /><br />"
Response.Write " </td>" & vbNewLine & _
" </tr>" & vbNewLine
End If
Response.Write " <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>" & uCase(strInputAction)
If strInputAction = "add" Then
Response.Write " to your friends list?"
Else
Response.Write " from your friends list?"
End If
Response.Write "</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""Submit"" name=""friends"" id=""friends"" value="" Confirm "" /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
"</form>" & vbNewLine
Else
getErrMsg "Do not edit the URL to access this page."
End If
Else
If Trim(Request.Form("action")) <> "" Then
strAction = Trim(lCase(Request.Form("action")))
If Trim(Request.Form("id")) <> "" and isNumeric(Request.Form("id")) = True Then
FriendID = cLng(Request.Form("id"))
Else
getErrMsg "Problem - Not getting needed form input - id."
End If
Select Case strAction
Case "add"
If MemberID = FriendID Then getErrMsg "Adding yourself to your friends list is not allowed.<br />Do not edit URL to access this page"
If Trim(Request.Form("level")) <> "" and isNumeric(Request.Form("level")) = True Then
FriendLevel = cLng(Request.Form("level"))
Else
getErrMsg "Problem - Not getting needed form input - level."
End If
strSql = "SELECT M_NAME, M_EMAIL FROM " & strMemberTablePrefix & "MEMBERS " & _
"WHERE MEMBER_ID = " & FriendID
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF or rs.BOF Then
Set rs=Nothing
getErrMsg "Member does not exist!"
Else
FriendName = rs("M_NAME")
FriendMail = rs("M_EMAIL")
rs.Close
If chkFriend(MemberID,FriendID) = True Then
If addFriend(MemberID,FriendID,FriendLevel) = True Then
getMsg FriendName & " has been added to your forum friends' folder.<br /><br /><a href=""active.asp"">Back</a><br />"
Else
getErrMsg "Friends Problem - Should not be able to get this far."
End If
End If
End If
Set rs=Nothing
Case "delete"
If mLev > 3 Then
If Trim(Request.Form("memid")) <> "" and isNumeric(Request.Form("memid")) Then
blnDel = True
memID = cLng(Request.Form("memid"))
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,4,FriendID)
memID = MemberID
End If
Else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,4,FriendID)
memID = MemberID
End If
strSql = "SELECT FRIEND_ID, M_NAME " & _
"FROM " & strTablePrefix & "FRIENDS, " & strMemberTablePrefix & "MEMBERS " & _
"WHERE F_MEMBER = " & memID & " AND FRIEND_ID = " & FriendID & " AND MEMBER_ID = F_FRIEND"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rs.EOF or rs.BOF Then
Set rs=Nothing
getErrMsg "Either member is not in your friends' folder or member does not exist!<br /><br /><a href=""active.asp"">Community</a><br /><br />Do Not Edit URL to access this page!"
Else
fFriendID = rs("FRIEND_ID")
FriendName = rs("M_NAME")
rs.Close
If blnDel = True Then
If delFriend(memID,FriendID) = True Then
Response.Write " <p align=""center""><font size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """ face=""" & strDefaultFontFace & """><b>" & FriendName & " has been deleted from your forum friends folder.</b><br /><br /><b>Click on <font color=""#FF0000"">x</font> in top-right to close window.</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
Else
getErrMsg "Friends Problem - Should not be able to get this far."
End If
End If
End If
Set rs=Nothing
End Select
Else
getErrMsg "Do Not edit the URL to access this page.</font>"
End If
End If
Case Else
getErrMsg "Please do not edit the url to gain access to this page!!!!"
End Select
Response.Write " <p><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>Choose your friends wisely!</font></p>" & vbNewLine
WriteFooterShort
Response.End
Sub getMsg(msg)
Response.Write "<p align=""center""><font color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>" & msg & "</b></font></p>" & vbNewline
WriteFooterShort
Response.End
End Sub
Sub getErrMsg(msg)
Response.Write "<p align=""center""><font color=""" & strHiLiteFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>" & msg & "</b></font></p>" & vbNewline
WriteFooterShort
Response.End
End Sub
Function chkFolderCnt(mMemID,fMax,fType)
Dim bTmp
bTmp = False
If mLev < 3 or blnLimit = True Then
Dim strSql,rsChk
Dim strTable,strIDCol,strCol
Dim TotalFiles
Select Case cLng(fType)
Case 3
strTable = "BOOKMARKS"
strIDCol = "BOOKMARK_ID"
strCol = "B_MEMBER"
Case 4
strTable = "FRIENDS"
strIDCol = "FRIEND_ID"
strCol = "F_MEMBER"
End Select
strSql = "SELECT COUNT(" & strIDCol & ") AS TOTAL_FILES " & _
"FROM " & strTablePrefix & strTable & " " & _
"WHERE " & strCol & " = " & mMemID
Set rsChk = my_Conn.Execute (strSql)
If not rsChk.EOF Then
TotalFiles = rsChk(0).value
rsChk.Close
End If
Set rsChk = Nothing
If TotalFiles => fMax Then
bTmp = True
End If
End If
chkFolderCnt = bTmp
End Function
Function chkCanEdit(mName,mPassword,fType,fID)
Dim bTmp,strSql,rsChk
Dim strTable,strIDCol,strCol,strMsg
bTmp = False
Select Case cLng(fType)
Case 2
strTable = "DRAFTS"
strIDCol = "DRAFT_ID"
strCol = "D_AUTHOR"
Case 3
strTable = "BOOKMARKS"
strIDCol = "BOOKMARK_ID"
strCol = "B_MEMBER"
Case 4
strTable = "FRIENDS"
strIDCol = "FRIEND_ID"
strCol = "F_MEMBER"
Case Else
strMsg = "There has been an error.<br /><br /><a href=""javascript:history(-1)"">Back</a>"
If mLev > 3 Then
strMsg = strMsg & "Feature is out of range - Function chkCanEdit."
Else
strMsg = strMsg & "Please inform Amin."
End If
getErrMsg strMsg
End Select
strSql = "SELECT " & strCol & ", M.MEMBER_ID, M.M_LEVEL, M.M_NAME " & _
"FROM " & strMemberTablePrefix & "MEMBERS M, " & strTablePrefix & strTable & " " & _
"WHERE M." & strDBNTSQLName & " = '" & mName & "' "
If strAuthType="db" Then
strSql = strSql & " AND M.M_PASSWORD = '" & mPassword &"' "
End If
strSql = strSql & " AND " & strIDCol & " = " & fID & " "
strSql = strSql & " AND M.M_STATUS = " & 1
Set rsChk = my_Conn.Execute (strSql)
If not (rsChk.BOF or rsChk.EOF) Then
If cLng(rsChk("MEMBER_ID")) = cLng(rsChk(strCol)) Then
bTmp = True 'author
End If
rsChk.Close
End If
Set rsChk = Nothing
chkCanEdit = bTmp
End Function
Function IsValidURL(sValidate)
Dim sInvalidChars, bTemp, i
If Trim(sValidate) = "" Then IsValidURL = True : exit Function
sInvalidChars = """;+()*'<>"
For i = 1 To Len(sInvalidChars)
If InStr(sValidate, Mid(sInvalidChars, i, 1)) > 0 Then bTemp = True
If bTemp Then strURLError = "<br />• cannot contain any of the following characters: "" ; + ( ) * ' < > "
If bTemp Then Exit For
Next
If not bTemp Then
For i = 1 to Len(sValidate)
If Asc(Mid(sValidate, i, 1)) = 160 Then bTemp = True
If bTemp Then strURLError = "<br />• cannot contain any spaces "
If bTemp Then Exit For
Next
End If
If not bTemp Then
bTemp = (lCase(left(sValidate, 7)) <> "http://") and (lCase(left(sValidate, 8)) <> "https://")
If bTemp Then strURLError = "<br />• must begin with either http:// or https:// "
End If
If not bTemp Then
bTemp = len(sValidate) > 255
If bTemp Then strURLError = "<br />• cannot be more than 255 characters "
End If
If not bTemp Then
bTemp = InStr(sValidate, "..") > 0
If bTemp Then strURLError = "<br />• cannot contain consecutive periods "
End If
If not bTemp Then
bTemp = InStr(sValidate, " ") > 0
If bTemp Then strURLError = "<br />• cannot contain any spaces "
End If
If not bTemp Then
bTemp = (len(sValidate) <> len(Trim(sValidate)))
If bTemp Then strURLError = "<br />• cannot contain any spaces "
End If
IsValidURL = Not bTemp
End Function
Function chkUrl(fStr)
fStr = Replace(fStr,"#","#")
fStr = ChkString(fStr, "SQLString")
chkUrl = fStr
End Function
Sub chkVariable(strVar,strDesc)
If Trim(strVar) <> "" Then
If cLng(strVar) < 1 Then
If mLev > 2 Then
getErrMsg "Admin has " & strDesc & " turned off."
Else
Response.Redirect "default.asp"
End If
End If
Else
If mLev > 3 Then
getErrMsg strDesc & " could not be found in Database."
Else
Response.Redirect "default.asp"
End If
End If
End Sub
Function addBookmark(iMemId,sUrl,sTitle,sCat)
Dim bTmp,strSql
bTmp = False
If Trim(Request.QueryString("topic_id")) <> "" Then
If isNumeric(Trim(Request.QueryString("topic_id"))) = True Then
Topic_ID = cLng(Trim(Request.QueryString("topic_id")))
Else
getErrMsg "Problem - not getting a numeric topic id. Value provided is:" & Request.QueryString("topic_id")
End If
Else
getErrMsg "Problem - Not getting a topic id"
End If
strSql = "INSERT INTO " & strTablePrefix & "BOOKMARKS(B_URL, B_MEMBER, B_TITLE, B_CAT, B_DATE, B_TOPICID" & _
") VALUES (" & _
"'" & chkUrl(sUrl) & "', " & iMemID & ", '" & chkString(sTitle,"SQLString") & "', '" & chkString(sCat,"SQLString") & "', '" & DateToStr(strForumTimeAdjust) & "', " & Topic_ID & ")"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If Err.Description <> "" Then
getErrMsg "There was an error = " & Err.Description
Else
bTmp = True
End If
addBookmark = bTmp
End Function
Function delBookmark(iMemID,iBookmarkID)
Dim bTmp,strSql
bTmp = False
strSql = "DELETE FROM " & strTablePrefix & "BOOKMARKS " & _
"WHERE B_MEMBER = " & iMemID & " AND BOOKMARK_ID = " & iBookmarkID
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If Err.Description <> "" Then
getErrMsg "There was an error = " & Err.Description
Else
bTmp = True
End If
delBookmark = bTmp
End Function
Function chkFriend(iMemID,iFriendID)
Dim bTemp,strSql,rsChk
bTemp = False
strSql = "SELECT F_FRIEND FROM " & strTablePrefix & "FRIENDS " & _
"WHERE F_MEMBER = " & iMemID & " AND F_FRIEND = " & iFriendID
Set rsChk = my_Conn.Execute (strSql)
If rsChk.EOF or rsChk.BOF Then
bTemp = True
chkFriend = bTemp
Set rsChk = Nothing
Else
rsChk.Close
Set rsChk = Nothing
getErrMsg "Member already exists in your friends' folder.<br /><br /><a href=""active.asp"">Community</a>"
End If
End Function
Function addFriend(iMemID,iFriendID,iLev)
Dim bTmp, strSql
bTmp = False
strSql = "INSERT INTO " & strTablePrefix & "FRIENDS " & _
"(F_MEMBER, F_FRIEND, F_LEVEL, F_DATE) VALUES " & _
"(" & iMemID & ", " & iFriendID & ", " & iLev & ", '" & DateToStr(strForumTimeAdjust) & "')"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If err.Description <> "" Then
getErrMsg err.Description, 0
Else
bTmp = True
End If
addFriend = bTmp
If strEmail = "1" Then
strRecipientsName = FriendName
strRecipients = FriendMail
strFrom = strSender
strFromName = strForumTitle
strSubject = strForumTitle & " Friends' List "
strMessage = "Hello " & FriendName & vbNewline & vbNewline
If Request("Confirm")>"" Then
strMessage = strMessage & "You received this message from " & strForumTitle & " because " & strDBNTUserName & " confirmed your request for friendship on the forums at " & strForumURL & vbNewline & vbNewline
Else
strMessage = strMessage & "You received this message from " & strForumTitle & " because " & strDBNTUserName & " wishes to befriend you on the forums at " & strForumURL & vbNewline & vbNewline
strMessage = strMessage & "To ignore " & strDBNTUserName & "'s request, simply do nothing." & vbNewline & vbNewline
strMessage = strMessage & "To confirm " & strDBNTUserName & "'s request, click on link below or copy and paste link into your browser: " & strForumURL & "pop_user_space.asp?mode=friends&Confirm=1&action=add&id=" & MemberID & vbNewline & vbNewline
strMessage = strMessage & "or, if you have already added " & strDBNTUserName & " as a friend, you can remove " & strDBNTUserName & " from your friends' list here: " & strForumURL & "pop_user_space.asp?mode=friends&action=delete&id=" & MemberID & vbNewline & vbNewline
End If
%>
<!--#INCLUDE FILE="inc_mail.asp" -->
<%
End If
End Function
Function delFriend(iMemID,iFriendID)
Dim bTmp, strSql
bTmp = False
strSql = "DELETE FROM " & strTablePrefix & "FRIENDS " & _
"WHERE F_MEMBER = " & iMemID & " AND FRIEND_ID = " & iFriendID
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
If err.Description <> "" Then
getErrMsg err.Description, 0
Else
bTmp = True
End If
delFriend = bTmp
End Function
%>
|
Edited by - Carefree on 18 February 2014 18:19:27 |
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 18 February 2014 : 12:18:30
|
Error message:
Problem - Not getting a topic id
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Carefree
Advanced Member
Philippines
4207 Posts |
Posted - 18 February 2014 : 15:09:57
|
| There you have it. The issue isn't with this file but with the link going to it from "topic.asp". Post a link to a .txt version and we'll take a quick look. |
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 18 February 2014 : 17:56:26
|
Here ya go!
I really do appreciate your time with this!
<%
'#################################################################################
'## Snitz Forums 2000 v3.4.07
'#################################################################################
'## Copyright (C) 2000-06 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<%
if (Request.QueryString("TOPIC_ID") = "" or IsNumeric(Request.QueryString("TOPIC_ID")) = False) and Request.Form("Method_Type") <> "login" and Request.Form("Method_Type") <> "logout" then
Response.Redirect "default.asp"
Response.End
else
Topic_ID = cLng(Request.QueryString("TOPIC_ID"))
end if
Dim ArchiveView, ArchiveLink, CColor
if request("ARCHIVE") = "true" then
strActivePrefix = strTablePrefix & "A_"
ArchiveView = "true"
ArchiveLink = "ARCHIVE=true&"
elseif request("ARCHIVE") <> "" then
Response.Redirect "default.asp"
Response.End
else
strActivePrefix = strTablePrefix
ArchiveView = ""
ArchiveLink = ""
end if
%>
<!--#INCLUDE FILE="inc_sha256.asp"-->
<!--#INCLUDE FILE="inc_header.asp" -->
<!--#INCLUDE FILE="inc_func_secure.asp" -->
<!--#INCLUDE FILE="inc_func_member.asp" -->
<!--#INCLUDE FILE="inc_subscription.asp" -->
<!--#INCLUDE FILE="inc_moderation.asp" -->
<%
Response.Write " <script language=""JavaScript"" type=""text/javascript"">" & vbNewLine & _
" function ChangePage(fnum){" & vbNewLine & _
" if (fnum == 1) {" & vbNewLine & _
" document.PageNum1.submit();" & vbNewLine & _
" }" & vbNewLine & _
" else {" & vbNewLine & _
" document.PageNum2.submit();" & vbNewLine & _
" }" & vbNewLine & _
" }" & vbNewLine & _
" </script>" & vbNewLine
mypage = request("whichpage")
if ((Trim(mypage) = "") or (IsNumeric(mypage) = False)) then mypage = 1
mypage = cLng(mypage)
if Request("SearchTerms") <> "" then
SearchLink = "&SearchTerms=" & Request("SearchTerms")
else
SearchLink = ""
end if
if strSignatures = "1" and strDSignatures = "1" then
if ViewSig(MemberID) <> "0" then
CanShowSignature = 1
end if
end if
'## Forum_SQL - Get original topic and check for the Category, Forum or Topic Status and existence
' ## Poll Below
strSql = "SELECT M.M_NAME, M.M_RECEIVE_EMAIL, M.M_AIM, M.M_ICQ, M.M_PMRECEIVE, M.M_MSN, M.M_YAHOO" & _
", M.M_TITLE, M.M_HOMEPAGE, M.MEMBER_ID, M.M_LEVEL, M.M_POSTS, M.M_GLOW_TEXT, M.M_COUNTRY, M.M_SKYPE, M.M_GOOGLETALK" & _
", T.T_DATE, T.T_SUBJECT, T.T_AUTHOR, T.TOPIC_ID, T.T_STATUS, T.T_ISPOLL, T.T_POLLSTATUS, T.T_LAST_EDIT" & _
", T.T_LAST_EDITBY, T.T_LAST_POST, T.T_SIG, T.T_REPLIES" & _
", C.CAT_STATUS, C.CAT_ID, C.CAT_NAME, C.CAT_SUBSCRIPTION, C.CAT_MODERATION" & _
", F.F_STATUS, F.F_POLLS, F.FORUM_ID, F.F_SUBSCRIPTION, F.F_SUBJECT, F.F_MODERATION, F.F_RATING_AUTH, T.ALLOW_RATING, T.T_MSGICON, T.T_MESSAGE"
' ## Poll Above
if CanShowSignature = 1 then
strSql = strSql & ", M.M_SIG"
end if
if CanShowAvatar = 1 then
strSql = strSql & ", M.M_AVATAR_URL"
end if
strSql = strSql & " FROM " & strActivePrefix & "TOPICS T, " & strTablePrefix & "FORUM F, " & _
strTablePrefix & "CATEGORY C, " & strMemberTablePrefix & "MEMBERS M " & _
" WHERE T.TOPIC_ID = " & Topic_ID & _
" AND F.FORUM_ID = T.FORUM_ID " & _
" AND C.CAT_ID = T.CAT_ID " & _
" AND M.MEMBER_ID = T.T_AUTHOR "
set rsTopic = Server.CreateObject("ADODB.Recordset")
rsTopic.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rsTopic.EOF then
recTopicCount = ""
else
recTopicCount = 1
Member_Name = rsTopic("M_NAME")
Member_ReceiveMail = rsTopic("M_RECEIVE_EMAIL")
Member_AIM = rsTopic("M_AIM")
Member_ICQ = rsTopic("M_ICQ")
Member_MSN = rsTopic("M_MSN")
Member_GOOGLETALK = rsTopic("M_GOOGLETALK")
Member_SKYPE = rsTopic("M_SKYPE")
Member_YAHOO = rsTopic("M_YAHOO")
Member_PM = rsTopic("M_PMRECEIVE")
Member_Title = rsTopic("M_TITLE")
Member_Homepage = rsTopic("M_HOMEPAGE")
TMember_ID = rsTopic("MEMBER_ID")
Member_Level = rsTopic("M_LEVEL")
Member_Posts = rsTopic("M_POSTS")
Member_Country = rsTopic("M_COUNTRY")
Member_GlowText = rsTopic("M_GLOW_TEXT")
Topic_Date = rsTopic("T_DATE")
Topic_Subject = rsTopic("T_SUBJECT")
Topic_Author = rsTopic("T_AUTHOR")
TopicID = rsTopic("TOPIC_ID")
Topic_Status = rsTopic("T_STATUS")
Topic_LastEdit = rsTopic("T_LAST_EDIT")
Topic_LastEditby = rsTopic("T_LAST_EDITBY")
Topic_LastPost = rsTopic("T_LAST_POST")
Topic_Sig = rsTopic("T_SIG")
Topic_Replies = rsTopic("T_REPLIES")
Cat_Status = rsTopic("CAT_STATUS")
Cat_ID = rsTopic("CAT_ID")
Cat_Name = rsTopic("CAT_NAME")
Cat_Subscription = rsTopic("CAT_SUBSCRIPTION")
Cat_Moderation = rsTopic("CAT_MODERATION")
Forum_Status = rsTopic("F_STATUS")
Forum_ID = rsTopic("FORUM_ID")
Forum_Subject = rsTopic("F_SUBJECT")
Forum_Subscription = rsTopic("F_SUBSCRIPTION")
Forum_Moderation = rsTopic("F_MODERATION")
Topic_MsgIcon = rsTopic("T_MSGICON")
Topic_Message = rsTopic("T_MESSAGE")
intRatingAuth = rsTopic("F_RATING_AUTH")
Allow_Rating = rsTopic("ALLOW_RATING")
if CanShowSignature = 1 then
Topic_MemberSig = trim(rsTopic("M_SIG"))
end if
if CanShowAvatar = 1 then
Member_Avatar = rsTopic("M_AVATAR_URL")
end if
' ## Poll Below
IsPoll = rsTopic("T_ISPOLL")
Forum_Polls = rsTopic("F_POLLS")
Poll_Status = rsTopic("T_POLLSTATUS")
if IsPoll = 1 then
strSql = "SELECT P.P_LASTVOTE, P.P_WHOVOTES, P.P_ENDDATE"
For i = 1 To 15
strSql = strSql & ", P.ANSWER" & CStr(i)
strSql = strSql & ", P.COUNT" & CStr(i)
Next
strSql = strSql & " FROM " & strTablePrefix & "POLLS P"
strSql = strSql & " WHERE P.TOPIC_ID = " & Topic_ID
set rsPoll = Server.CreateObject("ADODB.Recordset")
rsPoll.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if not(rsPoll.EOF) or not(rsPoll.BOF) then
Last_Vote = rsPoll("P_LASTVOTE")
strWhoVotes = rsPoll("P_WHOVOTES")
strPEndDate = rsPoll("P_ENDDATE")
For nCount = 1 to 15
'Loop through answer and count fields for the poll
'and store them in arrays
vAnswers(nCount) = rsPoll("ANSWER" & CStr(nCount))
vCount(nCount) = rsPoll("COUNT" & CStr(nCount))
Next
end if
rsPoll.Close
set rsPoll = nothing
If strPEndDate<=datetostr(strForumTimeAdjust) then
Poll_Status=0
End If
end if
if IsPoll = 1 then
pollLink = "poll=1&"
else
pollLink = ""
end if
' ## Poll Above
end if
rsTopic.close
set rsTopic = nothing
'## Events Calendar - Check if this topic is an event
blnEvent = TRUE
strSQL = "SELECT EVENT_DATE FROM " & strTablePrefix & "CAL_EVENTS WHERE TOPIC_ID = " & Topic_ID & " ORDER BY EVENT_DATE"
set rsCal = Server.CreateObject("ADODB.Recordset")
rsCal.open StrSql, My_conn
If rsCal.EOF then blnEvent = FALSE else arrDates = rsCal.GetRows
rsCal.close
set rsCal = nothing
if recTopicCount = "" then
if ArchiveView <> "true" then
Response.Redirect("topic.asp?ARCHIVE=true&" & ChkString(Request.QueryString,"sqlstring"))
else
Response.Redirect("default.asp")
end if
end if
' ## Poll Below
if IsPoll = 1 then
'Check to see if user has voted
Voted = GetVote(Topic_ID)
end if
' ## Poll Above
if mLev = 4 then
AdminAllowed = 1
ForumChkSkipAllowed = 1
elseif mLev = 3 then
if chkForumModerator(Forum_ID, chkString(strDBNTUserName,"decode")) = "1" then
AdminAllowed = 1
ForumChkSkipAllowed = 1
else
if lcase(strNoCookies) = "1" then
AdminAllowed = 1
ForumChkSkipAllowed = 0
else
AdminAllowed = 0
ForumChkSkipAllowed = 0
end if
end if
elseif lcase(strNoCookies) = "1" then
AdminAllowed = 1
ForumChkSkipAllowed = 0
else
AdminAllowed = 0
ForumChkSkipAllowed = 0
end if
if strPrivateForums = "1" and (Request.Form("Method_Type") <> "login") and (Request.Form("Method_Type") <> "logout") and ForumChkSkipAllowed = 0 then
result = ChkForumAccess(Forum_ID, MemberID, true)
end if
if strModeration > 0 and Cat_Moderation > 0 and Forum_Moderation > 0 and AdminAllowed = 0 then
Moderation = "Y"
else
Moderation = "N"
end if
if mypage = -1 then
strSql = "SELECT REPLY_ID FROM " & strActivePrefix & "REPLY WHERE TOPIC_ID = " & Topic_ID & " "
if AdminAllowed = 0 then
strSql = strSql & " AND (R_STATUS < "
if Moderation = "Y" then
strSql = strSql & "2 "
else
strSql = strSql & "3 "
end if
strSql = strSql & "OR R_AUTHOR = " & MemberID & ") "
end if
strSql = strSql & "ORDER BY R_DATE ASC "
set rsReplies = Server.CreateObject("ADODB.Recordset")
if strDBType = "mysql" then
rsReplies.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
else
rsReplies.open strSql, my_Conn, adOpenStatic, adLockReadOnly, adCmdText
end if
if not rsReplies.EOF then
arrReplyData = rsReplies.GetRows(adGetRowsRest)
iReplyCount = UBound(arrReplyData, 2)
if Request.Querystring("REPLY_ID") <> "" and IsNumeric(Request.Querystring("REPLY_ID")) then
LastPostReplyID = cLng(Request.Querystring("REPLY_ID"))
for iReply = 0 to iReplyCount
intReplyID = arrReplyData(0, iReply)
if LastPostReplyID = intReplyID then
intPageNumber = ((iReply+1)/strPageSize)
exit for
end if
next
else
LastPostReplyID = cLng(arrReplyData(0, iReplyCount))
intPageNumber = ((iReplyCount+1)/strPageSize)
end if
if intPageNumber > cLng(intPageNumber) then
intPageNumber = cLng(intPageNumber) + 1
end if
strwhichpage = "whichpage=" & intPageNumber & "&"
else
strwhichpage = ""
end if
rsReplies.close
set rsReplies = nothing
my_Conn.close
set my_Conn = nothing
Response.Redirect "topic.asp?" & ArchiveLink & strwhichpage & "TOPIC_ID=" & Topic_ID & SearchLink & "#" & LastPostReplyID
Response.End
end if
' -- Get all the high level(board, category, forum) subscriptions being held by the user
Dim strSubString, strSubArray, strBoardSubs, strCatSubs, strForumSubs, strTopicSubs
if MySubCount > 0 then
strSubString = PullSubscriptions(0, 0, 0)
strSubArray = Split(strSubString,";")
if uBound(strSubArray) < 0 then
strBoardSubs = ""
strCatSubs = ""
strForumSubs = ""
strTopicSubs = ""
else
strBoardSubs = strSubArray(0)
strCatSubs = strSubArray(1)
strForumSubs = strSubArray(2)
strTopicSubs = strSubArray(3)
end if
end If
if (Moderation = "Y" and Topic_Status > 1 and Topic_Author <> MemberID) then
Response.write "<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><br />Viewing of this Topic is not permitted until it has been moderated.<br />Please try again later</font></p>" & vbNewLine & _
"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><a href=""JavaScript:history.go(-1)"">Go Back</a></font></p><br />" & vbNewLine
WriteFooter
Response.end
else
Response.Write " <script language=""JavaScript"" type=""text/javascript"">" & vbNewLine & _
" <!--" & vbNewLine & _
" function jumpTo(s) {if (s.selectedIndex != 0) location.href = s.options[s.selectedIndex].value;return 1;}" & vbNewLine & _
" // -->" & vbNewLine & _
" </script>" & vbNewLine
'## Forum_SQL
strSql = "SELECT M.M_NAME, M.M_RECEIVE_EMAIL, M.M_AIM, M.M_ICQ, M.M_MSN, M.M_GOOGLETALK, M.M_SKYPE, M.M_YAHOO, M.M_PMRECEIVE"
strSql = strSql & ", M.M_TITLE, M.MEMBER_ID, M.M_HOMEPAGE, M.M_LEVEL, M.M_POSTS, M.M_COUNTRY, M.M_GLOW_TEXT"
strSql = strSql & ", R.REPLY_ID, R.FORUM_ID, R.R_AUTHOR, R.TOPIC_ID, R.R_MESSAGE, R.R_LAST_EDIT"
strSql = strSql & ", R.R_LAST_EDITBY, R.R_SIG, R.R_STATUS, R.R_DATE, R.R_MSGICON"
if CanShowSignature = 1 then
strSql = strSql & ", M.M_SIG"
end if
if CanShowAvatar = 1 then
strSql = strSql & ", M.M_AVATAR_URL"
end if
strSql2 = " FROM " & strMemberTablePrefix & "MEMBERS M, " & strActivePrefix & "REPLY R "
strSql3 = " WHERE M.MEMBER_ID = R.R_AUTHOR "
strSql3 = strSql3 & " AND R.TOPIC_ID = " & Topic_ID & " "
' DEM --> if not a Moderator, all unapproved posts should not be viewed.
if AdminAllowed = 0 then
strSql3 = strSql3 & " AND (R.R_STATUS < "
if Moderation = "Y" then
' Ignore unapproved/rejected posts
strSql3 = strSql3 & "2"
else
' Ignore any previously rejected topic
strSql3 = strSql3 & "3"
end if
strSql3 = strSql3 & " OR R.R_AUTHOR = " & MemberID & ")"
end if
strSql4 = " ORDER BY R.R_DATE ASC"
if strDBType = "mysql" then 'MySql specific code
if mypage > 1 then
intOffset = cLng((mypage-1) * strPageSize)
strSql5 = " LIMIT " & intOffset & ", " & strPageSize & " "
end if
'## Forum_SQL - Get the total pagecount
strSql1 = "SELECT COUNT(R.TOPIC_ID) AS REPLYCOUNT "
set rsCount = my_Conn.Execute(strSql1 & strSql2 & strSql3)
iPageTotal = rsCount(0).value
rsCount.close
set rsCount = nothing
if iPageTotal > 0 then
maxpages = (iPageTotal \ strPageSize )
if iPageTotal mod strPageSize <> 0 then
maxpages = maxpages + 1
end if
if iPageTotal < (strPageSize + 1) then
intGetRows = iPageTotal
elseif (mypage * strPageSize) > iPageTotal then
intGetRows = strPageSize - ((mypage * strPageSize) - iPageTotal)
else
intGetRows = strPageSize
end if
else
iPageTotal = 0
maxpages = 0
end if
if iPageTotal > 0 then
set rsReplies = Server.CreateObject("ADODB.Recordset")
rsReplies.Open strSql & strSql2 & strSql3 & strSql4 & strSql5, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
arrReplyData = rsReplies.GetRows(intGetRows)
iReplyCount = UBound(arrReplyData, 2)
rsReplies.Close
set rsReplies = nothing
else
iReplyCount = ""
end if
else 'end MySql specific code
set rsReplies = Server.CreateObject("ADODB.Recordset")
rsReplies.cachesize = strPageSize
rsReplies.open strSql & strSql2 & strSql3 & strSql4, my_Conn, adOpenStatic, adLockReadOnly, adCmdText
if not (rsReplies.EOF or rsReplies.BOF) then
rsReplies.pagesize = strPageSize
rsReplies.absolutepage = mypage '**
maxpages = cLng(rsReplies.pagecount)
if maxpages >= mypage then
arrReplyData = rsReplies.GetRows(strPageSize)
iReplyCount = UBound(arrReplyData, 2)
else
iReplyCount = ""
end if
else '## No replies found in DB
iReplyCount = ""
end if
rsReplies.Close
set rsReplies = nothing
end if
' ## Poll Below
Select Case Request.Form("Method_Type")
Case "member_vote"
if Request.Form("R1") = "" then
Response.Write "<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """> </font></p>" & vbNewLine & _
"<table align=""center"" border=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """>You must choose an answer in order for your vote to be counted!</font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><br /><br /><a href=""JavaScript:history.go(-1)"">Go Back To Vote</a></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine & _
"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """> </font></p>" & vbNewLine
WriteFooter
Response.End
elseif strWhoVotes = "members" and MemberID = "-1" then
Response.Write "<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """> </font></p>" & vbNewLine & _
"<table align=""center"" border=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """>You need to be a member in order to vote!</font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><br /><br /><a href=""JavaScript:history.go(-1)"">Go Back to the forum</a></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine & _
"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """> </font></p>" & vbNewLine
WriteFooter
Response.End
elseif Voted = true then
Response.Write "<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """> </font></p>" & vbNewLine & _
"<table align=""center"" border=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """>You may only vote once per poll!</font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><br /><br /><a href=""JavaScript:history.go(-1)"">Go Back and click on ""View Results"" to see the results.</a></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine & _
"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """> </font></p>" & vbNewLine
WriteFooter
Response.End
elseif trim(Request.Form("R1")) <> "" then
if IsNumeric(Request.Form("R1")) = false then
nNumber = -1
else
nNumber = cLng(Request.Form("R1"))
end if
if nNumber <> -1 then
strSql = "UPDATE " & strTablePrefix & "POLLS "
strSql = strSql & " SET COUNT" & nNumber & " = COUNT" & nNumber & " +1"
strSql = strSql & ", P_LASTVOTE = '" & DateToStr(strForumTimeAdjust) & "'"
strSql = strSql & " WHERE TOPIC_ID = " & Topic_ID
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
Voted = true
strSql = "SELECT " & strTablePrefix & "POLLS.P_LASTVOTE"
For i = 1 To 15
strSql = strSql & ", " & strTablePrefix & "POLLS.ANSWER" & CStr(i)
strSql = strSql & ", " & strTablePrefix & "POLLS.COUNT" & CStr(i)
Next
strSql = strSql & " FROM " & strTablePrefix & "POLLS"
strSql = strSql & " WHERE " & strTablePrefix & "POLLS.TOPIC_ID = " & Topic_ID
set rsPoll = Server.CreateObject("ADODB.Recordset")
rsPoll.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
Last_Vote = rsPoll("P_LASTVOTE")
For nCount = 1 to 15
vAnswers(nCount) = rsPoll("ANSWER" & CStr(nCount))
vCount(nCount) = rsPoll("COUNT" & CStr(nCount))
Next
rsPoll.Close
set rsPoll = nothing
Call UpdateVote("0", MemberID, Topic_ID, Forum_ID, Cat_ID)
end if
end if
Case "guest_vote" '# User is viewing results - no vote
if strVResults = "0" and Voted <> true then
Call UpdateVote("1", MemberID, Topic_ID, Forum_ID, Cat_ID)
end if
Case else
if strVResults = "0" and Request.QueryString("results") = "1" and Voted = false then
Response.Write "<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """> </font></p>" & vbNewLine & _
"<table align=""center"" border=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """>You cannot view the poll results before you vote!</font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><br /><br /><a href=""JavaScript:history.go(-1)"">Go Back to Vote.</a></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine & _
"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """> </font></p>" & vbNewLine
WriteFooter
Response.End
end if
End Select
' ## Poll Above
Response.Write " <table border=""0"" width=""100%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td width=""50%"" align=""left"" nowrap><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
" " & getCurrentIcon(strIconFolderOpen,"","align=""absmiddle""") & " <a href=""default.asp"">COMMUNITY HOME</a><br />" & vbNewLine & _
" " & getCurrentIcon(strIconBar,"","align=""absmiddle""")
if Cat_Status <> 0 then
Response.Write getCurrentIcon(strIconFolderOpen,"","align=""absmiddle""")
else
Response.Write getCurrentIcon(strIconFolderClosed,"","align=""absmiddle""")
end if
Response.Write " <a href=""default.asp?CAT_ID=" & Cat_ID & """>" & ChkString(Cat_Name,"display") & "</a><br />" & vbNewLine & _
" " & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBar,"","align=""absmiddle""")
if ArchiveView = "true" then
Response.Write getCurrentIcon(strIconFolderArchived,"","align=""absmiddle""")
else
if Forum_Status <> 0 and Cat_Status <> 0 then
Response.Write getCurrentIcon(strIconFolderOpen,"","align=""absmiddle""")
else
Response.Write getCurrentIcon(strIconFolderClosed,"","align=""absmiddle""")
end if
end if
Response.Write " <a href=""forum.asp?" & ArchiveLink & "FORUM_ID=" & Forum_ID & """>" & ChkString(Forum_Subject,"display") & "</a><br />" & vbNewLine
if ArchiveView = "true" then
Response.Write " " & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBar,"","align=""absmiddle""") & getCurrentIcon(strIconFolderArchived,"","align=""absmiddle""") & " "
elseif blnEvent then
Response.Write " " & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBar,"","align=""absmiddle""") & getCurrentIcon(strCalIconEvent,"","align=""absmiddle""") & " " & strCalEvent & ": "
elseif Cat_Status <> 0 and Forum_Status <> 0 and Topic_Status <> 0 then
Response.Write " " & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBar,"","align=""absmiddle""") & getCurrentIcon(strIconFolderOpenTopic,"","align=""absmiddle""") & " "
else
Response.Write " " & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBar,"","align=""absmiddle""") & getCurrentIcon(strIconFolderClosedTopic,"","align=""absmiddle""") & " "
end if
if Request.QueryString("SearchTerms") <> "" then
Response.Write SearchHiLite(ChkString(Topic_Subject,"title"))
else
Response.Write ChkString(Topic_Subject,"title")
end if
Response.Write "</font></td>" & vbNewLine & _
" <td align=""center"" width=""50%"">" & vbNewLine
call PostingOptions()
Response.Write "</td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine
if maxpages > 1 then
Response.Write "<table align=""center"" border=""0"" cellPadding=""0"" cellSpacing=""1"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""right"" valign=""top""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>"
if mypage > 1 then Response.Write("<a href=""topic.asp?" & ArchiveLink & "TOPIC_ID=" & Topic_ID & "&whichpage=" & mypage-1 & SearchLink & """ title=""Goto the Previous page in this Topic""" & dWStatus("Goto the Previous page in this Topic") & ">Previous Page</a>")
'if mypage > 1 then Response.Write("<a href=""javascript: onclick=document.PageNum1.whichpage.value=" & mypage-1 & ";document.PageNum1.submit();"" title=""Goto the Previous page in this Topic""" & dWStatus("Goto the Previous page in this Topic") & ">Previous Page</a>")
if mypage > 1 and mypage < maxpages then Response.Write(" | ")
if mypage < maxpages then Response.Write("<a href=""topic.asp?" & ArchiveLink & "TOPIC_ID=" & Topic_ID & "&whichpage=" & mypage+1 & SearchLink & """ title=""Goto the Next page in this Topic""" & dWStatus("Goto the Next page in this Topic") & ">Next Page</a>")
'if mypage < maxpages then Response.Write("<a href=""javascript: onclick=document.PageNum1.whichpage.value=" & mypage+1 & ";document.PageNum1.submit();"" title=""Goto the Next page in this Topic""" & dWStatus("Goto the Next page in this Topic") & ">Next Page</a>")
Response.Write "</td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine
end if
Response.Write "<table align=""center"" border=""0"" cellPadding=""0"" cellSpacing=""0"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td>" & vbNewLine & _
" <table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgcolor=""" & strTableBorderColor & """>" & vbNewLine & _
" <table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""4"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center"" bgcolor=""" & strHeadCellColor & """ width=""" & strTopicWidthLeft & """"
if lcase(strTopicNoWrapLeft) = "1" then Response.Write(" nowrap")
Response.Write "><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>Author</font></b></td>" & vbNewLine & _
" <td align=""center"" bgcolor=""" & strHeadCellColor & """ width=""" & strTopicWidthRight & """"
if lcase(strTopicNoWrapRight) = "1" then Response.Write(" nowrap")
Response.Write "><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>" & vbNewLine
if strShowTopicNav = "1" then
Call Topic_nav()
else
Response.Write("Topic")
end if
Response.Write "</font></b></td>" & vbNewLine
if (AdminAllowed = 1) then
if maxpages > 1 then
Call DropDownPaging(1)
Response.Write " <td align=""right"" bgcolor=""" & strHeadCellColor & """ nowrap>" & vbNewLine
call AdminOptions()
Response.Write " </td>" & vbNewLine
else
Response.Write " <td align=""right"" bgcolor=""" & strHeadCellColor & """ nowrap>" & vbNewLine
call AdminOptions()
Response.Write " </td>" & vbNewLine
end if
else
if maxpages > 1 then
Call DropDownPaging(1)
else
Response.Write " <td align=""right"" bgcolor=""" & strHeadCellColor & """ nowrap><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """> </font></td>" & vbNewLine
end if
end if
Response.Write " </tr>" & vbNewLine
'## Ignore post mod. Lets poulate the array with the ignored members ID
if strIgnorePost = "1" then
arrIgnoreMemberList = IgnoreMemberList()
end if
'## Ignore post mod above
if mypage = 1 then
Call GetFirst()
end if
'## Forum_SQL
strSql = "UPDATE " & strActivePrefix & "TOPICS "
strSql = strSql & " SET T_VIEW_COUNT = (T_VIEW_COUNT + 1) "
strSql = strSql & " WHERE (TOPIC_ID = " & Topic_ID & ")"
my_conn.Execute (strSql),,adCmdText + adExecuteNoRecords
if iReplyCount = "" then '## No replies found in DB
' Nothing
else
intI = 0
rM_NAME = 0
rM_RECEIVE_EMAIL = 1
rM_AIM = 2
rM_ICQ = 3
rM_MSN = 4
rM_GOOGLETALK = 5
rM_SKYPE = 6
rM_YAHOO = 7
rM_PM = 8
rM_TITLE = 9
rMEMBER_ID = 10
rM_HOMEPAGE = 11
rM_LEVEL = 12
rM_POSTS = 13
rM_COUNTRY = 14
rM_GLOW_TEXT = 15
rREPLY_ID = 16
rFORUM_ID = 17
rR_AUTHOR = 18
rTOPIC_ID = 19
rR_MESSAGE = 20
rR_LAST_EDIT = 21
rR_LAST_EDITBY = 22
rR_SIG = 23
rR_STATUS = 24
rR_DATE = 25
rR_MSGICON = 26
if CanShowSignature = 1 then
rM_SIG = 27
end if
if CanShowAvatar = 1 then
if CanShowSignature = 1 then
rM_AVATAR = 28
else
rM_AVATAR = 27
end if
end if
for iForum = 0 to iReplyCount
Reply_MemberName = arrReplyData(rM_NAME, iForum)
Reply_MemberReceiveEmail = arrReplyData(rM_RECEIVE_EMAIL, iForum)
Reply_MemberAIM = arrReplyData(rM_AIM, iForum)
Reply_MemberICQ = arrReplyData(rM_ICQ, iForum)
Reply_MemberMSN = arrReplyData(rM_MSN, iForum)
Reply_MemberGOOGLETALK = arrReplyData(rM_GOOGLETALK, iForum)
Reply_MemberSKYPE = arrReplyData(rM_SKYPE, iForum)
Reply_MemberYAHOO = arrReplyData(rM_YAHOO, iForum)
Reply_MemberPM = arrReplyData(rM_PM, iForum)
Reply_MemberTitle = arrReplyData(rM_TITLE, iForum)
Reply_MemberID = arrReplyData(rMEMBER_ID, iForum)
Reply_MemberHomepage = arrReplyData(rM_HOMEPAGE, iForum)
Reply_MemberLevel = arrReplyData(rM_LEVEL, iForum)
Reply_MemberPosts = arrReplyData(rM_POSTS, iForum)
Reply_MemberCountry = arrReplyData(rM_COUNTRY, iForum)
Reply_MemberGlowText = arrReplyData(rM_GLOW_TEXT, iForum)
Reply_ReplyID = arrReplyData(rREPLY_ID, iForum)
Reply_ForumID = arrReplyData(rFORUM_ID, iForum)
Reply_Author = arrReplyData(rR_AUTHOR, iForum)
Reply_TopicID = arrReplyData(rTOPIC_ID, iForum)
Reply_Content = arrReplyData(rR_MESSAGE, iForum)
Reply_LastEdit = arrReplyData(rR_LAST_EDIT, iForum)
Reply_LastEditBy = arrReplyData(rR_LAST_EDITBY, iForum)
Reply_Sig = arrReplyData(rR_SIG, iForum)
Reply_Status = arrReplyData(rR_STATUS, iForum)
Reply_Date = arrReplyData(rR_DATE, iForum)
Reply_MsgIcon = arrReplyData(rR_MSGICON, iForum)
if CanShowSignature = 1 then
Reply_MemberSig = trim(arrReplyData(rM_SIG, iForum))
end if
if CanShowAvatar = 1 then
Reply_MemberAvatar = trim(arrReplyData(rM_AVATAR, iForum))
end if
if intI = 0 then
CColor = strAltForumCellColor
else
CColor = strForumCellColor
end if
Response.Write " <tr>" & vbNewLine & _
" <td bgcolor=""" & CColor & """ valign=""top"" width=""" & strTopicWidthLeft & """"
if lcase(strTopicNoWrapLeft) = "1" then Response.Write(" nowrap")
Response.Write ">" & vbNewLine & _
" <p><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b><span class=""spnMessageText"" style=""width:0; height:0; " & Reply_MemberGlowText & """>" & profileLink(ChkString(Reply_MemberName,"display"),Reply_Author) & "</span></b></font><br />" & VbNewLine
if strShowRank = 1 or strShowRank = 3 then
Response.Write " <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>" & ChkString(getMember_Level(Reply_MemberTitle, Reply_MemberLevel, Reply_MemberPosts),"display") & "</small></font><br />" & vbNewLine
end if
if strShowRank = 2 or strShowRank = 3 then
Response.Write " " & getStar_Level(Reply_MemberLevel, Reply_MemberPosts) & "<br />" & vbNewLine
end if
Response.Write " </p>" & vbNewLine & _
" <p>" & vbNewLine
if CanShowAvatar = 1 and Reply_MemberAvatar <> "noavatar.gif" then
Response.Write " <table width=""" & intAvatarWidth & """ height= """ & intAvatarHeight & """ cellspacing=""0"" cellpadding=""0"" border=""0"" style="" background-image: url('" & Reply_MemberAvatar & "');background-repeat: no-repeat; background-position: center;"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><img src=""" & strImageURL & "noavatar.gif"" width=""96"" height=""96"" border=""0""></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine
end if
if strCountry = "1" and trim(Reply_MemberCountry) <> "" then
Response.Write " <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>" & Reply_MemberCountry & "</small></font><br /><img src=""" & strImageURL & Reply_MemberCountry & ".gif""><br />" & vbNewLine
end if
Response.Write " <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>" & Reply_MemberPosts & " Posts</small></font></p></td>" & vbNewLine & _
" <td bgcolor=""" & CColor & """ height=""100%"" width=""" & strTopicWidthRight & """"
if lcase(strTopicNoWrapRight) = "1" then Response.Write(" nowrap")
if (AdminAllowed = 1) and (maxpages > 1) then
Response.Write (" colspan=""3"" ")
else
Response.Write (" colspan=""2"" ")
end if
Response.Write "valign=""top""><a name=""" & Reply_ReplyID & """></a>" & vbNewLine & _
" <table width=""100%"" height=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td valign=""top"">" & vbNewLine
' DEM --> Start of Code altered for moderation
if Reply_Status < 2 then
Response.Write " " & getCurrentIcon(getCurrentMsgIcon(Reply_MsgIcon),"","hspace=""3""") & "<font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>Posted - " & ChkDate(Reply_Date, " : " ,true) & "</font>" & vbNewline
elseif Reply_Status = 2 then
Response.Write " <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>NOT MODERATED!!!</font>" & vbNewline
elseif Reply_Status = 3 then
Response.Write " " & getCurrentIcon(strIconPosticonHold,"","hspace=""3""") & "<font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>ON HOLD</font>" & vbNewline
end if
' DEM --> End of Code added for moderation.
Response.Write " <a href=""JavaScript:openWindowLink('pop_link_reply.asp?TOPIC_ID=" & Topic_ID & "&REPLY_ID=" & Reply_ReplyID & "')"">" & getCurrentIcon(strIconLinkTo,"Share a link to this reply","align=""absmiddle"" hspace=""3""") & "</a>" & vbNewLine
Response.Write " " & profileLink(getCurrentIcon(strIconProfile,"View This Member's Profile","align=""absmiddle"" hspace=""6"""),Reply_MemberID) & vbNewLine
if mLev > 2 or Reply_MemberReceiveEmail = "1" then
if (mlev <> 0) or (mlev = 0 and strLogonForMail <> "1") then
Response.Write " <a href=""JavaScript:openWindow5('pop_mail.asp?id=" & Reply_MemberID & "')"">" & getCurrentIcon(strIconEmail,"Send An Email To This Member","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if strHomepage = "1" then
if Reply_MemberHomepage <> " " then
Response.Write " <a href=""" & Reply_MemberHomepage & """ target=""_blank"">" & getCurrentIcon(strIconHomepage,"Visit " & ChkString(Reply_MemberName,"display") & "'s Homepage","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if (AdminAllowed = 1 or Reply_MemberID = MemberID) then
if (Cat_Status <> 0 and Forum_Status <> 0 and Topic_Status <> 0) or (AdminAllowed = 1) then
Response.Write " <a href=""post.asp?" & ArchiveLink & "method=Edit&REPLY_ID=" & Reply_ReplyID & "&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconEditTopic,"Edit Reply","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if (strAIM = "1") then
if Trim(Reply_MemberAIM) <> "" then
Response.Write " <a href=""JavaScript:openWindow('pop_messengers.asp?mode=AIM&ID=" & Reply_MemberID & "')"">" & getCurrentIcon(strIconAIM,"Send " & ChkString(Reply_MemberName,"display") & " an AOL message","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if strICQ = "1" then
if Trim(Reply_MemberICQ) <> "" then
Response.Write " <a href=""JavaScript:openWindow('pop_messengers.asp?mode=ICQ&ID=" & Reply_MemberID & "')"">" & getCurrentIcon(strIconICQ,"Send " & ChkString(Reply_MemberName,"display") & " an ICQ Message","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if (strMSN = "1") then
if Trim(Reply_MemberMSN) <> "" then
Response.Write " <a href=""JavaScript:openWindow('pop_messengers.asp?mode=MSN&ID=" & Reply_MemberID & "')"">" & getCurrentIcon(strIconMSNM,"Click to see " & ChkString(Reply_MemberName,"display") & "'s MSN Messenger address","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if strGOOGLETALK = "1" then
if Trim(Reply_MemberGOOGLETALK) <> "" then
Response.Write " <a href=""JavaScript:openWindow('pop_messengers.asp?mode=GOOGLETALK&ID=" & Reply_MemberID & "')"">" & getCurrentIcon(strIconGOOGLETALK,"Click to see " & ChkString(Reply_MemberName,"display") & "","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if strSKYPE = "1" then
if Trim(Reply_MemberSKYPE) <> "" then
Response.Write " <a href=""JavaScript:openWindow('pop_messengers.asp?mode=SKYPE&ID=" & Reply_MemberID & "')"">" & getCurrentIcon(strIconSKYPE,"Bekijk het Skype telefoon adres van " & ChkString(Reply_MemberName,"display") & "","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if strYAHOO = "1" then
if Trim(Reply_MemberYAHOO) <> "" then
Response.Write " <a href=""http://edit.yahoo.com/config/send_webmesg?.target=" & ChkString(Reply_MemberYAHOO, "urlpath") & "&.src=pg"" target=""_blank"">" & getCurrentIcon(strIconYahoo,"Send " & ChkString(Reply_MemberName,"display") & " a Yahoo! Message","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
'######################## Fame Mod #########################
if TMember_ID <> MemberID and mLev > 1 then
Response.Write "<a href=""pop_fame.asp?topic_id="& topic_id & "&reply_id="& reply_id & """ target=""_blank"">" & getCurrentIcon("" & striconFame & "","Hall of Fame", "align=""middle""") & "</a>" & vbNewLine
end if
'######################## Fame Mod #########################
'##FRIENDS ## User Space Mod ## Add Code Below ##############
if trim(strUSFriendSwitch) <> "" then
if cLng(strUSFriendSwitch) = 1 then
if Reply_MemberID <> MemberID then
Response.Write "<a href=""JavaScript:openWindow5('pop_user_space.asp?mode=friends&id=" & Reply_MemberID & "&action=add&type=0')"">" & getCurrentIcon(strIconFriends,"Add " & ChkString(Reply_MemberName,"display") & " to your friends list","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
end if
'## END #####################################################
'##BOOKMARKS ## User Space Mod ## Add Code below ###############
if trim(strUSBookmarkSwitch) <> "" then
if cLng(strUSBookmarkSwitch) = 1 then
Response.Write "<a href=""JavaScript:openWindow5('pop_user_space.asp?mode=bookmark&action=add&type=post&archive=" & ArchiveView & "&topic_id=" & TopicID & "&reply_id=" & Reply_ReplyID & "')"">" & getCurrentIcon(strIconFavorites,"Bookmark this reply","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
'## End #####################################################
If (Reply_MemberPM = "1" and strPMStatus = "1") Then
if Trim(Reply_MemberPM) <> "" then
Response.Write " <a href=""privatesend.asp?method=Topic&mname=" & ChkString(Reply_MemberName,"display") & """>" & getCurrentIcon(strIconPmprivatemessage,"Send " & ChkString(Reply_MemberName,"display") & " a Private Message","align=""absmiddle"" hspace=""0""") & "</a>" & vbNewLine
End If
End IF
if ((Cat_Status <> 0 and Forum_Status <> 0 and Topic_Status = 1) or (AdminAllowed = 1 and Topic_Status <= 1)) and ArchiveView = "" then
Response.Write " <a href=""post.asp?" & ArchiveLink & "method=ReplyQuote&REPLY_ID=" & Reply_ReplyID & "&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconReplyQuote,"Reply with Quote","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
if (strIPLogging = "1") then
if (AdminAllowed = 1) then
' ########################### Ban IP Mod ###############################
Response.Write " <a href=""JavaScript:openWindow('pop_ban_ip.asp?TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & "')"">" & getCurrentIcon(strIconIP,"View/Ban user's IP address","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
' ####################################################################
end if
end if
if (AdminAllowed = 1 or Reply_MemberID = MemberID) then
if (Cat_Status <> 0 and Forum_Status <> 0 and Topic_Status <> 0) or (AdminAllowed = 1) then
Response.Write " <a href=""JavaScript:openWindow('pop_delete.asp?" & ArchiveLink & "mode=Reply&REPLY_ID=" & Reply_ReplyID & "&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & "')"">" & getCurrentIcon(strIconDeleteReply,"Delete Reply","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
' DEM --> Start of Code added for Full Moderation
if (AdminAllowed = 1 and Reply_Status > 1) then
ReplyString = "REPLY_ID=" & Reply_ReplyID & "&CAT_ID=" & Cat_ID & "&FORUM_ID=" & Forum_ID & "&TOPIC_ID=" & Topic_ID
Response.Write " <a href=""JavaScript:openWindow('pop_moderate.asp?" & ReplyString & "')"">" & getCurrentIcon(strIconFolderModerate,"Approve/Hold/Reject this Reply","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewline
end if
' DEM --> End of Code added for Full Moderation
end if
Response.Write " <hr noshade size=""" & strFooterFontSize & """></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td valign=""top"" height=""100%""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """><span class=""spnMessageText"" id=""msg"">"
If blnEvent Then
%> <!-- #include file="cal_topic.asp" --> <%
End If
'## Ignore Post mod Below
if strIgnorePost = "1" then
boolIgnoreReply = ChkIgnoreList(arrIgnoreMemberList, Reply_MemberID)
end if
if Request.QueryString("SearchTerms") <> "" then
if strIgnorePost = "1" then
if boolIgnoreReply then
WriteIgnPostLinks TopicID, Reply_ReplyID, Reply_MemberID
else
Response.Write SearchHiLite(formatStr(Reply_Content))
end if
else
Response.Write SearchHiLite(formatStr(Reply_Content))
end if
else
if strIgnorePost = "1" then
if boolIgnoreReply then
WriteIgnPostLinks TopicID, Reply_ReplyID, Reply_MemberID
else
Response.Write formatStr(Reply_Content)
end if
else
Response.Write formatStr(Reply_Content)
end if
end if
'## Ignore Post mod Above
Response.Write "</span id=""msg""></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
if CanShowSignature = 1 and Reply_Sig = 1 and Reply_MemberSig <> "" then
Response.Write " <tr>" & vbNewLine & _
" <td valign=""bottom""><hr noshade size=""" & strFooterFontSize & """><font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><span class=""spnMessageText"">" & formatStr(Reply_MemberSig) & "</span></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
end if
if strEditedByDate = "1" and Reply_LastEditBy <> "" then
if Reply_LastEditBy <> Reply_Author then
Reply_LastEditByName = getMemberName(Reply_LastEditBy)
else
Reply_LastEditByName = chkString(Reply_MemberName,"display")
end if
Response.Write " <tr>" & vbNewLine & _
" <td valign=""bottom""><hr noshade size=""1"" color=""" & strForumFontColor & """><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & _
"Edited by - " & Reply_LastEditByName & " on " & chkDate(Reply_LastEdit, " " ,true) & "</font></td>" & vbNewLine & _
" </tr>" & vbNewLine
end if
Response.Write " <tr>" & vbNewLine & _
" <td valign=""bottom"" align=""right"" height=""20""><a href=""#top"">" & getCurrentIcon(strIconGoUp,"Go to Top of Page","align=""right""") & "</a></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine
intI = intI + 1
if intI = 2 then
intI = 0
end if
next
end if
Response.Write " <tr>" & vbNewLine
if maxpages > 1 then
Call DropDownPaging(2)
else
Response.Write " <td align=""center"" bgcolor=""" & strHeadCellColor & """ width=""" & strTopicWidthLeft & """"
if lcase(strTopicNoWrapLeft) = "1" then Response.Write(" nowrap")
Response.Write "><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """> </font></b></td>" & vbNewLine
end if
Response.Write " <td align=""center"" bgcolor=""" & strHeadCellColor & """ width=""" & strTopicWidthRight & """"
if lcase(strTopicNoWrapRight) = "1" then Response.Write(" nowrap")
'if maxpages > 1 and (AdminAllowed = 1) then Response.Write(" colspan=""2""")
Response.Write "><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>" & vbNewLine
if strShowTopicNav = "1" then
Call Topic_nav()
else
Response.Write("Topic")
end if
Response.Write "</font></b></td>" & vbNewLine
if (AdminAllowed = 1) then
if maxpages > 1 then
Response.Write " <td align=""right"" bgcolor=""" & strHeadCellColor & """ nowrap><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """> </font></td>" & vbNewLine
end if
Response.Write " <td align=""right"" bgcolor=""" & strHeadCellColor & """ nowrap>" & vbNewLine
call AdminOptions()
Response.Write "</td>" & vbNewLine
else
Response.Write " <td align=""right"" bgcolor=""" & strHeadCellColor & """ nowrap><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """> </font></td>" & vbNewLine
end if
'## Beginning of modification for Tree Modification Mod
Response.Write " <table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td width=""50%"" align=""left"" bgcolor=""" & strForumCellColor & """ nowrap><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
" " & getCurrentIcon(strIconFolderOpen,"","align=""absmiddle""") & " <a href=""default.asp"">COMMUNITY HOME</a><br />" & vbNewLine & _
" " & getCurrentIcon(strIconBar,"","align=""absmiddle""")
if Cat_Status <> 0 then
Response.Write getCurrentIcon(strIconFolderOpen,"","align=""absmiddle""")
else
Response.Write getCurrentIcon(strIconFolderClosed,"","align=""absmiddle""")
end if
Response.Write " <a href=""default.asp?CAT_ID=" & Cat_ID & """>" & ChkString(Cat_Name,"display") & "</a><br />" & vbNewLine & _
" " & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBar,"","align=""absmiddle""")
if ArchiveView = "true" then
Response.Write getCurrentIcon(strIconFolderArchived,"","align=""absmiddle""")
else
if Forum_Status <> 0 and Cat_Status <> 0 then
Response.Write getCurrentIcon(strIconFolderOpen,"","align=""absmiddle""")
else
Response.Write getCurrentIcon(strIconFolderClosed,"","align=""absmiddle""")
end if
end if
Response.Write " <a href=""forum.asp?" & ArchiveLink & "FORUM_ID=" & Forum_ID & """>" & ChkString(Forum_Subject,"display") & "</a><br />" & vbNewLine
if ArchiveView = "true" then
Response.Write " " & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBar,"","align=""absmiddle""") & getCurrentIcon(strIconFolderArchived,"","align=""absmiddle""") & " "
elseif Cat_Status <> 0 and Forum_Status <> 0 and Topic_Status <> 0 then
Response.Write " " & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBar,"","align=""absmiddle""") & getCurrentIcon(strIconFolderOpenTopic,"","align=""absmiddle""") & " "
else
Response.Write " " & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBar,"","align=""absmiddle""") & getCurrentIcon(strIconFolderClosedTopic,"","align=""absmiddle""") & " "
end if
if Request.QueryString("SearchTerms") <> "" then
Response.Write SearchHiLite(ChkString(Topic_Subject,"title"))
else
Response.Write ChkString(Topic_Subject,"title")
end if
Response.Write "</font></td>" & vbNewLine & _
" <td align=""right"" width=""50%""bgcolor=""" & strForumCellColor & """ nowrap>" & vbNewLine
call PostingOptions()
'## End of modification for Tree Navigation Mod
Response.Write " </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine
if maxpages > 1 then
Response.Write "<table align=""center"" border=""0"" cellPadding=""0"" cellSpacing=""1"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""left"" valign=""top""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>"
if mypage > 1 then Response.Write("<a href=""topic.asp?" & ArchiveLink & "TOPIC_ID=" & Topic_ID & "&whichpage=" & mypage-1 & SearchLink & """ title=""Goto the Previous page in this Topic""" & dWStatus("Goto the Previous page in this Topic") & ">Previous Page</a>")
'if mypage > 1 then Response.Write("<a href=""javascript: onclick=document.PageNum1.whichpage.value=" & mypage-1 & ";document.PageNum1.submit();"" title=""Goto the Previous page in this Topic""" & dWStatus("Goto the Previous page in this Topic") & ">Previous Page</a>")
if mypage > 1 and mypage < maxpages then Response.Write(" | ")
if mypage < maxpages then Response.Write("<a href=""topic.asp?" & ArchiveLink & "TOPIC_ID=" & Topic_ID & "&whichpage=" & mypage+1 & SearchLink & """ title=""Goto the Next page in this Topic""" & dWStatus("Goto the Next page in this Topic") & ">Next Page</a>")
'if mypage < maxpages then Response.Write("<a href=""javascript: onclick=document.PageNum1.whichpage.value=" & mypage+1 & ";document.PageNum1.submit();"" title=""Goto the Next page in this Topic""" & dWStatus("Goto the Next page in this Topic") & ">Next Page</a>")
Response.Write "</td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine
end if
'## Beginning of second modification for Tree Navigation Mod
Response.Write "<table align=""center"" border=""0"" cellPadding=""0"" cellSpacing=""0"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td>" & vbNewLine & _
" <table width=""100%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center"" valign=""top"" width=""50%"">" & vbNewLine
' Call PostingOptions()
Response.Write "</td>" & vbNewLine & _
" <td align=""right"" valign=""top"" width=""50%"" nowrap>" & vbNewLine
'## End of second modification for Tree Navigation Mod
%>
<!--#INCLUDE FILE="inc_jump_to.asp" -->
<%
Response.Write " </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine
if strShowQuickReply = "1" and strDBNTUserName <> "" and ((Cat_Status = 1) and (Forum_Status = 1) and (Topic_Status = 1)) and ArchiveView = "" then
call QuickReply()
end if
WriteFooter
end if
sub GetFirst()
CColor = strForumFirstCellColor
' ################# TOPIC RATING MOD ######################
response.Write "<tr>" & vbNewLine & _
"<td></td>" & vbNewLine & _
"<td>" & vbNewLine
if request("ARCHIVE")<> "true" then
TopicRatingAvg = GetTopicRatingAvg( TopicID )
if intRatingAuth = 1 and Allow_Rating = 1 then
if strDBNTUserName <> "" Then
if ( getMemberID(strDBNTUserName) = Topic_Author ) then
Response.Write " <table border=""0"" width=""95%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgColor=""" & strForumFirstCellColor & """ align=left "" & strColspan & "">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>You Cannot Rate your own Topic: | Total Rating: " & getCurrentIcon(GetTopicRatingPicture(TopicRatingAvg),"","") & "</small></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine
Else
iTopicRating = GetTopicRating( getMemberID(strDBNTUserName), TopicID )
if iTopicRating <> -1 Then
Response.Write " <table border=""0"" width=""95%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgColor=""" & strForumFirstCellColor & """ align=left " & strColspan & ">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>You Rated this Topic: " & getCurrentIcon(GetTopicRatingPicture(iTopicRating),"","") & " | Total Rating: " & getCurrentIcon(GetTopicRatingPicture(TopicRatingAvg),"","") & "</small></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine
else
Response.Write " <table border=""0"" width=""95%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td valign=""top"" height=""100%"">" & vbNewLine & _
" <form align=""left"" action=""pop_topic_rating.asp?mode=goRate&id=" & TopicID & """ method=""Post"" id=Form1 name=Form1>" & vbNewLine & _
" <SELECT NAME=""rating"">" & vbNewLine & _
" <OPTION value=''>Rate Topic" & vbNewLine & _
" <OPTION value='5'>5: Highest Rating" & vbNewLine & _
" <OPTION value='4'>4" & vbNewLine & _
" <OPTION value='3'>3" & vbNewLine & _
" <OPTION value='2'>2" & vbNewLine & _
" <OPTION value='1'>1: Lowest Rating" & vbNewLine & _
" </SELECT> <INPUT TYPE=""SUBMIT"" NAME=""Submit"" VALUE=""Rate"">" & vbNewLine & _
" </form>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td bgColor=""" & strForumFirstCellColor & """ align=left " & strColspan & " valign=""top"" height=""100%"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small> | Total Rating: " & getCurrentIcon(GetTopicRatingPicture(TopicRatingAvg),"","") & "</small></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine
end if
end if
end if
else
Response.Write " <table border=""0"" width=""95%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
"<tr>" & vbNewLine & _
"<td bgColor=""" & strForumFirstCellColor & """ align=left " & strColspan & " valign=""top"" height=""100%"">" & vbNewLine & _
"<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>Rating is not allowed for this toic.</small></font>" & vbNewLine & _
"</td>" & vbNewLine & _
"</tr>" & vbNewLine & _
"</table>" & vbNewLine
end if
else
TopicRatingAvg = GetTopicRatingAvg( TopicID )
Response.Write "<table border=""0"" width=""95%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
"<tr>" & vbNewLine & _
"<td bgColor=""" & strForumFirstCellColor & """ align=left " & strColspan & " valign=""top"" height=""100%"">" & vbNewLine & _
"<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>Before Archiving the total rating was: " & getCurrentIcon(GetTopicRatingPicture(TopicRatingAvg),"","") & "</small></font>" & vbNewLine & _
"</td>" & vbNewLine & _
"</tr>" & vbNewLine & _
"</table>" & vbNewLine
end if
Response.Write "</td></tr>" &vbNewline
' ################# END TOPIC RATING MOD ######################
Response.Write " <tr>" & vbNewLine & _
" <td bgcolor=""" & strForumFirstCellColor & """ valign=""top"" width=""" & strTopicWidthLeft & """"
if lcase(strTopicNoWrapLeft) = "1" then Response.Write(" nowrap")
Response.Write ">" & vbNewLine & _
" <p><font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b><span class=""spnMessageText"" style=""width:0;height:0; " & Member_GlowText & """>" & profileLink(ChkString(Member_Name,"display"),TMember_ID) & "</span></b></font><br />" & VbNewLine
if strShowRank = 1 or strShowRank = 3 then
Response.Write " <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>" & ChkString(getMember_Level(Member_Title, Member_Level, Member_Posts),"display") & "</small></font><br />" & vbNewLine
end if
if strShowRank = 2 or strShowRank = 3 then
Response.Write " " & getStar_Level(Member_Level, Member_Posts) & "<br />" & vbNewLine
end if
Response.Write " </p>" & vbNewLine & _
" <p>" & vbNewLine
if CanShowAvatar = 1 and Member_Avatar <> "noavatar.gif" then
Response.Write " <table width=""" & intAvatarWidth & """ height= """ & intAvatarHeight & """ cellspacing=""0"" cellpadding=""0"" border=""0"" style="" background-image: url('" & Member_Avatar & "');background-repeat: no-repeat; background-position: center;"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><img src=""" & strImageURL & "noavatar.gif"" width=""96"" height=""96"" border=""0""></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine
end if
if strCountry = "1" and trim(Member_Country) <> "" then
Response.Write " <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>" & Member_Country & "</small></font><br /><img src=""" & strImageURL & Member_Country & ".gif""><br />" & vbNewLine
end if
Response.Write " <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>" & Member_Posts & " Posts</small></font></p></td>" & vbNewLine & _
" <td bgcolor=""" & strForumFirstCellColor & """ width=""" & strTopicWidthRight & """"
if lcase(strTopicNoWrapRight) = "1" then Response.Write(" nowrap")
if (AdminAllowed = 1) and (maxpages > 1) then
Response.Write (" colspan=""3"" ")
else
Response.Write (" colspan=""2"" ")
end if
Response.Write "valign=""top"">" & vbNewLine & _
" <table width=""100%"" height=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td valign=""top"">" & vbNewLine
if Topic_Status < 2 then
Response.Write " " & getCurrentIcon(getCurrentMsgIcon(Topic_MsgIcon),"","hspace=""3""") & "<font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>Posted - " & ChkDate(Topic_Date, " : " ,true) & "</font>" & vbNewline
elseif Topic_Status = 2 then
Response.Write " <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>NOT MODERATED!!!</font>" & vbNewline
elseif Topic_Status = 3 then
Response.Write " " & getCurrentIcon(strIconPosticonHold,"","hspace=""3""") & "<font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>ON HOLD</font>" & vbNewline
end if
Response.Write " <a href=""JavaScript:openWindowLink('pop_link_topic.asp?url=" & strForumURL & "topic.asp?TOPIC_ID=" & Topic_ID & "')"">" & getCurrentIcon(strIconLinkTo,"Share a link to this topic","align=""absmiddle"" hspace=""3""") & "</a>" & vbNewLine
Response.Write " " & profileLink(getCurrentIcon(strIconProfile,"View This Member's Profile","align=""absmiddle"" hspace=""6"""),TMember_ID) & vbNewLine
if mLev > 2 or Member_ReceiveMail = "1" then
if (mlev <> 0) or (mlev = 0 and strLogonForMail <> "1") then
Response.Write " <a href=""JavaScript:openWindow5('pop_mail.asp?id=" & TMember_ID & "')"">" & getCurrentIcon(strIconEmail,"Send An Email To This Member","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if (strHomepage = "1") then
if Member_Homepage <> " " then
Response.Write " <a href=""" & Member_Homepage & """ target=""_blank"">" & getCurrentIcon(strIconHomepage,"Visit " & ChkString(Member_Name,"display") & "'s Homepage","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
' ## Poll Below
if IsPoll = 1 and trim(strFeaturedPollID) = Topic_ID and AdminAllowed <> 1 then
' Do nothing
elseif IsPoll = 1 then
if (AdminAllowed = 1 or TMember_ID = MemberID) then
if ((Cat_Status <> 0) and (Forum_Status <> 0) and (Topic_Status <> 0)) or (AdminAllowed = 1) then
Response.Write " <a href=""post.asp?" & pollLink & "method=EditTopic&REPLY_ID=" & Topic_ID & "&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconEditTopic,"Edit Poll","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
else
if (AdminAllowed = 1 or TMember_ID = MemberID) then
if ((Cat_Status <> 0) and (Forum_Status <> 0) and (Topic_Status <> 0)) or (AdminAllowed = 1) then
Response.Write " <a href=""post.asp?" & ArchiveLink & "method=EditTopic&REPLY_ID=" & Topic_ID & "&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconEditTopic,"Edit Topic","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
end if
' ## Poll Above
if (strAIM = "1") then
if Trim(Member_AIM) <> "" then
Response.Write " <a href=""JavaScript:openWindow('pop_messengers.asp?mode=AIM&ID=" & TMember_ID & "')"">" & getCurrentIcon(strIconAIM,"Send " & ChkString(Member_Name,"display") & " an AOL message","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if (strICQ = "1") then
if Trim(Member_ICQ) <> "" then
Response.Write " <a href=""JavaScript:openWindow('pop_messengers.asp?mode=ICQ&ID=" & TMember_ID & "')"">" & getCurrentIcon(strIconICQ,"Send " & ChkString(Member_Name,"display") & " an ICQ Message","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if (strMSN = "1") then
if Trim(Member_MSN) <> "" then
Response.Write " <a href=""JavaScript:openWindow('pop_messengers.asp?mode=MSN&ID=" & TMember_ID & "')"">" & getCurrentIcon(strIconMSNM,"Click to see " & ChkString(Member_Name,"display") & "'s MSN Messenger address","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if (strGOOGLETALK = "1") then
if Trim(Member_GOOGLETALK) <> "" then
Response.Write " <a href=""JavaScript:openWindow('pop_messengers.asp?mode=GOOGLETALK&ID=" & TMember_ID & "')"">" & getCurrentIcon(strIconGOOGLETALK,"Click to see " & ChkString(Member_Name,"display") & "'s Google Talk address","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if (strSKYPE = "1") then
if Trim(Member_SKYPE) <> "" then
Response.Write " <a href=""JavaScript:openWindow('pop_messengers.asp?mode=SKYPE&ID=" & TMember_ID & "')"">" & getCurrentIcon(strIconSKYPE,"Look at the Skype phone address from " & ChkString(Member_Name,"display") & "","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
if (strYAHOO = "1") then
if Trim(Member_YAHOO) <> "" then
Response.Write " <a href=""http://edit.yahoo.com/config/send_webmesg?.target=" & ChkString(Member_YAHOO, "urlpath") & "&.src=pg"" target=""_blank"">" & getCurrentIcon(strIconYahoo,"Send " & ChkString(Member_Name,"display") & " a Yahoo! Message","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
'######################## Fame Mod #########################
if TMember_ID <> MemberID and mLev > 1 then
Response.Write "<a href=""pop_fame.asp?topic_id="& topic_id & "&reply_id="& reply_id & """ target=""_blank"">" & getCurrentIcon("" & striconFame & "","Hall of Fame", "align=""middle""") & "</a>" & vbNewLine
end if
'######################## Fame Mod #########################
'##FRIENDS ## User Space Mod ## Add Code Below ##############
if trim(strUSFriendSwitch) <> "" then
if cLng(strUSFriendSwitch) = 1 then
if TMember_ID <> MemberID then
Response.Write "<a href=""JavaScript:openWindow5('pop_user_space.asp?mode=friends&id=" & TMember_ID & "&action=add&type=0')"">" & getCurrentIcon(strIconFriends,"Add " & ChkString(Member_Name,"display") & " to your friends list","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
end if
'## END #####################################################
'##BOOKMARKS ## User Space Mod ## Add Code below ###########################
if trim(strUSBookmarkSwitch) <> "" then
if cLng(strUSBookmarkSwitch) = 1 then
Response.Write "<a href=""JavaScript:openWindow5('pop_user_space.asp?mode=bookmark&action=add&type=post&archive=" & ArchiveView & "&topic_id=" & TopicID & "')"">" & getCurrentIcon(strIconFavorites,"Bookmark this topic","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
end if
'## End ## Thats all for this file ##########################
If (Member_PM = "1" and strPMStatus = "1") Then
if Trim(Member_PM) <> "" then
Response.Write " <a href=""privatesend.asp?method=Topic&mname=" & ChkString(Member_Name,"display") & """>" & getCurrentIcon(strIconPmprivatemessage,"Send " & ChkString(Member_Name,"display") & " a Private Message","align=""absmiddle"" hspace=""0""") & "</a>" & vbNewLine
End If
End IF
if ((Cat_Status <> 0 and Forum_Status <> 0 and Topic_Status = 1) or (AdminAllowed = 1 and Topic_Status <= 1) and ArchiveView = "" ) then
Response.Write " <a href=""post.asp?" & ArchiveLink & "method=TopicQuote&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconReplyQuote,"Reply with Quote","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
end if
if (strIPLogging = "1") then
if (AdminAllowed = 1) then
' ########################### Ban IP Mod ###############################
Response.Write " <a href=""JavaScript:openWindow('pop_ban_ip.asp?TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & "')"">" & getCurrentIcon(strIconIP,"View/Ban user's IP address","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
' ####################################################################
end if
end if
if (AdminAllowed = 1) or (TMember_ID = MemberID and Topic_Replies < 1) then
' ## Poll Below
Response.Write " <a href=""JavaScript:openWindow('pop_delete.asp?" & ArchiveLink & pollLink & "mode=Topic&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & "&CAT_ID=" & Cat_ID & "')"">" & getCurrentIcon(strIconDeleteReply,"Delete Topic","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine
' ## Poll Above
end if
' DEM --> Start of Code added for Full Moderation
if (AdminAllowed = 1 and Topic_Status > 1) then
TopicString = "TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & "&CAT_ID=" & Cat_ID
Response.Write " <a href=""JavaScript:openWindow('pop_moderate.asp?" & TopicString & "')"">" & getCurrentIcon(strIconFolderModerate,"Approve/Hold/Reject this Topic","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewline
End if
' End of Code added for Full Moderation
Response.Write " <hr noshade size=""" & strFooterFontSize & """></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine
'####################################### Poll Mod ##################################
'# Remember to remove the &_ from the end of the line above. #
'# Find the following code in your file and comment out or remove it: #
'###################################################################################
' " <td valign=""top"" height=""100%""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """><span class=""spnMessageText"" id=""msg"">"
'if Request.QueryString("SearchTerms") <> "" then
' Response.Write SearchHiLite(formatStr(Topic_Message))
'else
' Response.Write formatStr(Topic_Message)
'end if
'Response.Write "</span id=""msg""></font></td>" & vbNewLine & _
'############## Poll Mod ########################
'# Then add the following code below. #
'################################################
Response.Write " <td valign=""top"" height=""100%""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>" & vbNewLine
if IsPoll = 1 then
if Voted = false and Request.QueryString("results") <> "1" and Poll_Status = 1 and Forum_Polls <> "0" then
Response.Write "<table border=""0"" width=""100%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td valign=""top"">" & vbNewLine & _
" <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b>Poll Question:</b></font><br />" & vbNewLine & _
" <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><span class=""spnMessageText"" id=""msg"">" & vbNewLine
'## Ignore Post Mod Below
if strIgnorePost = "1" then
boolIgnorePost = ChkIgnoreList(arrIgnoreMemberList, TMember_ID)
end if
if Request.QueryString("SearchTerms") <> "" then
if strIgnorePost = "1" then
if boolIgnorePost then
WriteIgnPostLinks TopicID, 0, TMember_ID
else
Response.Write SearchHiLite(formatStr(Topic_Message))
end if
else
Response.Write SearchHiLite(formatStr(Topic_Message))
end if
else
if strIgnorePost = "1" then
if boolIgnorePost then
WriteIgnPostLinks TopicID, 0, TMember_ID
else
Response.Write formatStr(Topic_Message)
end if
else
Response.Write SearchHiLite(formatStr(Topic_Message))
end if
end if
'## Ignore Post Mod Above
Response.Write "</span id=""msg""></font>" & vbNewLine & _
" <table border=""0"" width=""100%"">" & vbNewLine & _
" <form method=""POST"" action=""topic.asp?TOPIC_ID=" & Topic_ID & "&results=1"" name=""Poll"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td width=""100%"" bgcolor=""" & strForumFirstCellColor & """ align=""left"">" & vbNewLine & _
" <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><br><b>Choices:</b></font><br />" & vbNewLine
for nCount = 1 To 15
if trim(vAnswers(nCount)) <> "" then
Response.Write " <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><input type=""radio"" value=""" & nCount & """ name=""R1"">" & formatStr(vAnswers(nCount)) & "</font><br />" & vbNewLine
end if
next
Response.Write " </td>" & vbNewLine & _
" </tr>" & vbNewLine
if IsPoll = 1 then
Response.Write " <tr>" & vbNewLine & _
" <td width=""100%"" bgcolor=""" & strForumFirstCellColor & """ align=""left""><br />" & vbNewLine
if strGfxButtons <> "0" then
Response.Write "<input type=""image"" src=""" & strImageURL & "vote_now.gif"" name=""Vote"" width=""72"" height=""16"" hspace=""0"" alt=""Click to vote!"" onClick=""submitPoll(this)"">"
else
Response.Write "<input type=""button"" value=""Vote Now!"" name=""vote"" onClick=""submitPoll(this)"">" & vbNewLine & _
"<input type=""button"" value=""Poll Results"" name=""results"" onClick=""submitPoll(this)"">" & vbNewLine
end if
if strVResults = "0" then
Response.Write "<font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """> (You will not be able to view poll results until poll voting has ended.)</font>" & vbNewLine
end if
Response.Write " <input type=""hidden"" name=""Method_Type"" value="""">" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine
end if
Response.Write " </form>" & vbNewLine & _
" </table>" & vbNewLine
if strWhoVotes = "members" and mlev = 0 then
Response.Write " <hr size=""" & strFooterFontSize & """ noshade>" & vbNewLine & _
" <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><b>Who Can Vote?</b> Only Members can vote. You need to <a href=""policy.asp"">register</a> or be logged in to vote.</font>" & vbNewLine
end if
Response.Write " </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine
end if
else
Response.Write " <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """><span class=""spnMessageText"" id=""msg"">"
if Request.QueryString("SearchTerms") <> "" then
Response.Write SearchHiLite(formatStr(Topic_Message))
else
Response.Write formatStr(Topic_Message)
end if
Response.Write "</span id=""msg""></font>" & vbNewLine
end if
if IsPoll = 1 then
if Request.QueryString("results") = "1" or _
(Request.QueryString("results") <> "1" and Voted = true) or Poll_Status = 0 or Forum_Polls = "0" then
Response.Write "<table border=""0"" width=""100%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td valign=""top"" colspan=""3"">" & vbNewLine & _
" <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b>Poll Question:</b></font><br />" & vbNewLine & _
" <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><span class=""spnMessageText"" id=""msg"">" & vbNewLine
if Request.QueryString("SearchTerms") <> "" then
Response.Write SearchHiLite(formatStr(Topic_Message))
else
Response.Write formatStr(Topic_Message)
end if
Response.Write "</span id=""msg""></font><br /><br />" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td colspan=""3""><font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b>Results:</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
'First of all get max value and nLowValue
nMaxValue = 0
for nCount = 1 to 15
if trim(vAnswers(nCount)) <> "" and vCount(nCount) > nMaxValue then
nMaxValue = vCount(nCount)
end if
next
if nMaxValue = 0 then
nMaxValue = 1
end if
nMaxWidth = 200 'This is number of pixels for maxvalue
nTotal = 0
nTotal2 = 0
'1. Go through all and get total
for nCount = 1 to 15
if trim(vAnswers(nCount)) <> "" then
nTotal = nTotal + vCount(nCount)
nTotal2 = nTotal2 + vCount(nCount)
end if
next
if nTotal2 = 0 then
nTotal2 = 1
end if
'2. Go through all and get percent
for nCount = 1 to 15
if trim(vAnswers(nCount)) <> "" then
vPercent(nCount) = FormatNumber(vCount(nCount)/nTotal2*100,0)
end if
next
for nCount = 1 to 15
if trim(vAnswers(nCount)) <> "" then
nThisVal = FormatNumber(vCount(nCount)/nMaxValue * nMaxWidth,0)
If strPEndDate <= DateToStr(strForumTimeAdjust) Then
Response.Write " <tr>" & vbNewLine & _
" <td width=""30%""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strDefaultFontSize & """>" & formatStr(vAnswers(nCount)) & "</font></td>" & vbNewLine & _
" <td nowrap><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strDefaultFontSize & """><img src=""" & strImageURL & "bar.gif"" width=""" & nThisVal & """ height=""10""> [" & vPercent(nCount) & "%]</font></td>" & vbNewLine & _
" <td nowrap width=""10%""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strDefaultFontSize & """>" & vCount(nCount) & " votes</font></td>" & vbNewLine & _
" </tr>" & vbNewLine
Else
Response.Write " <tr>" & vbNewLine & _
" <td width=""30%""> </td>" & vbNewLine & _
" <td nowrap><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strDefaultFontSize & """>Poll voting not yet closed. Results not available.</font></td>" & vbNewLine & _
" <td nowrap width=""10%""></td>" & vbNewLine & _
" </tr>" & vbNewLine
Exit For
End If
end if
next
Response.Write " <tr>" & vbNewLine & _
" <td align=""left"" colspan=""3""><br />" & vbNewLine & _
" <hr noshade size=""" & strFooterFontSize & """>" & vbNewLine & _
" <table cellspacing=""0"""
if AdminAllowed = 1 and ArchiveView <> "true" then
Response.Write " cellPadding=""3"""
else
Response.Write " cellPadding=""0"""
end if
Response.Write " border=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strFooterFontSize & """>" & vbNewLine & _
" <b>Poll Status:</b> " & vbNewLine
if Poll_Status = 0 or Forum_Polls = "0" then
Response.Write "Locked"
else
Response.Write "Open"
end if
Response.Write " </font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strFooterFontSize & """>" & vbNewLine & _
" <b> Total Votes:</b> " & nTotal & " counted </font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strFooterFontSize & """>" & vbNewLine & _
" <b> Last Vote:</b> " & vbNewLine
if cint(nTotal) > 0 then Response.Write(chkDate(Last_Vote, " ", true)) else Response.Write("never")
Response.Write " </font></td>" & vbNewLine & _
" </tr>" & vbNewLine
if AdminAllowed = 1 and ArchiveView <> "true" then
Response.Write " <tr>" & vbNewLine & _
" <td colspan=""3""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strFooterFontSize & """><b>Admins/Moderators:</b> <a href=""javascript:openPollWindow('pop_poll.asp?TOPIC_ID=" & Topic_ID & "&p=wv','300','300')"">See who voted</a></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
end if
Response.Write " </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine
end if
end if
Response.Write " </td>" & vbNewLine & _
" </tr>" & vbNewLine
' ## Poll Above
if CanShowSignature = 1 and Topic_Sig = 1 and Topic_MemberSig <> "" then
Response.Write " <tr>" & vbNewLine & _
" <td valign=""bottom""><hr noshade size=""" & strFooterFontSize & """><font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><span class=""spnMessageText"">" & formatStr(Topic_MemberSig) & "</span></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
end if
if strEditedByDate = "1" and Topic_LastEditBy <> "" then
if Topic_LastEditBy <> Topic_Author then
Topic_LastEditByName = getMemberName(Topic_LastEditBy)
else
Topic_LastEditByName = chkString(Member_Name,"display")
end if
Response.Write " <tr>" & vbNewLine & _
" <td valign=""bottom""><hr noshade size=""" & strFooterFontSize & """ color=""" & strForumFirstCellColor & """><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & vbNewLine & _
"Edited by - " & Topic_LastEditByName & " on " & chkDate(Topic_LastEdit, " " ,true) & "</font></td>" & vbNewLine & _
" </tr>" & vbNewLine
end if
Response.Write " </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine
End Sub
sub PostingOptions()
Response.Write " <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine
'## Events Calendar - Adds a "New Event" Link
strSql = "SELECT F_ALLOWEVENTS FROM " & strTablePrefix & "FORUM WHERE FORUM_ID = " & Forum_ID & " AND F_ALLOWEVENTS = 1"
set rsCal = Server.CreateObject("ADODB.Recordset")
rsCal.Open strSql, My_conn
if not rsCal.EOF then blnCalAllowed = TRUE else blnCalAllowed = FALSE
rsCal.Close
set rsCal = nothing
if blnCalAllowed and (intCalMLev <= MLev) then Response.Write " <a href=""post.asp?method=Topic&event=1&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strCalIconEvent,strIconEvent,"align=""absmiddle""") & "</a> <a href=""post.asp?method=Topic&event=1&FORUM_ID=" & Forum_ID & """>" & strCalNewEvent & "</a> " & vbNewLine
if (mlev = 4 or mlev = 3 or mlev = 2 or mlev = 1) or (lcase(strNoCookies) = "1") or (strDBNTUserName = "") then
if ((Cat_Status = 1) and (Forum_Status = 1)) then
Response.Write " <a href=""post.asp?" & ArchiveLink & "method=Topic&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconFolderNewTopic,"","align=""absmiddle""") & "</a> <a href=""post.asp?" & ArchiveLink & "method=Topic&FORUM_ID=" & Forum_ID & """>New Topic</a>" & vbNewLine
' ## Poll Below
if strPolls = "1" and ((Forum_Polls = "2" and AdminAllowed = 1) or (Forum_Polls = "1")) then
Response.Write " <a href=""post.asp?poll=1&method=Topic&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconPoll,"New Poll","align=""absmiddle""") & "</a> <a href=""post.asp?poll=1&method=Topic&FORUM_ID=" & Forum_ID & """>New Poll</a><br />" & vbNewLine
end if
' ## Poll Above
else
if (AdminAllowed = 1) then
Response.Write " <a href=""post.asp?" & ArchiveLink & "method=Topic&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconFolderLocked,"","align=""absmiddle""") & "</a> <a href=""post.asp?" & ArchiveLink & "method=Topic&FORUM_ID=" & Forum_ID & """>New Topic</a>" & vbNewLine
' ## Poll Below
Response.Write " <a href=""post.asp?poll=1&method=Topic&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconPoll,"New Poll","align=""absmiddle""") & "</a> <a href=""post.asp?poll=1&method=Topic&FORUM_ID=" & Forum_ID & """>New Poll</a><br />" & vbNewLine
' ## Poll Above
else
Response.Write " " & getCurrentIcon(strIconFolderLocked,"","align=""absmiddle""") & " Forum Locked" & vbNewLine
end if
end if
if ((Cat_Status = 1) and (Forum_Status = 1) and (Topic_Status = 1)) and ArchiveView = "" then
Response.Write " <a href=""post.asp?" & ArchiveLink & "method=Reply&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconReplyTopic,"","align=""absmiddle""") & "</a> <a href=""post.asp?" & ArchiveLink & "method=Reply&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & """>Reply to Topic</a>" & vbNewLine
else
if ((AdminAllowed = 1 and Topic_Status <= 1) and ArchiveView = "") then
Response.Write " <a href=""post.asp?" & ArchiveLink & "method=Reply&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & """>"
' DEM --> Added if statement to show normal icon for unmoderated posts.
if Topic_Status = 1 and Cat_Status <> 0 and Forum_Status <> 0 then
Response.Write getCurrentIcon(strIconReplyTopic,"","align=""absmiddle""") & "</a> "
else
Response.Write getCurrentIcon(strIconClosedTopic,"","align=""absmiddle""") & "</a> "
end if
Response.Write "<a href=""post.asp?" & ArchiveLink & "method=Reply&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & """>Reply to Topic</a>" & vbNewLine
else
if Topic_Status = 0 then
Response.Write getCurrentIcon(strIconClosedTopic,"","align=""absmiddle""") & " Topic Locked" & vbNewline
end if
end if
end if
if lcase(strEmail) = "1" and Topic_Status < 2 then
if Cat_Status <> 0 and Forum_Status <> 0 and Topic_Status <> 0 and mLev > 0 then
if strSubscription > 0 and Cat_Subscription > 0 and Forum_Subscription > 0 then
if InArray(strTopicSubs, Topic_ID) then
Response.Write " <br />" & ShowSubLink ("U", Cat_ID, Forum_ID, Topic_ID, "Y") & vbNewLine
elseif strBoardSubs <> "Y" and not(InArray(strForumSubs,Forum_ID) or InArray(strCatSubs,Cat_ID)) then
Response.Write " <br />" & ShowSubLink ("S", Cat_ID, Forum_ID, Topic_ID, "Y") & vbNewLine
end if
end if
end if
if ((mlev <> 0) or (mlev = 0 and strLogonForMail <> "1")) and lcase(strShowSendToFriend) = "1" then
' ## Poll Below
if strPolls = "1" and ((Forum_Polls = "2" and AdminAllowed = 1) or (Forum_Polls = "1")) then
Response.Write " <a href=""JavaScript:openWindow('pop_send_to_friend.asp?url=" & strForumURL & "topic.asp?TOPIC_ID=" & Topic_ID & "')"">" & getCurrentIcon(strIconSendTopic,"","align=""absmiddle""") & "</a> <a href=""JavaScript:openWindow('pop_send_to_friend.asp?url=" & strForumURL & "topic.asp?TOPIC_ID=" & Topic_ID & "')"">Send Topic to a Friend</a>" & vbNewLine
else
Response.Write " <br /><a href=""JavaScript:openWindow('pop_send_to_friend.asp?url=" & strForumURL & "topic.asp?TOPIC_ID=" & Topic_ID & "')"">" & getCurrentIcon(strIconSendTopic,"","align=""absmiddle""") & "</a> <a href=""JavaScript:openWindow('pop_send_to_friend.asp?url=" & strForumURL & "topic.asp?TOPIC_ID=" & Topic_ID & "')"">Send Topic to a Friend</a>" & vbNewLine
end if
' ## Poll Above
end if
end if
if lcase(strShowPrinterFriendly) = "1" and Topic_Status < 2 then
Response.Write " <br /><a href=""JavaScript:openWindow5('pop_printer_friendly.asp?" & ArchiveLink & "TOPIC_ID=" & Topic_ID & "')"">" & getCurrentIcon(strIconPrint,"","align=""absmiddle""") & "</a> <a href=""JavaScript:openWindow5('pop_printer_friendly.asp?" & ArchiveLink & "TOPIC_ID=" & Topic_ID & "')"">Printer Friendly</a>" & vbNewLine
end if
end if
Response.Write " </font>"
end sub
sub AdminOptions()
Response.Write " <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine
if (AdminAllowed = 1) or (lcase(strNoCookies) = "1") then
if (Cat_Status = 0) then
if (mlev = 4) then
Response.Write " <a href=""JavaScript:openWindow('pop_open.asp?mode=Category&CAT_ID=" & Cat_ID & "')"">" & getCurrentIcon(strIconFolderUnlocked,"Un-Lock Category","") & "</a>" & vbNewLine
else
Response.Write " " & getCurrentIcon(strIconFolderUnlocked,"Category Locked","") & vbNewLine
end if
else
if (Forum_Status = 0) then
Response.Write " <a href=""JavaScript:openWindow('pop_open.asp?mode=Forum&FORUM_ID=" & Forum_ID & "&CAT_ID=" & Cat_ID & "')"">" & getCurrentIcon(strIconFolderUnlocked,"Un-Lock Forum","") & "</a>" & vbNewLine
else
if (Topic_Status <> 0) then
Response.Write " <a href=""JavaScript:openWindow('pop_lock.asp?mode=Topic&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & "&CAT_ID=" & Cat_ID & "')"">" & getCurrentIcon(strIconFolderLocked,"Lock Topic","") & "</a>" & vbNewLine
else
Response.Write " <a href=""JavaScript:openWindow('pop_open.asp?mode=Topic&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & "&CAT_ID=" & Cat_ID & "')"">" & getCurrentIcon(strIconFolderUnlocked,"Un-Lock Topic","") & "</a>" & vbNewLine
end if
end if
end if
if ((Cat_Status <> 0) and (Forum_Status <> 0) and (Topic_Status <> 0)) or (AdminAllowed = 1) then
' ## Poll Below
Response.Write " <a href=""post.asp?" & ArchiveLink & pollLink & "method=EditTopic&REPLY_ID=" & Topic_ID & "&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconFolderPencil,"Edit Topic","hspace=""0""") & "</a>" & vbNewLine
end if
Response.Write " <a href=""JavaScript:openWindow('pop_delete.asp?" & ArchiveLink & pollLink & "mode=Topic&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & "&CAT_ID=" & Cat_ID & "')"">" & getCurrentIcon(strIconFolderDelete,"Delete Topic","") & "</a>" & vbNewLine & _
" <a href=""post.asp?" & ArchiveLink & "method=Topic&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconFolderNewTopic,"New Topic","") & "</a>" & vbNewLine
' ## Poll Above
if Topic_Status <= 1 and ArchiveView = "" then
Response.Write " <a href=""post.asp?" & ArchiveLink & "method=Reply&TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconReplyTopic,"Reply to Topic","") & "</a>" & vbNewLine
end if
'##################################### Split Topic Mod ###########################################
if iReplyCount <> "" then
Response.Write "<a href=""split.asp?" & ArchiveLink & "TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & """>" & getCurrentIcon(strIconSplitTopic,"Split Topic","") & "</a>" & vbNewLine
end if
'#################################################################################################
'################################# Merge Topic Mod ################################
Response.Write "<a href=""merge.asp?TOPIC_ID=" & Topic_ID & """>" & getCurrentIcon(strIconMerge,"Merge Topic","") & "</a>" & vbNewLine
'##################################################################################
end if
' DEM --> Start of Code added for Full Moderation
if (AdminAllowed = 1 and CheckForUnModeratedPosts("TOPIC", Cat_ID, Forum_ID, Topic_ID) > 0) then
TopicString = "TOPIC_ID=" & Topic_ID & "&FORUM_ID=" & Forum_ID & "&CAT_ID=" & Cat_ID & "&REPLY_ID=X"
Response.Write " <a href=""JavaScript:openWindow('pop_moderate.asp?" & TopicString & "')"">" & getCurrentIcon(strIconFolderModerate,"Approve/Hold/Reject all posts for this Topic","") & "</a>" & vbNewline
end if
' DEM --> End of Code added for Full Moderation
Response.Write " </font>"
end sub
sub DropDownPaging(fnum)
if maxpages > 1 then
if mypage = "" then
pge = 1
else
pge = mypage
end if
scriptname = request.servervariables("script_name")
Response.Write(" <form name=""PageNum" & fnum & """ action=""topic.asp"">" & vbNewLine)
Response.Write(" <td bgcolor=""" & strHeadCellColor & """ nowrap><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>" & vbNewLine)
if Archiveview = "true" then Response.Write(" <input type=""hidden"" name=""ARCHIVE"" value=""" & ArchiveView & """>" & vbNewLine)
Response.Write(" <input type=""hidden"" name=""TOPIC_ID"" value=""" & Request("TOPIC_ID") & """>" & vbNewLine)
Response.Write(" <b>Page: </b><select name=""whichpage"" size=""1"" onchange=""ChangePage(" & fnum & ");"">" & vbNewLine)
for counter = 1 to maxpages
if counter <> cLng(pge) then
Response.Write " <option value=""" & counter & """>" & counter & "</option>" & vbNewLine
else
Response.Write " <option selected value=""" & counter & """>" & counter & "</option>" & vbNewLine
end if
next
Response.Write(" </select><b> of " & maxpages & "</b>" & vbNewLine)
if Request.QueryString("SearchTerms") <> "" then Response.Write(" <input type=""hidden"" name=""SearchTerms"" value=""" & Server.HTMLEncode(Request.QueryString("SearchTerms")) & """>" & vbNewLine)
Response.Write(" </font></td>" & vbNewLine)
Response.Write(" </form>" & vbNewLine)
end if
top = "0"
end sub
Sub Topic_nav()
if prevTopic = "" then
strSQL = "SELECT T_SUBJECT, TOPIC_ID "
strSql = strSql & "FROM " & strActivePrefix & "TOPICS "
strSql = strSql & "WHERE T_LAST_POST > '" & Topic_LastPost
strSql = strSql & "' AND FORUM_ID = " & Forum_ID
strSql = strSql & " AND T_STATUS < 2" ' Ignore unapproved/held posts
strSql = strSql & " ORDER BY T_LAST_POST;"
set rsPrevTopic = my_conn.Execute(TopSQL(strSql,1))
if rsPrevTopic.EOF then
prevTopic = getCurrentIcon(strIconBlank,"","align=""top"" hspace=""6""")
else
prevTopic = "<a href=""topic.asp?" & ArchiveLink & "TOPIC_ID=" & rsPrevTopic("TOPIC_ID") & """>" & getCurrentIcon(strIconGoLeft,"Previous Topic","align=""top"" hspace=""6""") & "</a>"
end if
rsPrevTopic.close
set rsPrevTopic = nothing
else
prevTopic = prevTopic
end if
if NextTopic = "" then
strSQL = "SELECT T_SUBJECT, TOPIC_ID "
strSql = strSql & "FROM " & strActivePrefix & "TOPICS "
strSql = strSql & "WHERE T_LAST_POST < '" & Topic_LastPost
strSql = strSql & "' AND FORUM_ID = " & Forum_ID
strSql = strSql & " AND T_STATUS < 2" ' Ignore unapproved/held posts
strSql = strSql & " ORDER BY T_LAST_POST DESC;"
set rsNextTopic = my_conn.Execute(TopSQL(strSql,1))
if rsNextTopic.EOF then
nextTopic = getCurrentIcon(strIconBlank,"","align=""top"" hspace=""6""")
else
nextTopic = "<a href=""topic.asp?" & ArchiveLink & "TOPIC_ID=" & rsNextTopic("TOPIC_ID") & """>" & getCurrentIcon(strIconGoRight,"Next Topic","align=""top"" hspace=""6""") & "</a>"
end if
rsNextTopic.close
set rsNextTopic = nothing
else
nextTopic = nextTopic
end if
Response.Write (" " & prevTopic & "<b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """> Topic </font></b>" & nextTopic)
end sub
function SearchHiLite(fStrMessage)
'function derived from HiLiTeR by 2eNetWorX
fArr = split(replace(Request.QueryString("SearchTerms"),";",""), ",")
strBuffer = ""
for iPos = 1 to len(fStrMessage)
bChange = False
'Looks for html tags
if mid(fStrMessage, iPos, 1) = "<" then
bInHTML = True
end if
'Looks for End of html tags
if bInHTML = True then
if mid(fStrMessage, iPos, 1) = ">" then
bInHTML = False
end if
end if
if bInHTML <> True then
for i = 0 to UBound(fArr)
if fArr(i) <> "" then
if lcase(mid(fStrMessage, iPos, len(fArr(i)))) = lcase(fArr(i)) then
bChange = True
strBuffer = strBuffer & "<span class=""spnSearchHighlight"" id=""hilite"">" & _
mid(fStrMessage, iPos, len(fArr(i))) & "</span id=""hilite"">"
iPos = iPos + len(fArr(i)) - 1
end if
end if
next
end if
if Not bChange then
strBuffer = strBuffer & mid(fStrMessage, iPos, 1)
end if
next
SearchHiLite = strBuffer
end function
Sub QuickReply()
intSigDefault = getSigDefault(MemberID)
Response.Write " <script language=""JavaScript"" type=""text/javascript"" src=""inc_code.js""></script>" & vbNewLine & _
" <table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgcolor=""" & strPopUpBorderColor & """>" & vbNewLine & _
" <table width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""1"">" & vbNewLine & _
" <form name=""PostTopic"" method=""post"" action=""post_info.asp"" onSubmit=""return validate();"">" & vbNewLine & _
" <input name=""ARCHIVE"" type=""hidden"" value=""" & ArchiveView & """>" & vbNewLine & _
" <input name=""Method_Type"" type=""hidden"" value=""Reply"">" & vbNewLine & _
" <input name=""TOPIC_ID"" type=""hidden"" value=""" & Topic_ID & """>" & vbNewLine & _
" <input name=""FORUM_ID"" type=""hidden"" value=""" & Forum_ID & """> " & vbNewLine & _
" <input name=""CAT_ID"" type=""hidden"" value=""" & Cat_ID & """>" & vbNewLine & _
" <input name=""Refer"" type=""hidden"" value=""" & request.servervariables("SCRIPT_NAME") & "?" & chkString(Request.QueryString,"refer") & """>" & vbNewLine & _
" <input name=""UserName"" type=""hidden"" value=""" & strDBNTUserName & """>" & vbNewLine & _
" <input name=""Password"" type=""hidden"" value=""" & Request.Cookies(strUniqueID & "User")("Pword") & """>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgColor=""" & strHeadCellColor & """ noWrap vAlign=""top"" colspan=""2""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """><b>Quick Reply</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgColor=""" & strForumCellColor & """ noWrap vAlign=""top"" align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """><span class=""spnMessageText""><b>Message: </b><br />" & vbNewLine & _
" <br />" & vbNewLine & _
" <table border=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""left"" nowrap><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & vbNewLine
if strAllowHTML = "1" then
Response.Write " * HTML is ON<br />" & vbNewLine
else
Response.Write " * HTML is OFF<br />" & vbNewLine
end if
if strAllowForumCode = "1" then
Response.Write " * <a href=""JavaScript:openWindow6('pop_forum_code.asp')"">Forum Code</a> is ON<br />" & vbNewLine
else
Response.Write " * Forum Code is OFF<br />" & vbNewLine
end if
if strSignatures = "1" then
Response.Write " <br /><input name=""Sig"" id=""Sig"" type=""checkbox"" value=""yes""" & chkCheckbox(intSigDefault,1,true) & "><label for=""Sig"">Include Signature</label><br />" & vbNewLine
end if
Response.Write " </font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </span></font></td>" & vbNewLine & _
" <td width=""" & strTopicWidthRight & """ bgColor=""" & strForumCellColor & """><textarea name=""Message"" cols=""50"" rows=""6"" wrap=""VIRTUAL"" style=""width:100%""></textarea><br /></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgColor=""" & strForumCellColor & """ noWrap align=""center"" colspan=""2""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """><input name=""Submit"" type=""submit"" value=""Submit Reply""> <input name=""Preview"" type=""button"" value=""Preview Reply"" onclick=""OpenPreview()"">"
'Response.Write " <input name=""Reset"" type=""reset"" value=""Reset Form""></font></td>" & vbNewLine & _
Response.Write "</font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </form>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" <br />" & vbNewLine
end sub
'###### Ignore Post Mod Below ######
Function IgnoreMemberList()
strSql = "SELECT I.I_IGNOREID FROM " & _
strTablePrefix & "IGNORE_POSTS I WHERE I.I_MEMBERID = " & MemberID
set rsIgnore = my_Conn.Execute(strSql)
if rsIgnore.BOF or rsIgnore.EOF then
rsIgnore.close
set rsIgnore = nothing
exit function
else
IgnoreMemberList = rsIgnore.GetRows()
rsIgnore.close
set rsIgnore = nothing
end if
End Function
Function ChkIgnoreList(IgnoredMembers, CurrentMember)
if IsArray(IgnoredMembers) = False then
ChkIgnoreList = False
exit function
end if
For iRow = 0 to UBound(IgnoredMembers, 2)
if IgnoredMembers(0,iRow) = CurrentMember then
ChkIgnoreList = True
Exit Function
end if
Next
ChkIgnoreList = False
End Function
Sub WriteIgnPostLinks(TopicID, ReplyID, IMemberID)
if ReplyID > 0 then strReplyPart = "&REPLY_ID=" & ReplyID
if mLev >= 3 then
Response.Write "[<a href=""javascript:openWindowIgnore('pop_viewpost.asp?TOPIC_ID=" & TopicID & strReplyPart & "')"">View Post</a>] "
end if
Response.Write "[<a href=""javascript:openWindow('pop_ignorelist.asp?id=" & IMemberID & "&mode=r')"">Un-Ignore User</a>]"
End Sub
'###### Ignore Post Mod Above ######
%>
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Carefree
Advanced Member
Philippines
4207 Posts |
Posted - 18 February 2014 : 18:20:59
|
| Found it, Ma. It wasn't in "topic.asp" after all. When the new form was being created in the popup window, it didn't resend the topic_id value. See fixed code in post above. |
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 18 February 2014 : 20:49:46
|
That fixed it! YEA!
You are amazing, Carefree!
Thank you so much!
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Topic |
|
|
|
