Snitz Forums 2000 - Looking mod birthday automatic email member

Author

Topic

Maxime
Average Member

France
521 Posts

Posted - 15 June 2014 : 22:02:43

Hello,

Looking mod birthday with automatic email member. So that the birthday or sent an email automatically member.

Cordially,
Maxime

Taxation consists in so plucking the goose to get the most out of feathers with the least possible cries.(Jean-Baptiste Colbert)

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 16 June 2014 : 17:24:43

Look at this topic.

Maxime
Average Member

France
521 Posts

Posted - 16 June 2014 : 19:36:54

Hello Carefree

There is there a way to utilser inc_birthdays.asp this page to send email automatically to the member on the day of their birthdays.

inc_birthdays.asp

<%
'#################################################################################
'## Snitz Forums 2000 v3.4.04
'#################################################################################
'## Copyright (C) 2000-04 Michael Anderson, Pierre Gorissen,
'##                       Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################
'## MOD: Birthdays v1.0 for Snitz Forums v3.4
'## Author: Michael Reisinger (OneWayMule)
'## File: inc_birthdays.asp
'##
'## Get the latest version of this MOD at
'## http://www.onewaymule.org/onewayscripts/
'#################################################################################
Sub DisplayBirthdays(intRange,intAge)
	Call DoHideCategory("Birthdays")
	HideForumCat = strUniqueID & "HideCatBirthdays"
	If Request.Cookies <> "Y" Then
		strBDToday = Left(DateToStr(strForumTimeAdjust),8) & "000000"
		strBDRecentDay = Mid(DateToStr(DateAdd("d",-intRange,strToDate(strBDToday))),5,4)
		strBDUpcomingDay = Mid(DateToStr(DateAdd("d",+intRange,strToDate(strBDToday))),5,4)
		strBDToday = Mid(strBDToday,5,4)
		strsql = "SELECT MEMBER_ID, M_NAME, M_DOB FROM " & strMemberTablePrefix & "MEMBERS WHERE M_DOB<>'' AND M_STATUS=1 ORDER BY Right(M_DOB,4)"
		Set rsBirthday = my_conn.Execute(strsql)
		bolRecentBD = False
		bolTodaysBD = False
		bolUpcomingBD = False
		If intRange = 1 Then
			strRecentBD = "Hier: "
			strUpcomingBD = "Demain: "
		Else
			strRecentBD = " Anniversaires Récents: "
			strUpcomingBD = "Prochains Anniversaires: "
		End If
		strTodaysBD = ""
		If NOT rsBirthday.EOF Then
			arrBD = rsBirthday.GetRows()
			bolBDFound = True
		Else
			bolBDFound = False
		End If
		rsBirthday.Close
		Set rsBirthday = Nothing
		If bolBDFound Then 
			For iBD = 0 to ubound(arrBD, 2)
				intBDID = arrBD(0, iBD)
				strBDName = chkString(arrBD(1, iBD),"display")
				intTPPostcount = arrBD(2, iBD)
				strDOB = Right(arrBD(2, iBD),4)
				strBirthdate = strToDate(arrBD(2, iBD) & "000000")
				If strDOB = strBDToday Then
					If bolTodaysBD = True Then 
						strTodaysBD = strTodaysBD & ", "
					End If
					strTodaysBD = strTodaysBD & profileLink(strBDName,intBDID) & " ("
					If intAge = 1 Then
						strTodaysBD = strTodaysBD & DisplayUsersAge(strBirthdate) & " ans le " 
					End If
					strTodaysBD = strTodaysBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate)) & ")"          
					bolTodaysBD = True
				End If   
				If strBDRecentDay > strBDToday Then
					If (strDOB > strBDRecentDay AND strDOB < "1231") OR (strDOB > "0101" AND strDOB < strBDToday) Then
						If bolRecentBD = True Then 
							strRecentBD = strRecentBD & ", "
						End If
						strRecentBD = strRecentBD & profileLink(strBDName,intBDID) & " ("
						If intAge = 1 Then
							strRecentBD = strRecentBD & DisplayUsersAge(strBirthdate) & " ans le " 
						End If
						strRecentBD = strRecentBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate)) & ")"          
						bolRecentBD = True
				        End If       
				Else
					If strDOB < strBDToday AND strDOB >= strBDRecentDay Then
						If bolRecentBD = True Then 
							strRecentBD = strRecentBD & ", "
						End If
						strRecentBD = strRecentBD & profileLink(strBDName,intBDID) & " ("
						If intAge = 1 Then
							strRecentBD = strRecentBD & DisplayUsersAge(strBirthdate) & " ans le " 
						End If
						strRecentBD = strRecentBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate)) & ")"          
						bolRecentBD = True
					End If
				End If
				If strBDUpcomingDay < strBDToday Then
					If (strDOB =< strBDUpcomingDay AND strDOB >= "0101") OR (strDOB =< "1231" AND strDOB > strBDToday) Then
						If bolUpcomingBD = True Then 
							strUpcomingBD = strUpcomingBD & ", "
						End If
						strUpcomingBD = strUpcomingBD & profileLink(strBDName,intBDID) & " ("
						If intAge = 1 Then
							strUpcomingBD = strUpcomingBD & DisplayUsersAge(strBirthdate)+1 & " ans le " 
						End If
						strUpcomingBD = strUpcomingBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate), true) & ")"          
						bolUpcomingBD = True
					End If       
				Else
					If strDOB > strBDToday AND strDOB <= strBDUpcomingDay Then
						If bolUpcomingBD = True Then 
							strUpcomingBD = strUpcomingBD & ", "
						End If
						strUpcomingBD = strUpcomingBD & profileLink(strBDName,intBDID) & " ("
						If intAge = 1 Then
							strUpcomingBD = strUpcomingBD & DisplayUsersAge(strBirthdate)+1 & " ans le " 
						End If
						strUpcomingBD = strUpcomingBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate), true) & ")"          
						bolUpcomingBD = True
					End If
				End If
			Next
		End If                  
		intBDRowSpan = 1
		If bolRecentBD Then 
			intBDRowSpan = intBDRowSpan + 1
			strRecentBD = strRecentBD & "."
		End If
		If bolTodaysBD Then 
			strTodaysBD = strTodaysBD & "."
		Else
			strTodaysBD = "Aucuns Anniversaires Aujourd'hui."
		End If
		If bolUpcomingBD Then 
			intBDRowSpan = intBDRowSpan + 1
			strUpcomingBD = strUpcomingBD & "."
		End If
        End If
	If Request.Cookies(HideForumCat) = "Y" Then
		Response.Write  "                <td bgcolor=""" & strCategoryCellColor & """ colspan=""" & sGetColspan(7,6) & """><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """><a href=""" & ScriptName & "?" & HideForumCat & "=N"">" & getCurrentIcon(strIconPlus,"Développer cette catégorie","") & "</a> <b>Anniversaires</b></font></td>" & vbNewLine
	Else
		Response.Write  "                <td bgcolor=""" & strCategoryCellColor & """ colspan=""" & sGetColspan(7,6) & """><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """><a href=""" & ScriptName & "?" & HideForumCat & "=Y"">" & getCurrentIcon(strIconMinus,"Réduire cette catégorie","") & "</a> <b>Anniversaires</b></font></td>" & vbNewLine
	End If
	Response.Write  "              </tr>" & vbNewLine 
	If Request.Cookies(HideForumCat) <> "Y" Then
		Response.write  "              <tr>" & vbNewLine & _
				"                <td align=""center"" bgcolor=""" & strForumCellColor & """ colspan=""1"" rowspan=""" & intBDRowSpan & """ valign=""middle"">" & getCurrentIcon(strIconBirthdays,"","") & vbNewLine & _
				"              </td>" & vbNewLine
		If (NOT bolTodaysBD) AND (NOT bolUpcomingBD) AND (NOT bolRecentBD) Then
			Response.Write  "                <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,5) & """>" & vbNewLine & _
					"                <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>None today." & vbNewLine
		Else
			Response.Write  "                <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,5) & """>" & vbNewLine & _
					"                  <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>" & strTodaysBD & "</font>" & vbNewLine & _
					"		      </td></tr>" & vbNewLine
			If bolUpcomingBD Then
				Response.Write  "                <tr><td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,5) & """>" & vbNewLine & _
						"                  <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & strUpcomingBD & "</font></td></tr>" & vbNewLine
			End If
			If bolRecentBD Then
				Response.Write  "                <tr><td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,5) & """>" & vbNewLine & _
						"                  <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & strRecentBD & "</font></td></tr>" & vbNewLine
			End If
		End If
		Response.Write  "		</tr>" & vbNewLine
 	End If
