T O P I C R E V I E W |
dl4gbe |
Posted - 26 May 2006 : 07:58:38 Hello.
Here an example to add adsense in topic.asp
Add the folllowing function to topic.asp please do not forget to set your own ID in google_ad_client
sub Adsense(strColorBG)
Response.Write " <tr>" & vbNewLine & _
" <td bgcolor=""" & CColor & """ valign=""top"" width=""" & strTopicWidthLeft & """>" & vbnewline
Response.Write " <p><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b><span class=""spnMessageText"">Google Adsense</span></font>" & vbNewLine
response.write " <p><font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>USA</small></font><br />" & vbNewLine & _
" <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>Mountain View</small></font></p></td>" & vbNewLine
Response.Write " </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"">" & vbnewline
Response.Write " <table width=""100%"" height=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td valign=""top"">" & vbNewLine
strColor = strColorBG
if (left(strColor,1) = "#") then
strColor = mid(strColor,2)
end if
%>
<script type="text/javascript"><!--
google_ad_client = "xxxxxxxxxxxxxx";
google_ad_width = 468;
google_ad_height = 60;
google_ad_format = "468x60_as";
google_ad_type = "text";
google_ad_channel ="";
google_color_border = "<%=strColor%>";
google_color_link = "0000FF";
google_color_bg = "<%=strColor%>";
google_color_text = "000000";
google_color_url = "008000";
//--></script>
<script type="text/javascript"
src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
</script>
<%
Response.Write " </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td valign=""bottom"" align=""right"" height=""20""><a href=""#top"">" & getCurrentIcon(strIconGoUp,strLangTopic00200,"align=""right""") & "</a></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine
end sub
at the beginning of the file declare one variable.
bolShowAdd = true
At the end of the big reply loop bevor the next insert this.
if bolShowAdd = true then
adsense(CColor)
bolShowAdd = false
end if
Here is an example:
http://www.thai-wahn.com/topic.asp?TOPIC_ID=4755
Please note: colors only work with rgb values. In case you need a ColorName RGB converter I can post the code here.
Chris < |
15 L A T E S T R E P L I E S (Newest First) |
AnonJr |
Posted - 18 August 2010 : 15:45:18 quote: Originally posted by giaguaro
I include my topic.asp It's a Serverhacker mod but i guess it's the same..
There's part of the problem - Its not the same. Its been too long since I last looked at Serverhacker's code to be able to say one way or the other how to help.
Add to that, you're looking to add something a little different than the original topic. There may be all sorts of odd little issues that you might not expect because of the differences in the ad code.
I would recommend that you first ask the Serverhacker community and see if they can help.
If they can't help, start a new topic instead of hijacking this one. Include the code (and/or a link to the reference) for the ad service you're trying to use and a link to a .txt version of your topic.asp |
giaguaro |
Posted - 18 August 2010 : 13:56:00 up |
giaguaro |
Posted - 14 August 2010 : 07:49:59 hello. I'm an OLD Snitz user (2002). I would like to insert between my post a banner rotation (not Adsense but another script). May i ask help to properly insert that at the half of the page? I include my topic.asp It's a Serverhacker mod but i guess it's the same.. Thanks in advance. Marco
<% '################################################################################# '## Copyright (C) 2000-02 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 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 support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## reinhold@bigfoot.com '## '## or '## '## Snitz Communications '## C/O: Michael Anderson '## PO Box 200 '## Harpswell, ME 04079 '################################################################################# %> <!--#INCLUDE FILE="config.asp"--> <!--#INCLUDE FILE="cal_functions.asp"--> <!--#INCLUDE FILE="cal_style.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 '###### Poll Mod ###### Dim vPercent(100) Dim vAnswers(15) Dim vCount(15) Dim mpoll, nMaxValue, nMaxWidth Dim nTotal, nTotal2, nThisVal '###################### if request("ARCHIVE") = "true" then strActivePrefix = strTablePrefix & "A_" ArchiveView = "true" ArchiveLink = "ARCHIVE=true&" 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 strSql = "SELECT M.M_NAME, M.M_RECEIVE_EMAIL, M.M_AIM, M.M_ICQ, M.M_MSN, M.M_YAHOO" & _ ", M.M_TITLE, M.M_HOMEPAGE, M.MEMBER_ID, M.M_LEVEL, M.M_POSTS, M.M_COUNTRY" & _ ", 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" & _ ", T_EVENT_DATE, T.T_ISEVENT" & _ ", 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, T.T_MSGICON, T.T_MESSAGE" if CanShowSignature = 1 then strSql = strSql & ", M.M_SIG" end if
'#######Avatar Start######## if StrShowAvatar = "1" then strSQL = strSQL & ", M.M_Avatar, M.M_AVATAR_WIDTH, M.M_AVATAR_HEIGHT" end if '#######Avatar End##########
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_YAHOO = rsTopic("M_YAHOO") 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") 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") if CanShowSignature = 1 then Topic_MemberSig = trim(rsTopic("M_SIG")) '############## Poll Mod ################## 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" 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") 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 end if if IsPoll = 1 then pollLink = "poll=1&" else pollLink = "" end if '########################################## end if dateHolder = strtodate(rsTopic("T_EVENT_DATE")) isevent = rsTopic("T_ISEVENT")
'#######Avatar Start######## if StrShowAvatar = "1" then Member_Avatar = rsTopic("M_AVATAR") Member_AvatarW = rsTopic("M_AVATAR_WIDTH") Member_AvatarH = rsTopic("M_AVATAR_HEIGHT") end if '#######Avatar End##########
end if
rsTopic.close set rsTopic = nothing
if recTopicCount = "" then if ArchiveView <> "true" then Response.Redirect("topic.asp?ARCHIVE=true&" & Request.QueryString) else Response.Redirect("default.asp") end if end if
'################ Poll Mod ############## if IsPoll = 1 then 'Check to see if user has voted Voted = GetVote(Topic_ID) end if '########################################
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 and Request.QueryString("REPLY_ID") <> "" then strSql1 = "SELECT REPLY_ID " strSql2 = "FROM " & strActivePrefix & "REPLY " strSql3 = "WHERE TOPIC_ID = " & Topic_ID & " " ' DEM --> if not a Moderator, all unapproved posts should not be viewed. if AdminAllowed = 0 then strSql3 = strSql3 & "AND (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_AUTHOR = " & MemberID & ") " end if strSql4 = "ORDER BY R_DATE ASC "
if strDBType = "mysql" then set rsReplies = Server.CreateObject("ADODB.Recordset")
rsReplies.open strSql1 & strSql2 & strSql3 & strSql4, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rsReplies.EOF then iReplyCount = "" else arrReplyData = rsReplies.GetRows(adGetRowsRest) iReplyCount = UBound(arrReplyData, 2) rREPLY_ID = 0 end if
LastPostReplyID = cLng(Request.QueryString("REPLY_ID"))
if iReplyCount <> "" then for iReply = 0 to iReplyCount intReplyID = arrReplyData(rREPLY_ID,iReply) if LastPostReplyID = intReplyID then intPageNumber = ((iReply+1)/strPageSize) if intPageNumber > cLng(intPageNumber) then intPageNumber = cLng(intPageNumber) + 1 end if strwhichpage = "whichpage=" & intPageNumber & "&" exit for end if next else strwhichpage = "" end if
rsReplies.Close set rsReplies = nothing else set rsReplies = Server.CreateObject("ADODB.Recordset") rsReplies.cachesize = strPageSize rsReplies.pagesize = strPageSize
rsReplies.open strSql1 & strSql2 & strSql3 & strSql4, my_Conn, adOpenStatic, adLockReadOnly, adCmdText
LastPostReplyID = cLng(Request.QueryString("REPLY_ID")) rsReplies.Find = "REPLY_ID=" & LastPostReplyID & ""
if not (rsReplies.EOF or rsReplies.BOF) then if rsReplies.absolutepage > 1 then strwhichpage = "whichpage=" & rsReplies.absolutepage & "&" else strwhichpage = "" end if
rsReplies.Close set rsReplies = nothing end if
Response.Redirect("topic.asp?" & strwhichpage & "TOPIC_ID=" & Topic_ID & "#" & 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_YAHOO" strSql = strSql & ", M.M_TITLE, M.MEMBER_ID, M.M_HOMEPAGE, M.M_LEVEL, M.M_POSTS, M.M_COUNTRY" 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
'#######Avatar Start######## if StrShowAvatar = "1" then strSQL = strSQL & ", M.M_Avatar, M.M_AVATAR_WIDTH, M.M_AVATAR_HEIGHT" end if '#######Avatar End##########
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 Mod ##################################### 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 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 totals.</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 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 '## Forum_SQL - 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 '## Forum_SQL - 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" if Voted <> true then Call UpdateVote("1", MemberID, Topic_ID, Forum_ID, Cat_ID) end if Case else if 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 '###########################################################################################
Response.Write " <table border=""0"" width=""100%"">" & vbNewLine & _ " <tr>" & vbNewLine & _ " <td width=""100%"" align=""left"" nowrap><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _ " " & getCurrentIcon(strIconFolderOpen,"","align=""absmiddle""") & " <a href=""default.asp"">All Forums</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 isevent=1 then Response.Write " " & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBar,"","align=""absmiddle""") & getCurrentIcon(strIconEvent,"","") & " " & strCalEvent else 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 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 & _ " </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=""100%"">" & 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 width=""100%"" valign=""top"" bgcolor=""" & strTableBorderColor & """ border=""0"" cellspacing=""1"" cellpadding=""4"">" & vbNewLine & _ " <tr>" & vbNewLine & _ " <td align=""center"" width=""100%"" bgcolor=""" & strCategoryCellColor & """>" & vbNewLine Call PostingOptions() Response.Write " </td>" & vbNewLine & _ " </tr>" & vbNewLine & _ " </table>" & vbNewLine Response.Write "<table align=""center"" border=""0"" cellPadding=""0"" cellSpacing=""0"" width=""100%"">" & 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 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_YAHOO = 5 rM_TITLE = 6 rMEMBER_ID = 7 rM_HOMEPAGE = 8 rM_LEVEL = 9 rM_POSTS = 10 rM_COUNTRY = 11 rREPLY_ID = 12 rFORUM_ID = 13 rR_AUTHOR = 14 rTOPIC_ID = 15 rR_MESSAGE = 16 rR_LAST_EDIT = 17 rR_LAST_EDITBY = 18 rR_SIG = 19 rR_STATUS = 20 rR_DATE = 21 rR_MSGICON = 22 if CanShowSignature = 1 then rM_SIG = 23 if StrShowAvatar = "1" then rM_AVATAR = 24 rM_AVATAR_WIDTH = 25 rM_AVATAR_HEIGHT = 26 end if else if StrShowAvatar = "1" then rM_AVATAR = 23 rM_AVATAR_WIDTH = 24 rM_AVATAR_HEIGHT = 25 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_MemberYAHOO = arrReplyData(rM_YAHOO, 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_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
'#######Avatar Start######## if StrShowAvatar = "1" then Reply_MemberAvatar = arrReplyData(rM_AVATAR, iForum) Reply_MemberAvatarW = arrReplyData(rM_AVATAR_WIDTH, iForum) Reply_MemberAvatarH = arrReplyData(rM_AVATAR_HEIGHT, iForum) end if '#######Avatar End##########
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"">" & 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_MemberID, Reply_MemberLevel, Reply_MemberPosts) & "<br />" & vbNewLine end if
'#######Avatar Start######## if StrShowAvatar = "1" then if not Reply_MemberAvatar = "" then Response.Write "<br /><img width=""" & Reply_MemberAvatarW & """ height=""" & Reply_MemberAvatarH & """ src='" & Reply_MemberAvatar & "'><br />" end if end if '#######Avatar End##########
Response.Write " </p>" & vbNewLine & _ " <p>" & vbNewLine
Response.Write " <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 colspan=""2"" 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 " " & profileLink(getCurrentIcon(strIconProfile,"Show 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:openWindow('pop_mail.asp?id=" & Reply_MemberID & "')"">" & getCurrentIcon(strIconEmail,"Email Poster","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 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 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(strIconReplyTopic,"Reply with Quote","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine end if if (strIPLogging = "1") then if (AdminAllowed = 1) then Response.Write " <a href=""JavaScript:openWindow('pop_viewip.asp?" & ArchiveLink & "mode=getIP&REPLY_ID=" & Reply_ReplyID & "&FORUM_ID=" & Forum_ID & "')"">" & getCurrentIcon(strIconIP,"View 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 Request.QueryString("SearchTerms") <> "" then Response.Write SearchHiLite(formatStr(Reply_Content)) else Response.Write formatStr(Reply_Content) end if Response.Write "</span id=""msg""></font><br><br></td>" & vbNewLine & _ " </tr>" & vbNewLine if CanShowSignature = 1 and Reply_Sig = 1 and Reply_MemberSig <> "" then Response.Write " <tr>" & vbNewLine & _ " <td valign=""bottom""><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=""" & strFooterFontSize & """ color=""" & CColor & """><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 colspan=""2"" valign=""bottom"" align=""left"" height=""20""><hr noshade size=""" & strFooterFontSize & """><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """></td></tr><td width=""100%"" nowrap>" & vbNewLine & _ " <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>Country: " & Reply_MemberCountry & " </small></font>" & vbNewLine & _ " <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>| Posts: " & Reply_MemberPosts & "</small></font></td>" & vbNewLine & _ " <td valign=""top"" align=""right"" width=""1""><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 Response.Write " </tr>" & vbNewLine & _ " </table>" & vbNewLine & _ " </td>" & vbNewLine & _ " </tr>" & vbNewLine & _ " </table>" & vbNewLine & _ " </td>" & vbNewLine & _ " </tr>" & vbNewLine & _ "</table>" & vbNewLine Response.Write " <table width=""100%"" valign=""top"" bgcolor=""" & strTableBorderColor & """ border=""0"" cellspacing=""1"" cellpadding=""4"">" & vbNewLine & _ " <tr>" & vbNewLine & _ " <td align=""center"" width=""100%"" bgcolor=""" & strCategoryCellColor & """>" & vbNewLine Call PostingOptions() Response.Write " </td>" & vbNewLine & _ " </tr>" & vbNewLine & _ " </table>" & vbNewLine if maxpages > 1 then Response.Write "<table align=""center"" border=""0"" cellPadding=""0"" cellSpacing=""1"" width=""100%"">" & 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 Response.Write "<table align=""center"" border=""0"" cellPadding=""0"" cellSpacing=""0"" width=""100%"">" & vbNewLine & _ " <tr>" & vbNewLine & _ " <td>" & vbNewLine & _ " <table width=""100%"">" & vbNewLine & _ " <tr>" & vbNewLine & _ " <td align=""center"" valign=""top"" width=""100%"" nowrap>" & vbNewLine %> <!--#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 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"">" & 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(TMember_ID, Member_Level, Member_Posts) & "<br />" & vbNewLine end if '#######Avatar Start######## if StrShowAvatar = "1" then if not Member_Avatar = "" then Response.Write "<br /><img width=""" & Member_AvatarW & """ height=""" & Member_AvatarH & """ src='" & Member_Avatar & "'><br />" end if end if '#######Avatar End##########
Response.Write " <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 " " & profileLink(getCurrentIcon(strIconProfile,"Show 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:openWindow('pop_mail.asp?id=" & TMember_ID & "')"">" & getCurrentIcon(strIconEmail,"Email Poster","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 Mod ############################### 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 Mod - 1 line ########## 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 (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 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(strIconReplyTopic,"Reply with Quote","align=""absmiddle"" hspace=""6""") & "</a>" & vbNewLine end if if (strIPLogging = "1") then if (AdminAllowed = 1) then Response.Write " <a href=""JavaScript:openWindow('pop_viewip.asp?" & ArchiveLink & "mode=getIP&TOPIC_ID=" & TopicID & "&FORUM_ID=" & Forum_ID & "')"">" & getCurrentIcon(strIconIP,"View 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 Mod - Added 'pollLink' to line 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 '###################################################################################### 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 if isevent=1 then Response.Write " <tr><td>" & vbnewline DrawMonth2 dateHolder, 1, 1, 1 Response.Write " <br><b><font size=""5"" color=""" & StrForumLinkColor & """>" & ChkString(Topic_Subject, "title") & "</font></b></td></tr>" end if Response.Write " <tr>" & vbNewLine '####################################### Poll Mod ################################## 'Remember to remove the &_ from the end of the line above. ' " <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 & _ Response.Write " <td valign=""top"" height=""100%""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>" & vbNewLine if IsPoll = 1 then Status = cint(Cat_Status + Forum_Status + Topic_Status) if Voted = false and Request.QueryString("results") <> "1" and Status = 3 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 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 & _ " <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"">" & 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=""Vote Now"" onClick=""submitPoll(this)"">" & vbNewLine & _ "<input type=""image"" src=""" & strImageURL & "view_results.gif"" name=""results"" width=""95"" height=""16"" hspace=""0"" alt=""Poll Results"" onClick=""submitPoll(this)"">" & vbNewLine 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 Response.Write "<font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>(Anonymous Vote)</font>" & vbNewLine & _ " <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 Status < 3 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) Response.Write " <tr>" & vbNewLine & _ " <td width=""30%""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strDefaultFontSize & """>" & 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 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 Status < 3 or Poll_Status = 0 or Forum_Polls = "0" then Response.Write "Locked" else Response.Write "Open" end if Response.Write " #187;#187; </font></td>" & vbNewLine & _ " <td align=""left""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strFooterFontSize & """>" & vbNewLine & _ " <b>Total Votes:</b> " & nTotal & " counted #187;#187; </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 ' Remember to start the 2nd line below with Response.Write. ' ##################################################################################### Response.Write " </tr>" & vbNewLine if CanShowSignature = 1 and Topic_Sig = 1 and Topic_MemberSig <> "" then Response.Write " <tr>" & vbNewLine & _ " <td valign=""bottom""><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 & """>" &_ "Edited by - " & Topic_LastEditByName & " on " & chkDate(Topic_LastEdit, " ", true) & "</font>" & vbNewLine & _ " </tr>" & vbNewLine end if Response.Write " <tr>" & vbNewLine & _ " <td valign=""bottom"" align=""left"" height=""20""><hr noshade size=""" & strFooterFontSize & """><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & vbNewLine & _ " <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>Country: " & Member_Country & " </small></font>" & vbNewLine & _ " <font color=""" & strForumFontColor & """ face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><small>| Posts: " & Member_Posts & "</small></font></td>" & vbNewLine & _ " </tr>" & vbNewLine & _ " </table>" & vbNewLine & _ " </td>" & vbNewLine & _ " </tr>" & vbNewLine End Sub
sub PostingOptions() Response.Write " <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>" & 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 Mod ################################ 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> | " & vbNewLine end if '######################################################################## 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 Mod ############################### 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> | " & vbNewLine '#################################################################### 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 " " & 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 " " & 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 Mod ################################ 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 " <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 Mod ########### end if end if if lcase(strShowPrinterFriendly) = "1" and Topic_Status < 2 then Response.Write " <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 Mod - Added 'pollLink' to line 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 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 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=""" & 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 & " 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 '##### Next/Prev Topic Title Hover MOD ##### prevTopic = "<a href=""topic.asp?" & ArchiveLink & "TOPIC_ID=" & rsPrevTopic("TOPIC_ID") & """>" & getCurrentIcon(strIconGoLeft,"" & "Previous Topic: " & chkString(rsPrevTopic("T_SUBJECT"),"imagetag") & "","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 & " 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 '##### Next/Prev Topic Title Hover MOD ##### nextTopic = "<a href=""topic.asp?" & ArchiveLink & "TOPIC_ID=" & rsNextTopic("TOPIC_ID") & """>" & getCurrentIcon(strIconGoRight,"" & "Next Topic: " & chkString(rsNextTopic("T_SUBJECT"),"imagetag") & "","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=""1"" cellpadding=""0"" align=""center"" bgcolor=""" & strPopUpBorderColor & """>" & vbNewLine & _ " <tr>" & vbNewLine & _ " <td bgcolor=""" & strPopUpBorderColor & """>" & vbNewLine & _ " <table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""4"">" & 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") & "?" & replace(Request.QueryString,"#","#") & """>" & 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=""" & strTableBorderColor & """ colspan=""2""></td>" & vbNewLine & _ " </tr>" & vbNewLine & _ " <tr>" & vbNewLine & _ " <td bgcolor=""" & strAltForumCellColor & """ 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 '##### Super/Admin/Mod HTML Only Mod ##### if strAllowHTML = "1" or chkSuperAdminModHtmlOk 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"" type=""checkbox"" value=""yes""" & chkCheckbox(intSigDefault,1,true) & ">Include Signature<br />" & vbNewLine end if Response.Write " </font></td>" & vbNewLine & _ " </tr>" & vbNewLine & _ " </table>" & vbNewLine & _ " </span></font></td>" & vbNewLine & _ " <td width=""" & strTopicWidthRight & """ bgColor=""" & strAltForumCellColor & """><textarea name=""Message"" cols=""50"" rows=""6"" wrap=""VIRTUAL"" style=""width:100%""></textarea><br /></td>" & vbNewLine & _ " </tr>" & vbNewLine & _ " <tr>" & vbNewLine & _ " <td bgColor=""" & strAltForumCellColor & """ noWrap align=""center"" colspan=""2""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """><input class=buttons name=""Submit"" type=""submit"" value=""Submit Reply""> <input class=buttons name=""Preview"" type=""button"" value=""Preview Reply"" onclick=""OpenPreview()""> <input class=buttons name=""Reset"" type=""reset"" value=""Reset Form""></font></td>" & vbNewLine & _ " </tr>" & vbNewLine & _ " <tr >" & vbNewLine & _ " <td bgColor=""" & strAltForumCellColor & """ colspan=""2""></td>" & vbNewLine & _ " </tr>" & vbNewLine & _ " <tr >" & vbNewLine & _ " <td bgColor=""" & strAltForumCellColor & """ colspan=""2""></td>" & vbNewLine & _ " </tr>" & vbNewLine & _ " <tr >" & vbNewLine & _ " <td bgColor=""" & strAltForumCellColor & """ colspan=""2""></td>" & vbNewLine & _ " </tr>" & vbNewLine & _ " <tr >" & vbNewLine & _ " <td bgColor=""" & strAltForumCellColor & """ colspan=""2""></td>" & vbNewLine & _ " </tr>" & vbNewLine & _ " </form>" & vbNewLine & _ " </table>" & vbNewLine & _ " </td>" & vbNewLine & _ " </tr>" & vbNewLine & _ " </table>" & vbNewLine end sub
%>
<% ' resample and proportinalize image
Sub GetPicFileInfo( i_sFilename, o_PicType, o_nWidth, o_nHeight )
i_sFilename = replace(i_sFilename, "/", "\", 1, -1, 1) o_PicType = "" o_nWidth = 0 o_nHeight = 0
Dim fso, ts Dim GIF_MARKER, JPG_MARKER
GIF_MARKER = "GIF8" JPG_MARKER = Chr(&HFF) & Chr(&HD8) & Chr(&HFF) & Chr(&HE0)
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set ts = fso.OpenTextFile(Server.MapPath("" & StrForumURL & "" & i_sFilename))
If Err.Number <> 0 Then Err.Clear Set ts = fso.OpenTextFile("" & StrImageURL & "noavatar.gif") End if
Select Case ts.Read(4) Case GIF_MARKER o_PicType = "GIF" ts.Skip(2) If Err.Number <> 0 Then Exit Sub End If o_nWidth = Asc(ts.Read(1)) + ( Asc(ts.Read(1))* 256 ) o_nHeight = Asc(ts.Read(1)) + ( Asc(ts.Read(1))* 256 )
Case JPG_MARKER o_PicType = "JPG"
Dim byteVal, bDone bDone = False byteVal = Asc(ts.Read(1)) Do While Not ts.AtEndOfStream And byteVal <> &HD8 And Not bDone 'look for the next marker (xFF) Do While Not ts.AtEndOfStream And byteVal <> &HFF byteVal = Asc(ts.Read(1)) Loop
'Get past any repeated xFF markers Do While Not ts.AtEndOfStream And byteVal = &HFF byteVal = Asc(ts.Read(1)) Loop
'Check out the marker 'if this is the width/height section then read the values If ((byteVal >= &HC0) And (byteVal <= &HC3)) Then ts.Skip(3) If Err.Number <> 0 Then Exit Sub End If If Not ts.EOF Then o_nHeight = (Asc(ts.Read(1)) * 256) + Asc(ts.Read(1)) o_nWidth = (Asc(ts.Read(1)) * 256) + Asc(ts.Read(1)) bDone = True End If Else 'this is a comment or other stuff we are not interested in. 'we must read the size and then skip over this section Dim nSectionLength nSectionLength = (Asc(ts.Read(1)) * 256) + Asc(ts.Read(1))
'NOTE: we subtract two since from the size since we already 'are past the length bytes which are included in the size ts.Skip(nSectionLength - 2) byteVal = Asc(ts.Read(1))
If Err.Number <> 0 Then Exit Sub End If End If Loop End Select
maxwidth = 64 maxheight = 100 if o_nWidth > maxwidth or o_nHeight > maxheight then if o_nWidth > maxwidth then o_nHeight = cInt(o_nHeight * maxwidth/o_nWidth) o_nWidth = maxwidth if (o_nHeight > maxheight) then o_nWidth = cInt(o_nWidth * maxheight/o_nHeight) o_nHeight = maxheight end if elseif o_nHeight > maxheight then o_nWidth = cInt(o_nWidth * maxheight/o_nHeight) o_nHeight = maxheight if (o_nWidth > maxwidth) then o_nHeight = cInt(o_nHeight * maxwidth/o_nWidth) o_nWidth = maxwidth end if end if end if o_nText = " X " response.write " width=""" & o_nWidth & """ height=""" & o_nHeight & """" response.write " title=""" & o_nWidth & o_nText & o_nHeight & """" Set ts = Nothing Set fso = Nothing End Sub
%>
|
akintosyali |
Posted - 15 August 2008 : 01:57:39 I get the following error when I implement this code. What am I doing wrong? Microsoft JET Database Engine error '80040e10'
No value given for one or more required parameters.
/forum/topic.asp, line 126
[quote]Originally posted by Podge
Try the following version of your topic.asp
I added the code to sub GetFirst so that ads are shown between the first thread and before the first reply. You can change Google, Mountainview to whatever you like. Its just text. < |
gpspassion |
Posted - 04 June 2008 : 20:34:28 quote: Originally posted by MarkJH To make the ads only visible to guests, add the mlev = 0 bit below to the code. To only display an ad after a topic has been replied to, add the iReplyCount <> "" bit below to the code. With both parts added, your code should look like this:
'############# Google Adsense #############
if bolShowAdd = true and mlev = 0 and iReplyCount <> "" then
adsense(CColor) 'Show the Google ad
bolShowAdd = false 'Turn off ads shown further down the page. You can change this to true if needed.
end if
Hope this helps somebody.
That sure did, thanks ! Too bad they don't have more Snitz-Friendly formats like 640x80< |
mitchell-krog |
Posted - 28 June 2007 : 14:47:38 quote: Originally posted by bobby131313
And a little tip, the top ad in the unit is the highest paying click, and it's hanging out up in the corner out of the way. I would push the whole unit down so that the top edge of the top ad is at least even with the top edge of the main forum table.
Thank you for that tip Bobby. I moved the ad units down so that the first ad is level with the top of the forum. Thanks for that ... makes total sense :)
Cheers Mitch < |
mitchell-krog |
Posted - 28 June 2007 : 14:46:32 quote: Originally posted by MarkJH
You're welcome.
One little thing: you've got the text "Footer area" in your, well, footer area. Not sure if that was an oversight or not but there you go.
Thank you Mark, I fixed that :)< |
bobby131313 |
Posted - 14 June 2007 : 19:38:12 And a little tip, the top ad in the unit is the highest paying click, and it's hanging out up in the corner out of the way. I would push the whole unit down so that the top edge of the top ad is at least even with the top edge of the main forum table.
< |
MarkJH |
Posted - 14 June 2007 : 18:09:36 You're welcome.
One little thing: you've got the text "Footer area" in your, well, footer area. Not sure if that was an oversight or not but there you go. < |
mitchell-krog |
Posted - 14 June 2007 : 16:49:15 Thank you Mark, I implemented the SiteIntegration Mod and it ROCKS.
Regards Mitchell www.environment.co.za < |
MarkJH |
Posted - 12 June 2007 : 19:25:59 Easy, if you use the Site Integration MOD < |
mitchell-krog |
Posted - 12 June 2007 : 18:26:32 Hi everyone I am new on the forums but not new to Snitz. I have been using it pretty much out of the box since I first began. Just recently I upgraded it and started with some mods. I want to put Google Adsense onto my forum but I would like it placed as in the image below. (hope you can see it) Could anyone give me some advice on where to insert the code ... I do not want to mess up my pages.
Many Thanks Mitch
If you cannot see the image try here: http://www.environment.co.za/photosmk/GoogleAdSense.jpg < |
MarkJH |
Posted - 26 May 2007 : 11:48:02 I must be getting clever in my old age...
In Podge's code, look for this:
'############# Google Adsense #############
if bolShowAdd = true then
adsense(CColor) 'Show the Google ad
bolShowAdd = false 'Turn off ads shown further down the page. You can change this to true if needed.
end if
To make the ads only visible to guests, add the mlev = 0 bit below to the code. To only display an ad after a topic has been replied to, add the iReplyCount <> "" bit below to the code. With both parts added, your code should look like this:
'############# Google Adsense #############
if bolShowAdd = true and mlev = 0 and iReplyCount <> "" then
adsense(CColor) 'Show the Google ad
bolShowAdd = false 'Turn off ads shown further down the page. You can change this to true if needed.
end if
Hope this helps somebody. < |
MarkJH |
Posted - 26 May 2007 : 11:25:26 Looking good! Though, how would I make this work only when at least one reply has been made to the topic? I don't want it to show a one post topic with an advert underneath.< |
bobby131313 |
Posted - 25 May 2007 : 10:55:11
Hee hee...
< |
|
|