Snitz Forums 2000
Snitz Forums 2000
Home | Profile | Register | Active Topics | Members | Search | FAQ
Username:
Password:
Save Password
Forgot your Password?

 All Forums
 Help Groups for Snitz Forums 2000 Users
 Help: MOD Implementation
 Points Mod Compatibility
 New Topic
 Printer Friendly
Previous Page | Next Page
Author Previous Topic Topic Next Topic
Page: of 3

MaGraham
Senior Member

USA
1297 Posts

Posted - 05 December 2013 :  13:54:37  Show Profile

Is there a way for members to earn more points for replying to a particular topic? I'm just trying to get more to participate in a particular area.


"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
Go to Top of Page

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 06 December 2013 :  00:07:24  Show Profile
Yes, you'd want to change the code in "inc_func_common.asp".


Look for this routine:

'	##	Points Below
Function GetPoints(ActionCode)
	If strPointsEnabled = "0" Then
		GetPoints = 0
	Else
		strSql = "select P_POINTS from " & strTablePrefix & "POINT_ACTIONS WHERE P_ENABLED = 1 AND P_ACTION = '" & ActionCode & "'"
		Set rsPoints = Server.CreateObject("ADODB.RECORDSET")
		rsPoints.open strSql, my_Conn
		pVal=0
		If not rsPoints.EOF Then
			pVal =  rsPoints("P_POINTS")
			rsPoints.Close
		End If
		Set rsPoints = Nothing
		GetPoints = pVal
	End If
End Function
'	##	Points Above

Now, what you'd want to do is modify the value of "GetPoints" just before the "End If" statement.  Something like this (replace the first set of  ? marks in red with the forum # where you want the additional points awarded, then replace the second set of ? marks with the amount of points:

		GetPoints = pVal
		If forum_id=??? Then GetPoints=GetPoints+??
	End If
End Function
'	##	Points Above

Edited by - Carefree on 06 December 2013 03:12:28
Go to Top of Page

MaGraham
Senior Member

USA
1297 Posts

Posted - 06 December 2013 :  02:32:39  Show Profile

If I make this change, does this mean a member would now only receive points when posting to a particular topic, or will they still receive points for ANY posting?

I'm asking because I may not have made myself clear. I want them to continue to receive points for replying to ALL posts, just more points for a particular post.

Also, if I add more possible ways of them receiving points, how do I know what "code" to use?


"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
Go to Top of Page

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 06 December 2013 :  03:13:31  Show Profile
All posts would continue to be awarded points, the point value for the forum number specified would be higher by the amount specified following it.
Go to Top of Page

MaGraham
Senior Member

USA
1297 Posts

Posted - 06 December 2013 :  10:55:15  Show Profile
The forum number is 10, and I chose 10 points.

If forum_id=10 Then GetPoints=GetPoints+10

It works fine, but it's giving 15 points. (lol) I won't complain about that though but just thought I'd let you know, Carefree.

What a NEAT way to get members more involved on a particular forum! I LOVE IT!!

Thank you so much, Carefree!


"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
Go to Top of Page

MaGraham
Senior Member

USA
1297 Posts

Posted - 06 December 2013 :  11:30:59  Show Profile

Question: What if a member adds "glow" to his/her username and then decides he/she doesn't want it? What can I do to remove it?


Also, how could I make this "removal of glow" an option in the Points Store? Or, is that even possible? Your thoughts on this, Carefree?


"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 06 December 2013 11:43:09
Go to Top of Page

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 06 December 2013 :  18:46:32  Show Profile
quote:
Originally posted by MaGraham

The forum number is 10, and I chose 10 points.

If forum_id=10 Then GetPoints=GetPoints+10

It works fine, but it's giving 15 points.




It's giving 15 because you selected 5 as the default. Ergo, 5 (GetPoints) + 10 = 15..... Change the + value to 5 if you want to award 10.
Go to Top of Page

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 06 December 2013 :  18:49:56  Show Profile
quote:
Originally posted by MaGraham


Question: What if a member adds "glow" to his/her username and then decides he/she doesn't want it? What can I do to remove it?


Also, how could I make this "removal of glow" an option in the Points Store? Or, is that even possible? Your thoughts on this, Carefree?




I'll look at this one later, running out of time now. Tests in 13 minutes.
Go to Top of Page

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 07 December 2013 :  09:25:49  Show Profile
OK - to remove, you could edit the database "Members" table and delete the content of the "M_Glow_Text" field for that member. Alternatively, you could replace two files (like normal, back them up, these are untested):

"pstore.asp"

<%
'#################################################################################
'## 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="inc_header.asp" -->
<!--#INCLUDE FILE="inc_func_member.asp" -->
<!--#INCLUDE FILE="inc_func_secure.asp" -->
<%
tItem = Request.QueryString("item")
Response.Write	"      <table width=""100%"" border=""0"">" & VbNewLine & _
		"        <tr>" & VbNewLine & _
		"          <td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & VbNewLine & _
		"          " & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""default.asp"">All Forums</a><br />" & VbNewLine
If tItem <> "" Then
  Response.Write "          " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""pstore.asp"">" & strForumTitle & " Store</a><br />" & VbNewLine & _
		"          " & getCurrentIcon(strIconBlank,"","") & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " Purchase Item</font></td>" & VbNewLine
Else
   Response.Write "          " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " " & strForumTitle & " Store</font></td>" & VbNewLine
End If
Response.Write "        </tr>" & VbNewLine & _
		"      </table>" & VbNewLine