End Sub
%>

Cordially,
Maxime

Taxation consists in so plucking the goose to get the most out of feathers with the least possible cries.(Jean-Baptiste Colbert)

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 21 June 2014 : 15:16:22

No, not really; it does not do anything by itself. The commands have to come from another program, in this case "default.asp".

First, we need to add a field to your members table. Save the following as "dbs_membirth.asp" in your forum root folder. Then run it from the admin console, "mod setup".


Auto Birthday Mail v1.0

[ALTER]
MEMBERS
ADD#M_SENT_DOBMAIL#VARCHAR(4)#NULL#
[END]

Next, replace your "inc_birthdays.asp" with this:


<%
'#################################################################################
'## Snitz Forums 2000 v3.4.04
'#################################################################################
'## Copyright (C) 2000-04 Michael Anderson, Pierre Gorissen,
'##                       Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################
'## MOD: Birthdays v1.0 for Snitz Forums v3.4
'## Author: Michael Reisinger (OneWayMule)
'## File: inc_birthdays.asp
'##
'## Get the latest version of this MOD at
'## http://www.onewaymule.org/onewayscripts/
'#################################################################################
Sub DisplayBirthdays(intRange,intAge)
	Call DoHideCategory("Birthdays")
	HideForumCat = strUniqueID & "HideCatBirthdays"
	If Request.Cookies <> "Y" Then
		strBDToday = Left(DateToStr(strForumTimeAdjust),8) & "000000"
		strBDRecentDay = Mid(DateToStr(DateAdd("d",-intRange,strToDate(strBDToday))),5,4)
		strBDUpcomingDay = Mid(DateToStr(DateAdd("d",+intRange,strToDate(strBDToday))),5,4)
		strBDToday = Mid(strBDToday,5,4)
		strsql = "SELECT MEMBER_ID, M_NAME, M_DOB FROM " & strMemberTablePrefix & "MEMBERS WHERE M_DOB<>'' AND M_STATUS=1 ORDER BY Right(M_DOB,4)"
		Set rsBirthday = my_conn.Execute(strsql)
		bolRecentBD = False
		bolTodaysBD = False
		bolUpcomingBD = False
		If intRange = 1 Then
			strRecentBD = "Hier: "
			strUpcomingBD = "Demain: "
		Else
			strRecentBD = " Anniversaires Récents: "
			strUpcomingBD = "Prochains Anniversaires: "
		End If
		strTodaysBD = ""
		If NOT rsBirthday.EOF Then
			arrBD = rsBirthday.GetRows()
			bolBDFound = True
		Else
			bolBDFound = False
		End If
		rsBirthday.Close
		Set rsBirthday = Nothing
		If bolBDFound Then 
			For iBD = 0 to ubound(arrBD, 2)
				intBDID = arrBD(0, iBD)
				strBDName = chkString(arrBD(1, iBD),"display")
				intTPPostcount = arrBD(2, iBD)
				strDOB = Right(arrBD(2, iBD),4)
				strBirthdate = strToDate(arrBD(2, iBD) & "000000")
				If strDOB = strBDToday Then
					If bolTodaysBD = True Then 
						strTodaysBD = strTodaysBD & ", "
					End If
					strTodaysBD = strTodaysBD & profileLink(strBDName,intBDID) & " ("
					If intAge = 1 Then
						strTodaysBD = strTodaysBD & DisplayUsersAge(strBirthdate) & " ans le " 
					End If
					strTodaysBD = strTodaysBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate)) & ")"          
					bolTodaysBD = True
				End If   
				If strBDRecentDay > strBDToday Then
					If (strDOB > strBDRecentDay AND strDOB < "1231") OR (strDOB > "0101" AND strDOB < strBDToday) Then
						If bolRecentBD = True Then 
							strRecentBD = strRecentBD & ", "
						End If
						strRecentBD = strRecentBD & profileLink(strBDName,intBDID) & " ("
						If intAge = 1 Then
							strRecentBD = strRecentBD & DisplayUsersAge(strBirthdate) & " ans le " 
						End If
						strRecentBD = strRecentBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate)) & ")"          
						bolRecentBD = True
				        End If       
				Else
					If strDOB < strBDToday AND strDOB >= strBDRecentDay Then
						If bolRecentBD = True Then 
							strRecentBD = strRecentBD & ", "
						End If
						strRecentBD = strRecentBD & profileLink(strBDName,intBDID) & " ("
						If intAge = 1 Then
							strRecentBD = strRecentBD & DisplayUsersAge(strBirthdate) & " ans le " 
						End If
						strRecentBD = strRecentBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate)) & ")"          
						bolRecentBD = True
					End If
				End If
				If strBDUpcomingDay < strBDToday Then
					If (strDOB =< strBDUpcomingDay AND strDOB >= "0101") OR (strDOB =< "1231" AND strDOB > strBDToday) Then
						If bolUpcomingBD = True Then 
							strUpcomingBD = strUpcomingBD & ", "
						End If
						strUpcomingBD = strUpcomingBD & profileLink(strBDName,intBDID) & " ("
						If intAge = 1 Then
							strUpcomingBD = strUpcomingBD & DisplayUsersAge(strBirthdate)+1 & " ans le " 
						End If
						strUpcomingBD = strUpcomingBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate), true) & ")"          
						bolUpcomingBD = True
					End If       
				Else
					If strDOB > strBDToday AND strDOB <= strBDUpcomingDay Then
						If bolUpcomingBD = True Then 
							strUpcomingBD = strUpcomingBD & ", "
						End If
						strUpcomingBD = strUpcomingBD & profileLink(strBDName,intBDID) & " ("
						If intAge = 1 Then
							strUpcomingBD = strUpcomingBD & DisplayUsersAge(strBirthdate)+1 & " ans le " 
						End If
						strUpcomingBD = strUpcomingBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate), true) & ")"          
						bolUpcomingBD = True
					End If
				End If
			Next
		End If                  
		intBDRowSpan = 1
		If bolRecentBD Then 
			intBDRowSpan = intBDRowSpan + 1
			strRecentBD = strRecentBD & "."
		End If
		If bolTodaysBD Then 
			strTodaysBD = strTodaysBD & "."
		Else
			strTodaysBD = "Aucuns Anniversaires Aujourd'hui."
		End If
		If bolUpcomingBD Then 
			intBDRowSpan = intBDRowSpan + 1
			strUpcomingBD = strUpcomingBD & "."
		End If
        End If
	If Request.Cookies(HideForumCat) = "Y" Then
		Response.Write  "                <td bgcolor=""" & strCategoryCellColor & """ colspan=""" & sGetColspan(7,6) & """><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """><a href=""" & ScriptName & "?" & HideForumCat & "=N"">" & getCurrentIcon(strIconPlus,"Développer cette catégorie","") & "</a> <b>Anniversaires</b></font></td>" & vbNewLine
	Else
		Response.Write  "                <td bgcolor=""" & strCategoryCellColor & """ colspan=""" & sGetColspan(7,6) & """><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """><a href=""" & ScriptName & "?" & HideForumCat & "=Y"">" & getCurrentIcon(strIconMinus,"Réduire cette catégorie","") & "</a> <b>Anniversaires</b></font></td>" & vbNewLine
	End If
	Response.Write  "              </tr>" & vbNewLine 
	If Request.Cookies(HideForumCat) <> "Y" Then
		Response.write  "              <tr>" & vbNewLine & _
				"                <td align=""center"" bgcolor=""" & strForumCellColor & """ colspan=""1"" rowspan=""" & intBDRowSpan & """ valign=""middle"">" & getCurrentIcon(strIconBirthdays,"","") & vbNewLine & _
				"              </td>" & vbNewLine
		If (NOT bolTodaysBD) AND (NOT bolUpcomingBD) AND (NOT bolRecentBD) Then
			Response.Write  "                <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,5) & """>" & vbNewLine & _
					"                <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>None today." & vbNewLine
		Else
			Response.Write  "                <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,5) & """>" & vbNewLine & _
					"                  <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>" & strTodaysBD & "</font>" & vbNewLine & _
					"		      </td></tr>" & vbNewLine
			If bolUpcomingBD Then
				Response.Write  "                <tr><td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,5) & """>" & vbNewLine & _
						"                  <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & strUpcomingBD & "</font></td></tr>" & vbNewLine
			End If
			If bolRecentBD Then
				Response.Write  "                <tr><td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,5) & """>" & vbNewLine & _
						"                  <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & strRecentBD & "</font></td></tr>" & vbNewLine
			End If
		End If
		Response.Write  "		</tr>" & vbNewLine
 	End If
End Sub
Function BirthMail
	strSql = "SELECT M_NAME, MEMBER_ID, M_EMAIL, M_RECEIVE_EMAIL, M_DOB, M_SENT_DOBMAIL FROM " & strMemberTablePrefix & "MEMBERS WHERE "
	if strDBType="sqlserver" or strDBType="mysql" then
		strSql = strSql & "SUBSTRING(M_DOB,5,4) ='" & SUBSTRING(DATETOSTR(STRFORUMTIMEADJUST),5,4) & "' ORDER BY M_DOB"
	else
		strSql = strSql & "MID(M_DOB,5,4) ='" & MID(DATETOSTR(STRFORUMTIMEADJUST),5,4) & "' ORDER BY M_DOB"
	end if
	set rsBirthMail = my_Conn.Execute(strSql)
	if not rsBirthMail.EOF then
		rsBirthMail.MoveFirst
		Do while not rsBirthMail.EOF
			strSent=rsBirthMail("M_SENT_DOBMAIL")
			strYY=left(DatetoStr(strForumTimeAdjust),4)
			If isNull(strSent) or (strSent <> strYY) then
				strFromName = strForumTitle
				strRecipientsName = rsBirthMail("M_NAME")
				strRecipients = rsBirthMail("M_EMAIL")
				strSender = strSender
				strSubject = "Happy Birthday!"
				strMessage = "Dear " & rsBirthMail("M_NAME")
				strMessage = strMessage & "<br><br>Happy birthday from everyone at <a href=" & strForumURL & ">" & strForumTitle & "</a>." & vbNewline & vbNewline
				htmlflag = 0
				if rsBirthMail("M_RECEIVE_EMAIL") = 1 then
					%><!--#INCLUDE FILE="inc_mail_html.asp" --><%
				end if
				strMessage =""
				strSql = " UPDATE " & strMemberTablePrefix & "MEMBERS SET M_SENT_DOBMAIL = '" & strYY & "' WHERE MEMBER_ID = " & rsBirthMail("MEMBER_ID")
				my_Conn.Execute(strSql)
			end if
			rsBirthMail.MoveNext
		Loop
		rsBirthMail.Close
	end if
	set rsBirthMail = Nothing