Response.Write "<table width=""100%"" align=center border=0 cellpadding=4 cellspacing=0>" & VbNewLine
If tItem = "" Then 
   Response.Write "    <tr>" & VbNewLine & _
      "        <td align=center><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strDefaultFontColor & """><b>" & strForumTitle & " Store</b></font></td>" & VbNewLine & _
      "     </tr>" & VbNewLine & _
      "    <tr>" & VbNewLine & _
      "        <td valign=""top"">" & VbNewLine
    strSql = "select M_POINTS,M_GLOW_TEXT from " & strTablePrefix & "MEMBERS where MEMBER_ID = " & MEMBERID
    Set rs = my_Conn.Execute(strSql)
    If Not rs.EOF Then
       TotPoints = rs("M_POINTS")
       intGText=0
       If NOT ISNULL(RS("M_GLOW_TEXT")) Then intGText=1
    Else
       TotPoints = 0
    End If
    rs.Close
    Response.Write "<p align=""center"">"
    Response.Write "<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>Here you can use the points you've earned to 'purchase' items. " & VbNewLine & _
                   "<br><a href=""points.asp"">Click here to learn more about the point system</a>" & VbNewLine
    If strDBNTUserName = "" Then
       Response.Write "<br><font color=""" & strHilliteFontColor & """>You must login to use the store</font>"
    Else
       Response.Write "<br><font color=""green"">You have " & TotPoints & " points to spend</font>"
    End If
    Response.Write "</font></p>"

    strSql = "select P_ITEM, P_TITLE, P_COST, P_DESCRIPTION, P_SOLD_COUNT " &_
             "from " & strTablePrefix & "STORE_ITEMS " & _
             "  where P_ENABLED = 1 " &_
             "    and P_INSTORE = 1 " & _
             "order by P_COST ASC"
    rs.open strSql, my_Conn
    Response.Write "<table width=""100%"">"
    Do until rs.EOF
       Response.Write "<tr><td valign=top width=""50%"">" & VbNewLine
       
       Response.Write "<table border=0 cellspacing=1 bgcolor=""" & strTableBorderColor & """ width=""100%"" align=center>" & VbNewLine &_
                      "<tr><td align=center bgcolor=""" & strAltForumCellColor & """><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """><a href=""pstore.asp?item=" & rs("P_ITEM") & """>" & rs("P_TITLE") & "</a></font></td></tr>" & VbNewLine
       Response.Write "<tr><td bgcolor=""" & strForumCellColor & """ align=center><font face=""" & strDefaultFontFace & """ Size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & rs("P_DESCRIPTION") & "</font><br><br>" & VbNewLine
       If rs("P_ITEM")="1503" Then
       	If intGText=1 Then
       		intCost=0
       	Else
       		intCost=formatnumber(rs("P_COST"), 0)
       	End If
       End If
       Response.Write "<table align=center border=0>" & VbNewLine &_
                      "<tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Cost:</b></font></td><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & intCost & "</font></td>" & VbNewLine &_
                      "<tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Sold:</b></font></td><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & rs("P_SOLD_COUNT") & "</font></td>" & VbNewLine &_
                      "<tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>You need:</b></td><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" 
       If intCost < TotPoints Then
          Response.Write "0"
       Else
          Response.Write formatnumber(intCost-TotPoints,0)
       End If
       Response.Write  "</font></td>" & VbNewLine
       Response.Write "</tr></table>"
       rs.MoveNext
       
       Response.Write "</td></tr></table></td><td valign=""top"" width=""50%"">" & VbNewLine
       If Not rs.EOF Then
          Response.Write "<table bgcolor=""" & strTableBorderColor & """ border=0 cellspacing=1 width=""100%"" align=center>" & VbNewLine &_
                         "<tr><td align=center bgcolor=""" & strAltForumCellColor & """><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """><a href=""pstore.asp?item=" & rs("P_ITEM") & """>" & rs("P_TITLE") & "</a></font></td></tr>" & VbNewLine
          Response.Write "<tr><td bgcolor=""" & strForumCellColor & """  align=center ><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & rs("P_DESCRIPTION") & "</font><br><br>" & VbNewLine
       Response.Write "<table align=center border=0>" & VbNewLine &_
                      "<tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Cost:</b></font></td><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & intCost & "</font></td>" & VbNewLine &_
                      "<tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Sold:</b></font></td><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & rs("P_SOLD_COUNT") & "</font></td>" & VbNewLine &_
                      "<tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>You need:</b></td><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" 
       If  intCost < TotPoints Then
          Response.Write "0"
       Else
          Response.Write formatnumber(intCost - TotPoints, 0)
       End If
       Response.Write  "</font></td>" & VbNewLine
          Response.Write "</tr></table></td></tr></table>"
          rs.MoveNext
       End If
       Response.Write "</td></tr>" & VbNewLine

    Loop
    Response.Write "</table>"
    rs.Close
    Set rs = Nothing  
'    my_Conn.Close
    Response.Write "</td></tr>" & VbNewLine
 Else 
      %><!-- #include file="PurchaseItem.asp" --><%
      Response.Write "<tr><td>" & VbNewLine
      Call PurchaseItem()
      Response.Write "</td></tr>"
 End If
 Response.Write "</table>" & VbNewLine
WriteFooter
%>


"purchaseitem.asp"

<%
 Dim MemberPoints
 Dim MemberLevel 
 Dim MemberPosts 
 Dim MemberTitle
 Dim MemberAvatar 
 Dim ItemCost 
 Dim ItemTitle
 Dim ItemSoldCount
 Dim ItemEnabled
 
 Sub PurchaseItem()
   Set rs = Server.CreateObject("ADODB.RECORDSET")
   ERR = 0
   DoIt = cbool(Request.Form("dd"))
   'First lets get info about the user
   strSql = "select M_POINTS, M_TITLE, M_LEVEL, M_POSTS "
   
   '--uncomment below if using avatar mod
   'strSql = strSql & ", M_AVATAR_URL "
   
   strSql = strSql & " from " & strTablePrefix & "MEMBERS " & _
            "where MEMBER_ID=" & MemberID

   rs.open strSql, my_Conn,3,3
   If Not rs.EOF Then
      MemberPoints = rs("M_POINTS")
      MemberLevel = rs("M_LEVEL")
      MemberPosts = rs("M_POSTS")
      MemberTitle = rs("M_TITLE")
      '-- Uncomment below if using avatar mod
      'MemberAvatar = rs("M_AVATAR_URL")
   Else
      GoError("You must be logged in to purchase items from the store")
      tItem = 0
      ERR = 1
   End If
   rs.Close 
  
   If ERR = 0 Then
      'get item cost etc...
      strSql = "select P_COST, P_TITLE, P_SOLD_COUNT, P_ENABLED " & _
               " from " & strTablePrefix & "STORE_ITEMS " &_
               " where P_ITEM = " & tItem
      rs.open strSql, my_Conn
      If Not rs.EOF Then
         ItemCost = rs("P_COST")
         ItemTitle = rs("P_TITLE")
         ItemSoldCount = rs("P_SOLD_COUNT")
         ItemEnabled = rs("P_ENABLED")
      Else
         GoError("That Item does not exist")
         tItem = 0
      End If
      
      rs.Close
      
      If ItemEnabled <> 1 Then
         GoError("That Item does not exist")
         tItem = 0
      ElseIf ItemCost > MemberPoints Then
         GoError("You do not have enough points to " & ItemTitle)
         tItem = 0
      End If
   End If
  
   strErr = ""
   
   Select Case tItem
      '=========
      Case 1500 'Donate points
      '=========
         CreateTable(ItemTitle)
         If DoIt <> True Then
            Call ShowStats()
            Response.Write "Donate points to: <input size=15 type=text name=dTo><br>" & VbNewLine &_
                           "Amount to Donate: <input size=3 type=text name=dAmt> <font size=""" & strFooterFontSize & """>max " & MemberPoints -ItemCost & "</font><br>" & VbNewLine &_
                           "<font size=""" & strFooterFontSize & """>a " & ItemCost & "pt prccessing fee will be applied.</font>"
            CloseTable(1)
         Else
            If Request.Form("dTo") = ""  Or GetMemberID(Request.Form("dTo")) = 0 Then
               strErr = strErr & "<li>You must enter a valid member name</li>"
            End If
            DonateAmount = Request.Form("dAmt")
            If DonateAmount = "" Then
               strErr = strErr & "<li>You must enter a valid donation amount</li>"
            ElseIf cint(DonateAmount) > (MemberPoints -ItemCost) Then
               strErr = strErr & "<li>You cannot donate more then you have.</li>"
            End If
            If strErr <> "" Then
               GoError(strErr)
            Else
               strSql = "update " & strTablePrefix & "MEMBERS set M_POINTS = M_POINTS + " & DonateAmount &_
                        " where M_NAME='" & Request.Form("dTo") & "'"
               my_Conn.Execute (strsql)
               strSql = "update " & strTablePrefix & "MEMBERS set M_POINTS = M_POINTS - (" & DonateAmount & " + " & ItemCost & ")" &_
                        " where MEMBER_ID=" & MemberID
               my_Conn.Execute (strsql)
               UpdateItemCount
               Response.Write DonateAmount & " points have been transferred to " & Request.Form("dTo") & "'s account"
               Call BackToStore
             End If
            CloseTable(0)

            
         End If      
      '=========
      Case 1501 'Change Title
      '=========
         CreateTable(ItemTitle)
         If DoIt <> True Then
            Call ShowStats()
            Response.Write "Current Title: " & ChkString(getMember_Level(MemberTitle, MemberLevel, MemberPosts), "display") & "<br>" & VbNewLine &_
                           "Change To: <input size=20 type=text name=dTitle><br>" & VbNewLine
            CloseTable(1)
         Else
            If Request.Form("dTitle") = "" Then
               strErr = strErr & "<li>You must enter a title you would like to use.</li>"
            End If
            If len(Request.Form("dTitle")) > 25 Then
               strErr = strErr & "<li>Titles cannot be more then 25 characters long.</li>"
            End If

            If strErr <> "" Then
               GoError(strErr)
            Else
               strSql = "update " & strTablePrefix & "MEMBERS set M_TITLE = '" & chkString(Request.Form("dTitle"), "SQLString") & "', " &_
                        "M_POINTS = M_POINTS -" & ItemCost &_
                        " where MEMBER_ID=" & MemberID
               my_Conn.Execute (strsql)
               UpdateItemCount
               Response.Write "<br>Your title has been changed."
               Call BackToStore

            End If  
            CloseTable(0)
         End If
         
      '=========
      Case 1502 'Buy lottery ticket
      '=========
         CreateTable(ItemTitle)
      '=========
      Case 1503 'add glow to name
      '=========
         CreateTable(ItemTitle)
         If DoIt <> True Then
            Call ShowStats()
            Response.Write "<font size=""" & strFooterFontSize & """>This will make your name glow on your forums posts as well as a few other places around the site.</font><br>"
            Response.Write "<br>Glow Color: " & _
                           "<select name=""GlowColor"">" & VbNewLine &_
                           "  <option value=""green"">Green</option>" & VbNewLine &_
                           "  <Option value=""red"">Red</option>" & VbNewLine &_
                           "  <Option value=""blue"">Blue</option>" & VbNewLine &_
                           "  <Option value=""black"">Black</option>" & VbNewLine &_
                           "  <Option value=""gray"">Gray</option>" & VbNewLine &_
                           "  <Option value=""lightblue"">Light-Blue</option>" & VbNewLine &_
                           "  <Option value=""pink"">Pink</option>" & VbNewLine &_
                           "  <Option value=""steelblue"">SteelBlue</option>" & VbNewLine &_
                           "  <Option value=""orange"">Orange</option>" & VbNewLine &_
                           "  <Option value=""purple"">Purple</option>" & VbNewLine &_
                           "  <Option value=""yellow"">Yellow</option>" & VbNewLine &_
                           "  <Option value=""brown"">Brown</option>" & VbNewLine &_
                           "</select><br>" & VbNewLine &_
                           "Strength: <input type=text size=3 value=5 name=gStrength>"
            CloseTable(1)
         Else
            If Request.Form("gStrength") = "" Then
               gS = 5
            Else 
               gS = Request.Form("gStrength")
            End If
            strGlow = "filter:glow(color=" & Request.Form("GlowColor") & ",strength=" & gS & ")"
            strSql = "SELECT M_GLOW_TEXT FROM " & strMemberTablePrefix & "MEMBERS WHERE MEMBER_ID=" & MemberID
            Set rs=my_Conn.Execute(strSql)
            If not rs.EOF Then
            	rs.Close
            	Set rs=Nothing
            	my_Conn.Execute("UPDATE " & strMemberTablePrefix &"MEMBERS SET M_GLOW_TEXT='' WHERE MEMBER_ID=" & MemberID & ", M_POINTS=M_POINTS+" & ItemCost)
            	DecreaseItemCount
            	Call BackToStore
            	CloseTable(0)
            Else
            	my_Conn.Execute("update " & strMemberTablePrefix & "MEMBERS set M_GLOW_TEXT = '" & strGlow & "', M_POINTS=M_POINTS-" & ItemCost &" WHERE MEMBER_ID=" & MemberID)
            	UpdateItemCount
            	Response.Write "<br>Congratulations, you've added the glow effect to your name."
            	Call BackToStore
            	CloseTable(0)
         End If
      

      '=========
      Case 1505 'Use custom avatar
      '=========
         CreateTable(ItemTitle)
         If DoIt <> True Then
            Call ShowStats()
            Response.Write "<font size=""" & strFooterFontSize & """>Currently, you cannot upload an avatar, you must have one residing somewhere on the web now.</font><br>"
            Response.Write "<table width=""100%"" border=0><tr><td align=center>" & VbNewLine &_
                           "<b>Current Avatar</b><br>" & VbNewLine
		   	If MemberAvatar <> "" And MemberAvatar <> "noavatar.gif" And IsNull(MemberAvatar) = False Then
               If mid(MemberAvatar, 1, 7) = "http://" Then
   			      Response.Write "                <img src=""" & MemberAvatar & """ align=""absmiddle""  width=64 height=64 border=" & AvatarBorder & " hspace=""0"" ><br>" & VbNewLine
			      Else  
   			      Response.Write "                <img src=""/" & MemberAvatar & """ align=""absmiddle"" width=64 height=64 border=" & AvatarBorder & " hspace=""0"" ><br>" & VbNewLine
			      End If
            Else
	   		   Response.Write "<br>None"
         	End If
            Response.Write "</td><td align=left>"
   
            Response.Write "<br>New Avatar URL: <br><input name=""AvatarURL"" value=""http://"" size=50><br>"
            Response.Write "</td></tr></table>" & VbNewLine
            Response.Write "<font size=""" & strFooterFontSize & """>Your avatar will be resized to 64x64 pixels when used on the site.</font><br>"
            
            CloseTable(1)
         Else
            If Request.Form("AvatarURL") = "" Or len(Request.Form("AvatarURL")) <=10 Then
               strErr = "<li>Please enter a valid url for your avatar</li>"
            End If
            If mid(Request.Form("AvatarURL"), 1, 7) <> "http://" Then
               strErr = "<li>URL's must start with ""http://"""
            End If
            
            If strErr <> "" Then
               GoError(strErr)
            Else
               strSql = "update " & strTablePrefix & "MEMBERS set M_AVATAR_URL = '" & chkString(Request.Form("AvatarURL"), "SQLString") & "', " &_
                        "M_POINTS = M_POINTS -" & ItemCost &_
                        " where MEMBER_ID=" & MemberID
               my_Conn.Execute (strsql)
               UpdateItemCount
               Response.Write "<br>Custom avatar has been set."
               Call BackToStore

            End If  
            CloseTable(0)
            
         End If
             
         
         
         
         
         
         
      '=========
      Case 1506 'change other users title
      '=========
         CreateTable(ItemTitle)
         If DoIt <> True Then
            Call ShowStats()
            Response.Write "User to change title for: <input size=15 type=text name=dUser><br>" & VbNewLine &_
                           "Change it to: <input size=15 type=text name=dNewTitle> <br>" & VbNewLine
            CloseTable(1)
         Else
            If Request.Form("dUser") = ""  Or GetMemberID(Request.Form("dUser")) = "" Then
               strErr = strErr & "<li>You must enter a valid member name</li>"
            End If
            NewTitle = Request.Form("dNewTitle")

            If strErr <> "" Then
               GoError(strErr)
            Else
               strSql = "update " & strTablePrefix & "MEMBERS set M_TITLE = '" & chkString(NewTitle, "sqlstring") & "'" & _
                        " where MEMBER_ID= " & GetMemberID(Request.Form("dUser"))
               my_Conn.Execute (strsql)

               UpdateItemCount

               Response.Write chkString(Request.Form("dUser"), "display") & "'s title has been changed to: " & chkString(NewTitle, "display")
               Call BackToStore
             End If
            CloseTable(0)

            
         End If      
  


      '=========
      Case 1507 'create own forum
      '=========
         CreateTable(ItemTitle)

      '=========
      Case 1508 'Change shout box text
      '=========
         CreateTable(ItemTitle)
         If DoIt <> True Then
            Call ShowStats()
            Response.Write "<b>Change Shout Box text to:</b>    <input type=""text"" name=""count"" value=""255"" size=""3"" onFocus=""this.blur"" readonly><br> " & VbNewLine & _
                           "<div align=center>" & VbNewLine & _
                           "<textarea rows=""5"" cols=""50"" name=""dShoutOut"" wrap" & VbNewLine & _
                           "onKeyUp=""" & VbNewLine & _
                           "val = this.value; " & VbNewLine & _
                           "if (val.length > 255) {" & VbNewLine & _
                           "  alert('Sorry, you are over the limit of 255 characters');" & VbNewLine & _
                           "  this.value = val.substring(0,255);" & VbNewLine & _
                           "  dShoutOut.focus()" & VbNewLine & _
                           "}" & VbNewLine & _
                           "this.form.count.value=255-parseInt(this.value.length);" & VbNewLine & _
                           """></textarea>" & VbNewLine
                           
                           
            CloseTable(1)
         Else
            If Request.Form("dShoutOut") = "" Then
               strErr = strErr & "<li>You must enter some text.</li>"
            End If
            If len(Request.Form("dShoutOut")) > 255 Then
               strErr = strErr & "<li>Shout outs must be less then 255 characters</li>"
            End If

            If strErr <> "" Then
               GoError(strErr)
            Else
               strSql = "insert into SHOUT_OUTS values ("
               strSql = strSql & "'" & chkString(Request.Form("dShoutout"), "SQLString") & "'"
               strSql = strSql & ",'" & DateToStr(strForumTimeAdjust) & "'"
               strSql = strSql & "," & MemberID
               strSql = strSql & ")"
               my_Conn.Execute (strsql)
               UpdateItemCount
               Response.Write "<br>Shout out has been updated."
               Call BackToStore

            End If  
            CloseTable(0)
         End If         
         
   End Select
   
      
 End Sub

 Sub GoError(ErrMsg)
 	Response.Write	"      <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHiLiteFontColor & """>Oops, There Was A Problem...</font></p>" & VbNewLine & _
			"      <table align=""center"" border=""0"">" & VbNewLine & _
			"        <tr>" & VbNewLine & _
			"          <td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHiLiteFontColor & """><ul>" & ErrMsg & "</ul></font></td>" & VbNewLine & _
			"        </tr>" & VbNewLine & _
			"      </table>" & VbNewLine & _
			"      <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><a href=""JavaScript:history.go(-1)"">Click to go back</a></font></p>" & VbNewLine

    AllGood = False
 End Sub


 Sub CreateTable(Header)
   Response.Write "<table align=center width=""80%"" cellspacing=""1"" bgcolor=""" & strTableBorderColor & """>" & VbNewLine &_
                  "<form action=""pstore.asp?item=" & tItem & """ method=post>" & VbNewLine &_
                  "<input type=""hidden"" name=""dd"" value=1>" & VbNewLine &_
                  "  <tr>" & VbNewLine & _
                  "     <td valign=top align=center bgcolor=""" & strHeadCellColor & """>" & VbNewLine & _
                  "      <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>" & chkString(Header, "display") & "</font></td>" & VbNewLine & _
                  "     </td>" & VbNewLine & _
                  "   </tr>" & VbNewLine & _
                  "   <tr>" & VbNewLine & _
                  "      <td bgcolor=""" & strForumCellColor & """ align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & VbNewLine
 End Sub
 
 Sub CloseTable(ShowButtons)
   Response.Write "<br><br>"
   If Showbuttons = 1 Then
      Response.Write "<div align=""center"">" & VbNewLine & _
          "<input type=submit value=Submit> <INPUT TYPE=""BUTTON"" NAME=""GOBACK"" VALUE=""Cancel"" OnClick=""history.go(-1)""></div>" & VbNewLine
   End If
   Response.Write "</font></td></tr></table>"
 End Sub
 
 Sub BackToStore()
   Response.Write "<p align=center><a href=""/pstore.asp"">Back to Store</a></p>" & VbNewLine
 End Sub
 
 Sub ShowStats()
   Response.Write "<table align=center border=0><tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>"
   Response.Write "<b><span class=""footersz3"">Item Cost:</b> " & ItemCost & "</font></td>" & VbNewLine &_
                  "<td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Sold Count:</b> " & ItemSoldCount & "</font></td></tr>"
   Response.Write "<tr><td colspan=2><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>You have <b>" & MemberPoints & "</b> points</font></td></tr>" & VbNewLine &_
                  "</table><br>"
 End Sub
 
 Sub UpdateItemCount()
   strSql = "update " & strTablePrefix & "STORE_ITEMS set P_SOLD_COUNT = P_SOLD_COUNT +1 " &_
            " where P_ITEM=" & tItem
   my_Conn.Execute (strsql)
 End Sub
 Sub DecreaseItemCount()
   strSql = "update " & strTablePrefix & "STORE_ITEMS set P_SOLD_COUNT = P_SOLD_COUNT -1 " &_
            " where P_ITEM=" & tItem
   my_Conn.Execute (strsql)
 End Sub
%>
Go to Top of Page

MaGraham
Senior Member

USA
1297 Posts

Posted - 07 December 2013 :  09:52:52  Show Profile

I'll come back to this, Carefree. I just realized this is causing an error when someone attemps to register, not allowing the registration to go through.

Here's the error message.



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/register.asp, line 774




Here are lines 759 - 779



end if
if strQuote = "1" then
strSql = strSql & ", '" & ChkString(Request.Form("Quote"),"message") & "'"
else
strSql = strSql & ", ''"
end if
strSql = strSql & ", '" & ChkString(Request.Form("Referred"),"message") & "'"
strSql = strSql & ", 1"
' ## Points Below
strSql = strSql & ", " & GetPoints("REG")
' ## Points Above
strSql = strSql & ")"
strSql = strSql & ", '" & ChkString(Request.Form("Avatar_URL"),"SqlString") & "'"
strSql = strSql & ")"

my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords

if strEmail = "1" and strEmailVal = "1" then
'Do Nothing
else
Call DoCount

"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 07 December 2013 09:56:03
Go to Top of Page

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 07 December 2013 :  11:06:58  Show Profile
I need more of the file than that, all of that routine defining the strSql from the very first one ... not a strSql=strSql+... You really should make this a new topic.

Edited by - Carefree on 07 December 2013 11:07:23
Go to Top of Page

MaGraham
Senior Member

USA
1297 Posts

Posted - 08 December 2013 :  00:36:37  Show Profile

I have decided to just remove the "glow" option, Carefree. Gonna turn that option OFF.

Thank you much for your time on that!

And, sorry for all the trouble and time it took!



"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
Go to Top of Page

MaGraham
Senior Member

USA
1297 Posts

Posted - 08 December 2013 :  04:01:37  Show Profile


Carefree, I am trying to create an option for members to purchase "Name Tags" with their points. Could you possibly help me with this?

I'll probably have about fifty name tags for them to choose from so it might be best to have about ten name tag graphics on each page so it won't take each page so long to load.

I'd just need to be able to come behind you and add a picture of each name tag and then change the generic name you would probably have in that area.

I would either want a means of the members selecting a name tag or simply an area for them to type the NAME of the name tag, i.e. "Scottish Bagpipes," "Christmas Elf," etc.

My members post a LOT so let's say the price for each could be 1,000 points.

Their points would be deducted when they place their order but since I would then need to create the name tag (putting their name on the graphic they chose), how could I be notified of what they ordered? Oh, could there be a place for them to enter an email address for me to use to send their name tag to them? And, could the message they receive after purchasing a name tag be something like, "Your name tag should be ready within the next 72 hours and will be sent to the email address you have provided. If you have any questions please contact 'forum email address could go here'" (as a means of them contacting me).

Would this be something just too major?

I've edited the following files so here's a copy of mine, if you can help. I didn't edit the other files in the "Points" mod.




Here's my pstore.asp



<%
'#################################################################################
'## 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="inc_header.asp" -->
<!--#INCLUDE FILE="inc_func_member.asp" -->
<!--#INCLUDE FILE="inc_func_secure.asp" -->
<%
   
tItem = Request.QueryString("item")

Response.Write	"      <table width=""100%"" border=""0"">" & VbNewLine & _
		"        <tr>" & VbNewLine & _
		"          <td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & VbNewLine & _
		"          " & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""default.asp"">All Forums</a><br />" & VbNewLine
If tItem <> "" Then
  Response.Write "          " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""pstore.asp"">" & strForumTitle & " Store</a><br />" & VbNewLine & _
		"          " & getCurrentIcon(strIconBlank,"","") & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " Purchase Item</font></td>" & VbNewLine
Else
   Response.Write "          " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " " & strForumTitle & " Store</font></td>" & VbNewLine
End If
Response.Write "        </tr>" & VbNewLine & _
		"      </table>" & VbNewLine


Response.Write "<table width=""100%"" align=center border=0 cellpadding=4 cellspacing=0>" & VbNewLine
    
If tItem = "" Then 
   Response.Write "    <tr>" & VbNewLine & _
      "        <td align=center><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strDefaultFontColor & """><b>" & strForumTitle & " Store</b></font></td>" & VbNewLine & _
      "     </tr>" & VbNewLine & _
      "    <tr>" & VbNewLine & _
      "        <td valign=""top"">" & VbNewLine
    strSql = "select M_POINTS from " & strTablePrefix & "MEMBERS where M_NAME = '" & strDBNTUserName & "'"
    Set rs = my_Conn.Execute(strSql)
    If Not rs.EOF Then
       TotPoints = rs("M_POINTS")
    Else
       TotPoints = 0
    End If
    rs.Close
    Response.Write "<p align=""center"">"

    Response.Write "<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>Here you can use the points you've earned to 'purchase' items. " & VbNewLine & _
                   "<br><a href=""points.asp"">Click here to learn more about the point system</a>" & VbNewLine
    If strDBNTUserName = "" Then
       Response.Write "<br><font color=""" & strHilliteFontColor & """>You must login to use the store</font>"
    Else
       Response.Write "<br><font color=""green"">You have " & TotPoints & " points to spend</font>"
    End If
    Response.Write "</font></p>"

    strSql = "select P_ITEM, P_TITLE, P_COST, P_DESCRIPTION, P_SOLD_COUNT " &_
             "from " & strTablePrefix & "STORE_ITEMS " & _
             "  where P_ENABLED = 1 " &_
             "    and P_INSTORE = 1 " & _
             "order by P_COST ASC"
    rs.open strSql, my_Conn
    Response.Write "<table width=""100%"">"
    Do until rs.EOF
       Response.Write "<tr><td valign=top width=""50%"">" & VbNewLine
       
       Response.Write "<table border=0 cellspacing=1 bgcolor=""" & strTableBorderColor & """ width=""100%"" align=center>" & VbNewLine &_
                      "<tr><td align=center bgcolor=""" & strAltForumCellColor & """><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """><a href=""pstore.asp?item=" & rs("P_ITEM") & """>" & rs("P_TITLE") & "</a></font></td></tr>" & VbNewLine
       Response.Write "<tr><td bgcolor=""" & strForumCellColor & """ align=center><font face=""" & strDefaultFontFace & """ Size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & rs("P_DESCRIPTION") & "</font><br><br>" & VbNewLine
       Response.Write "<table align=center border=0>" & VbNewLine &_
                      "<tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Cost:</b></font></td><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & formatnumber(rs("P_COST"), 0) & "</font></td>" & VbNewLine &_
                      "<tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Sold:</b></font></td><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & rs("P_SOLD_COUNT") & "</font></td>" & VbNewLine &_
                      "<tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>You need:</b></td><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" 
       If  rs("P_COST") < TotPoints Then
          Response.Write "0"
       Else
          Response.Write formatnumber(rs("P_COST") - TotPoints, 0)
       End If
       Response.Write  "</font></td>" & VbNewLine
       Response.Write "</tr></table>"
       rs.MoveNext
       
       Response.Write "</td></tr></table></td><td valign=""top"" width=""50%"">" & VbNewLine
       If Not rs.EOF Then
          Response.Write "<table bgcolor=""" & strTableBorderColor & """ border=0 cellspacing=1 width=""100%"" align=center>" & VbNewLine &_
                         "<tr><td align=center bgcolor=""" & strAltForumCellColor & """><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """><a href=""pstore.asp?item=" & rs("P_ITEM") & """>" & rs("P_TITLE") & "</a></font></td></tr>" & VbNewLine
          Response.Write "<tr><td bgcolor=""" & strForumCellColor & """  align=center ><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & rs("P_DESCRIPTION") & "</font><br><br>" & VbNewLine
       Response.Write "<table align=center border=0>" & VbNewLine &_
                      "<tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Cost:</b></font></td><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & formatnumber(rs("P_COST"), 0) & "</font></td>" & VbNewLine &_
                      "<tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Sold:</b></font></td><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & rs("P_SOLD_COUNT") & "</font></td>" & VbNewLine &_
                      "<tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>You need:</b></td><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" 
       If  rs("P_COST") < TotPoints Then
          Response.Write "0"
       Else
          Response.Write formatnumber(rs("P_COST") - TotPoints, 0)
       End If
       Response.Write  "</font></td>" & VbNewLine
          Response.Write "</tr></table></td></tr></table>"
          rs.MoveNext
       End If
       Response.Write "</td></tr>" & VbNewLine

    Loop
    Response.Write "</table>"
    rs.Close
    Set rs = Nothing  
'    my_Conn.Close
    Response.Write "</td></tr>" & VbNewLine
 Else 
      %><!-- #include file="PurchaseItem.asp" --><%
      Response.Write "<tr><td>" & VbNewLine
      Call PurchaseItem()
      Response.Write "</td></tr>"
 End If
 Response.Write "</table>" & VbNewLine
WriteFooter
%>




Here's my PurchaseItem.asp.



<%
 Dim MemberPoints
 Dim MemberLevel 
 Dim MemberPosts 
 Dim MemberTitle
 Dim MemberAvatar 
 Dim ItemCost 
 Dim ItemTitle
 Dim ItemSoldCount
 Dim ItemEnabled
 
 Sub PurchaseItem()
   Set rs = Server.CreateObject("ADODB.RECORDSET")
   ERR = 0
   DoIt = cbool(Request.Form("dd"))
   'First lets get info about the user
   strSql = "select M_POINTS, M_TITLE, M_LEVEL, M_POSTS "
   
   '--uncomment below if using avatar mod
   'strSql = strSql & ", M_AVATAR_URL "
   
   strSql = strSql & " from " & strTablePrefix & "MEMBERS " & _
            "where MEMBER_ID=" & MemberID

   rs.open strSql, my_Conn,3,3
   If Not rs.EOF Then
      MemberPoints = rs("M_POINTS")
      MemberLevel = rs("M_LEVEL")
      MemberPosts = rs("M_POSTS")
      MemberTitle = rs("M_TITLE")
      '-- Uncomment below if using avatar mod
      'MemberAvatar = rs("M_AVATAR_URL")
   Else
      GoError("You must be logged in to purchase items from the store")
      tItem = 0
      ERR = 1
   End If
   rs.Close 
  
   If ERR = 0 Then
      'get item cost etc...
      strSql = "select P_COST, P_TITLE, P_SOLD_COUNT, P_ENABLED " & _
               " from " & strTablePrefix & "STORE_ITEMS " &_
               " where P_ITEM = " & tItem
      rs.open strSql, my_Conn
      If Not rs.EOF Then
         ItemCost = rs("P_COST")
         ItemTitle = rs("P_TITLE")
         ItemSoldCount = rs("P_SOLD_COUNT")
         ItemEnabled = rs("P_ENABLED")
      Else
         GoError("That Item does not exist")
         tItem = 0
      End If
      
      rs.Close
      
      If ItemEnabled <> 1 Then
         GoError("That Item does not exist")
         tItem = 0
      ElseIf ItemCost > MemberPoints Then
         GoError("You do not have enough points to " & ItemTitle)
         tItem = 0
      End If
   End If
  
   strErr = ""
   
   Select Case tItem
      '=========
      Case 1500 'Donate points
      '=========
         CreateTable(ItemTitle)
         If DoIt <> True Then
            Call ShowStats()
            Response.Write "Donate points to: <input size=15 type=text name=dTo><br>" & VbNewLine &_
                           "Amount to Donate: <input size=3 type=text name=dAmt> <font size=""" & strFooterFontSize & """>max " & MemberPoints -ItemCost & "</font><br>" & VbNewLine &_
                           "<font size=""" & strFooterFontSize & """>a " & ItemCost & "pt prccessing fee will be applied.</font>"
            CloseTable(1)
         Else
            If Request.Form("dTo") = ""  Or GetMemberID(Request.Form("dTo")) = 0 Then
               strErr = strErr & "<li>You must enter a valid member name</li>"
            End If
            DonateAmount = Request.Form("dAmt")
            If DonateAmount = "" Then
               strErr = strErr & "<li>You must enter a valid donation amount</li>"
            ElseIf cint(DonateAmount) > (MemberPoints -ItemCost) Then
               strErr = strErr & "<li>You cannot donate more then you have.</li>"
            End If
            If strErr <> "" Then
               GoError(strErr)
            Else
               strSql = "update " & strTablePrefix & "MEMBERS set M_POINTS = M_POINTS + " & DonateAmount &_
                        " where M_NAME='" & Request.Form("dTo") & "'"
               my_Conn.Execute (strsql)
               strSql = "update " & strTablePrefix & "MEMBERS set M_POINTS = M_POINTS - (" & DonateAmount & " + " & ItemCost & ")" &_
                        " where MEMBER_ID=" & MemberID
               my_Conn.Execute (strsql)
               UpdateItemCount
               Response.Write DonateAmount & " points have been transferred to " & Request.Form("dTo") & "'s account"
               Call BackToStore
             End If
            CloseTable(0)

            
         End If      
      '=========
      Case 1501 'Change Title
      '=========
         CreateTable(ItemTitle)
         If DoIt <> True Then
            Call ShowStats()
            Response.Write "Current Title: " & ChkString(getMember_Level(MemberTitle, MemberLevel, MemberPosts), "display") & "<br>" & VbNewLine &_
                           "Change To: <input size=20 type=text name=dTitle><br>" & VbNewLine
            CloseTable(1)
         Else
            If Request.Form("dTitle") = "" Then
               strErr = strErr & "<li>You must enter a title you would like to use.</li>"
            End If
            If len(Request.Form("dTitle")) > 25 Then
               strErr = strErr & "<li>Titles cannot be more then 25 characters long.</li>"
            End If

            If strErr <> "" Then
               GoError(strErr)
            Else
               strSql = "update " & strTablePrefix & "MEMBERS set M_TITLE = '" & chkString(Request.Form("dTitle"), "SQLString") & "', " &_
                        "M_POINTS = M_POINTS -" & ItemCost &_
                        " where MEMBER_ID=" & MemberID
               my_Conn.Execute (strsql)
               UpdateItemCount
               Response.Write "<br>Your title has been changed."
               Call BackToStore

            End If  
            CloseTable(0)
         End If
         
      '=========
      Case 1502 'Buy lottery ticket
      '=========
         CreateTable(ItemTitle)
      '=========
      Case 1503 'add glow to name
      '=========
         CreateTable(ItemTitle)
         If DoIt <> True Then
            Call ShowStats()
            Response.Write "<font size=""" & strFooterFontSize & """>This will make your name glow on your forums posts as well as a few other places around the site.</font><br>"
            Response.Write "<br>Glow Color: " & _
                           "<select name=""GlowColor"">" & VbNewLine &_
                           "  <option value=""green"">Green</option>" & VbNewLine &_
                           "  <Option value=""red"">Red</option>" & VbNewLine &_
                           "  <Option value=""blue"">Blue</option>" & VbNewLine &_
                           "  <Option value=""black"">Black</option>" & VbNewLine &_
                           "  <Option value=""gray"">Gray</option>" & VbNewLine &_
                           "  <Option value=""lightblue"">Light-Blue</option>" & VbNewLine &_
                           "  <Option value=""pink"">Pink</option>" & VbNewLine &_
                           "  <Option value=""steelblue"">SteelBlue</option>" & VbNewLine &_
                           "  <Option value=""orange"">Orange</option>" & VbNewLine &_
                           "  <Option value=""purple"">Purple</option>" & VbNewLine &_
                           "  <Option value=""yellow"">Yellow</option>" & VbNewLine &_
                           "  <Option value=""brown"">Brown</option>" & VbNewLine &_
                           "</select><br>" & VbNewLine &_
                           "Strength: <input type=text size=3 value=5 name=gStrength>"
            CloseTable(1)
         Else
            If Request.Form("gStrength") = "" Then
               gS = 5
            Else 
               gS = Request.Form("gStrength")
            End If
            strGlow = "filter:glow(color=" & Request.Form("GlowColor") & ",strength=" & gS & ")"
            strSql = "update " & strTablePrefix & "MEMBERS set M_GLOW_TEXT = '" & strGlow & "', " &_
                     "M_POINTS = M_POINTS -" & ItemCost &_
                     " where MEMBER_ID=" & MemberID
            my_Conn.Execute (strsql)
            UpdateItemCount
            Response.Write "<br>Congratulations, you've added the glow effect to your name."
            Call BackToStore
            CloseTable(0)
         End If
      

      '=========
      Case 1505 'Use custom avatar
      '=========
         CreateTable(ItemTitle)
         If DoIt <> True Then
            Call ShowStats()
            Response.Write "<font size=""" & strFooterFontSize & """>Currently, you cannot upload an avatar, you must have one residing somewhere on the web now.</font><br>"
            Response.Write "<table width=""100%"" border=0><tr><td align=center>" & VbNewLine &_
                           "<b>Current Avatar</b><br>" & VbNewLine
		   	If MemberAvatar <> "" And MemberAvatar <> "noavatar.gif" And IsNull(MemberAvatar) = False Then
               If mid(MemberAvatar, 1, 7) = "http://" Then
   			      Response.Write "                <img src=""" & MemberAvatar & """ align=""absmiddle""  width=64 height=64 border=" & AvatarBorder & " hspace=""0"" ><br>" & VbNewLine
			      Else  
   			      Response.Write "                <img src=""/" & MemberAvatar & """ align=""absmiddle"" width=64 height=64 border=" & AvatarBorder & " hspace=""0"" ><br>" & VbNewLine
			      End If
            Else
	   		   Response.Write "<br>None"
         	End If
            Response.Write "</td><td align=left>"
   
            Response.Write "<br>New Avatar URL: <br><input name=""AvatarURL"" value=""http://"" size=50><br>"
            Response.Write "</td></tr></table>" & VbNewLine
            Response.Write "<font size=""" & strFooterFontSize & """>Your avatar will be resized to 64x64 pixels when used on the site.</font><br>"
            
            CloseTable(1)
         Else
            If Request.Form("AvatarURL") = "" Or len(Request.Form("AvatarURL")) <=10 Then
               strErr = "<li>Please enter a valid url for your avatar</li>"
            End If
            If mid(Request.Form("AvatarURL"), 1, 7) <> "http://" Then
               strErr = "<li>URL's must start with ""http://"""
            End If
            
            If strErr <> "" Then
               GoError(strErr)
            Else
               strSql = "update " & strTablePrefix & "MEMBERS set M_AVATAR_URL = '" & chkString(Request.Form("AvatarURL"), "SQLString") & "', " &_
                        "M_POINTS = M_POINTS -" & ItemCost &_
                        " where MEMBER_ID=" & MemberID
               my_Conn.Execute (strsql)
               UpdateItemCount
               Response.Write "<br>Custom avatar has been set."
               Call BackToStore

            End If  
            CloseTable(0)
            
         End If
             
         
         
         
         
         
         
      '=========
      Case 1506 'change other users title
      '=========
         CreateTable(ItemTitle)
         If DoIt <> True Then
            Call ShowStats()
            Response.Write "User to change title for: <input size=15 type=text name=dUser><br>" & VbNewLine &_
                           "Change it to: <input size=15 type=text name=dNewTitle> <br>" & VbNewLine
            CloseTable(1)
         Else
            If Request.Form("dUser") = ""  Or GetMemberID(Request.Form("dUser")) = "" Then
               strErr = strErr & "<li>You must enter a valid member name</li>"
            End If
            NewTitle = Request.Form("dNewTitle")

            If strErr <> "" Then
               GoError(strErr)
            Else
               strSql = "update " & strTablePrefix & "MEMBERS set M_TITLE = '" & chkString(NewTitle, "sqlstring") & "'" & _
                        " where MEMBER_ID= " & GetMemberID(Request.Form("dUser"))
               my_Conn.Execute (strsql)

               UpdateItemCount

               Response.Write chkString(Request.Form("dUser"), "display") & "'s title has been changed to: " & chkString(NewTitle, "display")
               Call BackToStore
             End If
            CloseTable(0)

            
         End If      
  


      '=========
      Case 1507 'create own forum
      '=========
         CreateTable(ItemTitle)

      '=========
      Case 1508 'Change shout box text
      '=========
         CreateTable(ItemTitle)
         If DoIt <> True Then
            Call ShowStats()
            Response.Write "<b>Change Shout Box text to:</b>    <input type=""text"" name=""count"" value=""255"" size=""3"" onFocus=""this.blur"" readonly><br> " & VbNewLine & _
                           "<div align=center>" & VbNewLine & _
                           "<textarea rows=""5"" cols=""50"" name=""dShoutOut"" wrap" & VbNewLine & _
                           "onKeyUp=""" & VbNewLine & _
                           "val = this.value; " & VbNewLine & _
                           "if (val.length > 255) {" & VbNewLine & _
                           "  alert('Sorry, you are over the limit of 255 characters');" & VbNewLine & _
                           "  this.value = val.substring(0,255);" & VbNewLine & _
                           "  dShoutOut.focus()" & VbNewLine & _
                           "}" & VbNewLine & _
                           "this.form.count.value=255-parseInt(this.value.length);" & VbNewLine & _
                           """></textarea>" & VbNewLine
                           
                           
            CloseTable(1)
         Else
            If Request.Form("dShoutOut") = "" Then
               strErr = strErr & "<li>You must enter some text.</li>"
            End If
            If len(Request.Form("dShoutOut")) > 255 Then
               strErr = strErr & "<li>Shout outs must be less then 255 characters</li>"
            End If

            If strErr <> "" Then
               GoError(strErr)
            Else
               strSql = "insert into SHOUT_OUTS values ("
               strSql = strSql & "'" & chkString(Request.Form("dShoutout"), "SQLString") & "'"
               strSql = strSql & ",'" & DateToStr(strForumTimeAdjust) & "'"
               strSql = strSql & "," & MemberID
               strSql = strSql & ")"
               my_Conn.Execute (strsql)
               UpdateItemCount
               Response.Write "<br>Shout out has been updated."
               Call BackToStore

            End If  
            CloseTable(0)
         End If         
         
   End Select
   
      
 End Sub

 Sub GoError(ErrMsg)
 	Response.Write	"      <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHiLiteFontColor & """>Oops, There Was A Problem...</font></p>" & VbNewLine & _
			"      <table align=""center"" border=""0"">" & VbNewLine & _
			"        <tr>" & VbNewLine & _
			"          <td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHiLiteFontColor & """><ul>" & ErrMsg & "</ul></font></td>" & VbNewLine & _
			"        </tr>" & VbNewLine & _
			"      </table>" & VbNewLine & _
			"      <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><a href=""JavaScript:history.go(-1)"">Click to go back</a></font></p>" & VbNewLine

    AllGood = False
 End Sub


 Sub CreateTable(Header)
   Response.Write "<table align=center width=""80%"" cellspacing=""1"" bgcolor=""" & strTableBorderColor & """>" & VbNewLine &_
                  "<form action=""pstore.asp?item=" & tItem & """ method=post>" & VbNewLine &_
                  "<input type=""hidden"" name=""dd"" value=1>" & VbNewLine &_
                  "  <tr>" & VbNewLine & _
                  "     <td valign=top align=center bgcolor=""" & strHeadCellColor & """>" & VbNewLine & _
                  "      <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>" & chkString(Header, "display") & "</font></td>" & VbNewLine & _
                  "     </td>" & VbNewLine & _
                  "   </tr>" & VbNewLine & _
                  "   <tr>" & VbNewLine & _
                  "      <td bgcolor=""" & strForumCellColor & """ align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & VbNewLine
 End Sub
 
 Sub CloseTable(ShowButtons)
   Response.Write "<br><br>"
   If Showbuttons = 1 Then
      Response.Write "<div align=""center"">" & VbNewLine & _
          "<input type=submit value=Submit> <INPUT TYPE=""BUTTON"" NAME=""GOBACK"" VALUE=""Cancel"" OnClick=""history.go(-1)""></div>" & VbNewLine
   End If
   Response.Write "</font></td></tr></table>"
 End Sub
 
 Sub BackToStore()
   Response.Write "<p align=center><a href=""/pstore.asp"">Back to Store</a></p>" & VbNewLine
 End Sub
 
 Sub ShowStats()
   Response.Write "<table align=center border=0><tr><td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>"
   Response.Write "<b><span class=""footersz3"">Item Cost:</b> " & ItemCost & "</font></td>" & VbNewLine &_
                  "<td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Sold Count:</b> " & ItemSoldCount & "</font></td></tr>"
   Response.Write "<tr><td colspan=2><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>You have <b>" & MemberPoints & "</b> points</font></td></tr>" & VbNewLine &_
                  "</table><br>"
 End Sub
 
 Sub UpdateItemCount()
   strSql = "update " & strTablePrefix & "STORE_ITEMS set P_SOLD_COUNT = P_SOLD_COUNT +1 " &_
            " where P_ITEM=" & tItem
   my_Conn.Execute (strsql)

 
 End Sub
%>




Here's my points.asp.


<%
'#################################################################################
'## 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="inc_sha256.asp"-->
<!--#INCLUDE FILE="inc_header.asp" -->
<%
Response.Write "      <table width=""100%"" border=""0"">" & VbNewLine & _
      "        <tr>" & VbNewLine & _
      "          <td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & VbNewLine & _
      "          " & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""default.asp"">Community Home</a><br />" & VbNewLine & _
      "          " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " About the Points System</font></td>" & VbNewLine & _
      "        </tr>" & VbNewLine & _
      "      </table>" & VbNewLine

   Response.Write "      <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 bgcolor=""" & strCategoryCellColor & """><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """><b>" & strForumTitle & " Points System</b></font></td>" & VbNewLine & _
         "              </tr>" & VbNewLine & _
         "              <tr>" & VbNewLine & _
         "                <td bgcolor=""" & strForumCellColor & """><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>" & VbNewLine & _


         "The Point system allows you to earn points by interactivly participating on the site. Points can then be used in the Points Store to purchase items for use on the site. " & VbNewLine & _
         " For example: if you post reguraly you will receive points for each post. You can then use those points in our Points Store.  In the Points Store you may also donate your points to another member." & VbNewLine & _
         " <br><br>Be sure to check out the <a href=""pstore.asp"">Points Store</a> to see what you can use your points for." & VbNewLine & _
         " <br><br>" & VbNewLine & _
         "  Listed below are some of the activities you can <b><i>always</i></b> do to earn points.  Not listed below is our current special challenge with our points.  During this time you may also earn <b>15 points</b> for each reply you make on our Beth Moore Bible Studies & Discussions forum.<br><br>" & VbNewLine


   Response.Write "<table width=""90%"" align=center border=0 bgcolor=""" & strAltForumCellColor & """>" & VbNewLine & _
      "  <tr><td><b>Activity</b></td><td align=center><b>Points</b></td></tr>" & VbNewLine

      strSql = "select P_NAME, P_DESCRIPTION, P_POINTS " &_
               "from " & strTablePrefix & "POINT_ACTIONS where P_ENABLED = 1 " &_
               "order by P_POINTS ASC"
      Set rs = my_Conn.Execute(strSql)

      tt = True

      Do until rs.EOF

         Response.Write "<tr bgcolor="""
         If tt Then
            Response.Write strForumCellColor
         Else
            Response.Write strAltForumCellColor
         End If
         Response.Write """><td>" & rs("P_NAME") & VbNewLine

         If Not isnull(rs("P_DESCRIPTION")) Then
            Response.Write "<br><font size=""" & strFooterFontSize & """>   " & rs("P_DESCRIPTION") & "</font>"
         End If
         Response.Write "</td><td align=center>" & VbNewLine
         Response.Write rs("P_POINTS") & "</td>" & VbNewLine &_
               "</tr>"

         rs.MoveNext
         tt = Not tt
      Loop
      rs.Close
      Set rs = Nothing

   Response.Write "              </table>" & VbNewLine & _
         "                </font></td>" & VbNewLine & _
         "              </tr>" & VbNewLine & _
         "            </table>" & VbNewLine & _
         "          </td>" & VbNewLine & _
         "        </tr>" & VbNewLine & _
         "      </table>" & VbNewLine & _

      "</p>" & VbNewLine & _
      "<div align=""center""><a href=""JavaScript:history.go(-1)"">Click To go back</a></div>" & VbNewLine

WriteFooter

%>




"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
Go to Top of Page

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 08 December 2013 :  07:49:54  Show Profile
This will take a while. I'll probably work on it piecemeal, instead of trying to do it all at once.
Go to Top of Page

MaGraham
Senior Member

USA
1297 Posts

Posted - 08 December 2013 :  12:51:57  Show Profile

GREAT! Thank you so much, Carefree!

I am planning a Grand Opening of the new site for next week (Dec. 11) and I think this will really be enticing for the new members.

The site has been open since the middle of October but only for a select group of members.

Members will get 25 points for each person they get to join the website. With the "Referral" mod you did, I am notified by email when someone registers and the email also tells me who referred the member to the site. YEA! That mod is the BEST!! And, that will obviously make it easy for me to award the member who invited the new member their 25 points.

I'm EXCITED!

Thank you, again, Carefree! You are Sooo appreciated!!



"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
Go to Top of Page
Page: of 3 Previous Topic Topic Next Topic  
Previous Page | Next Page
 New Topic
 Printer Friendly
Jump To:
Snitz Forums 2000 © 2000-2021 Snitz™ Communications Go To Top Of Page
This page was generated in 0.49 seconds. Powered By: Snitz Forums 2000 Version 3.4.07