End Function
%>

Next, in "default.asp" look for this line:

Call DisplayBirthdays(30,1)

Below that, insert this:

BirthMail

Maxime
Average Member

France
521 Posts

Posted - 22 June 2014 : 19:20:44

Hello Carefree,

This works, but there just has to make a correction, I get on this whole red part of the code shipments mail.

Text of the email received :
Dear Gege <br><br> Happy Birthday everyone <a href=http://www.chatquiz.org/> Forum Chatquiz</ a>


<%
'#################################################################################
'## Snitz Forums 2000 v3.4.04
'#################################################################################
'## Copyright (C) 2000-04 Michael Anderson, Pierre Gorissen,
'##                       Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################
'## MOD: Birthdays v1.0 for Snitz Forums v3.4
'## Author: Michael Reisinger (OneWayMule)
'## File: inc_birthdays.asp
'##
'## Get the latest version of this MOD at
'## http://www.onewaymule.org/onewayscripts/
'#################################################################################
Sub DisplayBirthdays(intRange,intAge)
	Call DoHideCategory("Birthdays")
	HideForumCat = strUniqueID & "HideCatBirthdays"
	If Request.Cookies <> "Y" Then
		strBDToday = Left(DateToStr(strForumTimeAdjust),8) & "000000"
		strBDRecentDay = Mid(DateToStr(DateAdd("d",-intRange,strToDate(strBDToday))),5,4)
		strBDUpcomingDay = Mid(DateToStr(DateAdd("d",+intRange,strToDate(strBDToday))),5,4)
		strBDToday = Mid(strBDToday,5,4)
		strsql = "SELECT MEMBER_ID, M_NAME, M_DOB FROM " & strMemberTablePrefix & "MEMBERS WHERE M_DOB<>'' AND M_STATUS=1 ORDER BY Right(M_DOB,4)"
		Set rsBirthday = my_conn.Execute(strsql)
		bolRecentBD = False
		bolTodaysBD = False
		bolUpcomingBD = False
		If intRange = 1 Then
			strRecentBD = "Hier: "
			strUpcomingBD = "Demain: "
		Else
			strRecentBD = " Anniversaires Récents: "
			strUpcomingBD = "Prochains Anniversaires: "
		End If
		strTodaysBD = ""
		If NOT rsBirthday.EOF Then
			arrBD = rsBirthday.GetRows()
			bolBDFound = True
		Else
			bolBDFound = False
		End If
		rsBirthday.Close
		Set rsBirthday = Nothing
		If bolBDFound Then 
			For iBD = 0 to ubound(arrBD, 2)
				intBDID = arrBD(0, iBD)
				strBDName = chkString(arrBD(1, iBD),"display")
				intTPPostcount = arrBD(2, iBD)
				strDOB = Right(arrBD(2, iBD),4)
				strBirthdate = strToDate(arrBD(2, iBD) & "000000")
				If strDOB = strBDToday Then
					If bolTodaysBD = True Then 
						strTodaysBD = strTodaysBD & ", "
					End If
					strTodaysBD = strTodaysBD & profileLink(strBDName,intBDID) & " ("
					If intAge = 1 Then
						strTodaysBD = strTodaysBD & DisplayUsersAge(strBirthdate) & " ans le " 
					End If
					strTodaysBD = strTodaysBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate)) & ")"          
					bolTodaysBD = True
				End If   
				If strBDRecentDay > strBDToday Then
					If (strDOB > strBDRecentDay AND strDOB < "1231") OR (strDOB > "0101" AND strDOB < strBDToday) Then
						If bolRecentBD = True Then 
							strRecentBD = strRecentBD & ", "
						End If
						strRecentBD = strRecentBD & profileLink(strBDName,intBDID) & " ("
						If intAge = 1 Then
							strRecentBD = strRecentBD & DisplayUsersAge(strBirthdate) & " ans le " 
						End If
						strRecentBD = strRecentBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate)) & ")"          
						bolRecentBD = True
				        End If       
				Else
					If strDOB < strBDToday AND strDOB >= strBDRecentDay Then
						If bolRecentBD = True Then 
							strRecentBD = strRecentBD & ", "
						End If
						strRecentBD = strRecentBD & profileLink(strBDName,intBDID) & " ("
						If intAge = 1 Then
							strRecentBD = strRecentBD & DisplayUsersAge(strBirthdate) & " ans le " 
						End If
						strRecentBD = strRecentBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate)) & ")"          
						bolRecentBD = True
					End If
				End If
				If strBDUpcomingDay < strBDToday Then
					If (strDOB =< strBDUpcomingDay AND strDOB >= "0101") OR (strDOB =< "1231" AND strDOB > strBDToday) Then
						If bolUpcomingBD = True Then 
							strUpcomingBD = strUpcomingBD & ", "
						End If
						strUpcomingBD = strUpcomingBD & profileLink(strBDName,intBDID) & " ("
						If intAge = 1 Then
							strUpcomingBD = strUpcomingBD & DisplayUsersAge(strBirthdate)+1 & " ans le " 
						End If
						strUpcomingBD = strUpcomingBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate), true) & ")"          
						bolUpcomingBD = True
					End If       
				Else
					If strDOB > strBDToday AND strDOB <= strBDUpcomingDay Then
						If bolUpcomingBD = True Then 
							strUpcomingBD = strUpcomingBD & ", "
						End If
						strUpcomingBD = strUpcomingBD & profileLink(strBDName,intBDID) & " ("
						If intAge = 1 Then
							strUpcomingBD = strUpcomingBD & DisplayUsersAge(strBirthdate)+1 & " ans le " 
						End If
						strUpcomingBD = strUpcomingBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate), true) & ")"          
						bolUpcomingBD = True
					End If
				End If
			Next
		End If                  
		intBDRowSpan = 1
		If bolRecentBD Then 
			intBDRowSpan = intBDRowSpan + 1
			strRecentBD = strRecentBD & "."
		End If
		If bolTodaysBD Then 
			strTodaysBD = strTodaysBD & "."
		Else
			strTodaysBD = "Aucuns Anniversaires Aujourd'hui."
		End If
		If bolUpcomingBD Then 
			intBDRowSpan = intBDRowSpan + 1
			strUpcomingBD = strUpcomingBD & "."
		End If
        End If
	If Request.Cookies(HideForumCat) = "Y" Then
		Response.Write  "                <td bgcolor=""" & strCategoryCellColor & """ colspan=""" & sGetColspan(7,6) & """><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """><a href=""" & ScriptName & "?" & HideForumCat & "=N"">" & getCurrentIcon(strIconPlus,"Développer cette catégorie","") & "</a> <b>Anniversaires</b></font></td>" & vbNewLine
	Else
		Response.Write  "                <td bgcolor=""" & strCategoryCellColor & """ colspan=""" & sGetColspan(7,6) & """><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """><a href=""" & ScriptName & "?" & HideForumCat & "=Y"">" & getCurrentIcon(strIconMinus,"Réduire cette catégorie","") & "</a> <b>Anniversaires</b></font></td>" & vbNewLine
	End If
	Response.Write  "              </tr>" & vbNewLine 
	If Request.Cookies(HideForumCat) <> "Y" Then
		Response.write  "              <tr>" & vbNewLine & _
				"                <td align=""center"" bgcolor=""" & strForumCellColor & """ colspan=""1"" rowspan=""" & intBDRowSpan & """ valign=""middle"">" & getCurrentIcon(strIconBirthdays,"","") & vbNewLine & _
				"              </td>" & vbNewLine
		If (NOT bolTodaysBD) AND (NOT bolUpcomingBD) AND (NOT bolRecentBD) Then
			Response.Write  "                <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,5) & """>" & vbNewLine & _
					"                <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>None today." & vbNewLine
		Else
			Response.Write  "                <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,5) & """>" & vbNewLine & _
					"                  <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>" & strTodaysBD & "</font>" & vbNewLine & _
					"		      </td></tr>" & vbNewLine
			If bolUpcomingBD Then
				Response.Write  "                <tr><td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,5) & """>" & vbNewLine & _
						"                  <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & strUpcomingBD & "</font></td></tr>" & vbNewLine
			End If
			If bolRecentBD Then
				Response.Write  "                <tr><td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,5) & """>" & vbNewLine & _
						"                  <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & strRecentBD & "</font></td></tr>" & vbNewLine
			End If
		End If
		Response.Write  "		</tr>" & vbNewLine
 	End If
End Sub
Function BirthMail
	strSql = "SELECT M_NAME, MEMBER_ID, M_EMAIL, M_RECEIVE_EMAIL, M_DOB, M_SENT_DOBMAIL FROM " & strMemberTablePrefix & "MEMBERS WHERE "
	if strDBType="sqlserver" or strDBType="mysql" then
		strSql = strSql & "SUBSTRING(M_DOB,5,4) ='" & SUBSTRING(DATETOSTR(STRFORUMTIMEADJUST),5,4) & "' ORDER BY M_DOB"
	else
		strSql = strSql & "MID(M_DOB,5,4) ='" & MID(DATETOSTR(STRFORUMTIMEADJUST),5,4) & "' ORDER BY M_DOB"
	end if
	set rsBirthMail = my_Conn.Execute(strSql)
	if not rsBirthMail.EOF then
		rsBirthMail.MoveFirst
		Do while not rsBirthMail.EOF
			strSent=rsBirthMail("M_SENT_DOBMAIL")
			strYY=left(DatetoStr(strForumTimeAdjust),4)
			If isNull(strSent) or (strSent <> strYY) then
				strFromName = strForumTitle
				strRecipientsName = rsBirthMail("M_NAME")
				strRecipients = rsBirthMail("M_EMAIL")
				strSender = strSender
				strSubject = "Happy Birthday!"
				strMessage = "Dear " & rsBirthMail("M_NAME")
				strMessage = strMessage & "<br><br>Happy birthday from everyone at <a href=" & strForumURL & ">"& strForumTitle & "</a>."  & vbNewline & vbNewline
				htmlflag = 0
				if rsBirthMail("M_RECEIVE_EMAIL") = 1 then
					%><!--#INCLUDE FILE="inc_mail.asp" --><%
				end if
				strMessage =""
				strSql = " UPDATE " & strMemberTablePrefix & "MEMBERS SET M_SENT_DOBMAIL = '" & strYY & "' WHERE MEMBER_ID = " & rsBirthMail("MEMBER_ID")
				my_Conn.Execute(strSql)
			end if
			rsBirthMail.MoveNext
		Loop
		rsBirthMail.Close
	end if
	set rsBirthMail = Nothing
End Function
%>

Cordially,
Maxime

Taxation consists in so plucking the goose to get the most out of feathers with the least possible cries.(Jean-Baptiste Colbert)

Edited by - Maxime on 22 June 2014 19:57:43

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 23 June 2014 : 04:10:25

Change those lines in red to say this:

				strMessage = "Dear " & rsBirthMail("M_NAME") & vbCRLF & vbCRLF
				strMessage = strMessage & "Happy birthday from everyone at "& strForumTitle & "."

Maxime
Average Member

France
521 Posts

Posted - 23 June 2014 : 06:44:35

Hello Carefree,

Thank you very much for the birthday page. Must wait until tomorrow because I put two of my birthday tomorrow accounts lol!

Cordially,
Maxime

Taxation consists in so plucking the goose to get the most out of feathers with the least possible cries.(Jean-Baptiste Colbert)

Edited by - Maxime on 23 June 2014 06:47:27

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 23 June 2014 : 08:20:44

You're welcome.

Maxime
Average Member

France
521 Posts

Posted - 25 June 2014 : 03:14:28

Hello Carefree,

It works correctly. I added a virguele at the end of the member name you tell me if it will work, it is marked in red below.

strMessage = "Cher(e) " & rsBirthMail("M_NAME")"," & vbCRLF & vbCRLF

Cordially,
Maxime

Taxation consists in so plucking the goose to get the most out of feathers with the least possible cries.(Jean-Baptiste Colbert)

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 25 June 2014 : 15:04:29

No. That will cause an error. It should be:

strMessage = "Cher(e) " & rsBirthMail("M_NAME") & "," & vbCRLF & vbCRLF

Maxime
Average Member

France
521 Posts

Posted - 25 June 2014 : 15:21:26

Thank you very much for your work Carefree,

I'll see tomorrow, because I put a new test with a creation of a new member to my email

Cordially,
Maxime

Taxation consists in so plucking the goose to get the most out of feathers with the least possible cries.(Jean-Baptiste Colbert)

Topic