| Author |
 Topic  |
|
Carefree
Advanced Member
Philippines
4207 Posts |
 Posted - 03 January 2014 : 19:13:38
|
| Forgot to define a variable. Replaced. Still untested here. |
 |
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 03 January 2014 : 20:50:53
|
It still doesn't list any of the upcoming birthdays, 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 |
|
|
|
Carefree
Advanced Member
Philippines
4207 Posts |
Posted - 03 January 2014 : 20:57:00
|
| I'll test it and send you a final version. Have to install it here, etc.; so will take a little while. Not sure what you're looking at, because I see your upcoming birthdays when I visit.... |
Edited by - Carefree on 04 January 2014 00:59:11 |
|
|
|
Maxime
Average Member
France
521 Posts |
Posted - 04 January 2014 : 02:42:27
|
Hello Carefree,
I also have a problem with the birthday page. In the list of upcoming birthday in December 2013, January 2014 was above those of December 2013. Can you fix it.
My page is in French and dates here in French begins with the day, month and year.
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 - 04 January 2014 : 04:53:50
|
Max, try this, untested:
<%
'#################################################################################
'## 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
strSqlC="SELECT COUNT(MEMBER_ID) AS CNT FROM " & strMemberTablePrefix & "MEMBERS WHERE (M_STATUS=1 AND RIGHT(M_DOB,4)>'" & STRBDTODAY & "' AND RIGHT(M_DOB,4) < '" & strBDUpcomingDay & "')"
Set rsC=my_conn.Execute(strSqlC)
intCnt=0
If not rsC.EOF Then
intCnt=rsC("Cnt")
strSql1="SELECT MEMBER_ID, M_NAME, M_DOB FROM " & strMemberTablePrefix & "MEMBERS WHERE (M_STATUS=1 AND RIGHT(M_DOB,4)>'" & STRBDTODAY & "' AND RIGHT(M_DOB,4) < '" & strBDUpcomingDay & "') ORDER BY Right(M_DOB,4) ASC"
Set rsUp=my_Conn.Execute(strSql1)
If not rsUp.EOF Then
rsUp.MoveFirst
Do while not rsUp.EOF
strBD=strToDate(rsUp("M_DOB") & "000000")
Response.Write " <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & profileLink(rsUp("M_Name"), rsUp("Member_ID")) & " (& day(strBD) & " " & monthName(Datepart("m",strBD, true)) & ")"
intCnt=intCnt-1
If intCnt>0 Then Response.Write ", "
Response.Write "</font>" & vbNewLine
rsUp.MoveNext
Loop
rsUp.Close
End If
Set rsUp=Nothing
rsC.Close
End If
Set rsC=Nothing
Response.Write "</td></tr>"
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
%>
|
Edited by - Carefree on 04 January 2014 04:54:29 |
|
|
|
Maxime
Average Member
France
521 Posts |
Posted - 04 January 2014 : 06:02:41
|
error
Microsoft VBScript compilation error error '800a0401 '
End of statement expected
/ inc_birthdays.asp, line 186
Response.Write "<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & ProfileLink (rsup ("m_name") , rsup ("member_id")) & "(& day (strBD) &" "& MonthName (DatePart (" m ", strBD, true)) &") " |
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 - 04 January 2014 : 09:07:56
|
It's missing a quotation mark (in red):
quote:
Response.Write "<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & ProfileLink (rsup ("m_name") , rsup ("member_id")) & "("& day (strBD) &" "& MonthName (DatePart (" m ", strBD, true)) &") "
|
|
|
|
Maxime
Average Member
France
521 Posts |
Posted - 04 January 2014 : 09:28:56
|
| Carefree sorry it lacks the number of years on Upcoming Events: Example: 48 years Smith |
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 - 04 January 2014 : 15:59:08
|
No problem, we'll just add it.
<%
'#################################################################################
'## 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
strSqlC="SELECT COUNT(MEMBER_ID) AS CNT FROM " & strMemberTablePrefix & "MEMBERS WHERE (M_STATUS=1 AND RIGHT(M_DOB,4)>'" & STRBDTODAY & "' AND RIGHT(M_DOB,4) < '" & strBDUpcomingDay & "')"
Set rsC=my_conn.Execute(strSqlC)
intCnt=0
If not rsC.EOF Then
intCnt=rsC("Cnt")
strSql1="SELECT MEMBER_ID, M_NAME, M_DOB FROM " & strMemberTablePrefix & "MEMBERS WHERE (M_STATUS=1 AND RIGHT(M_DOB,4)>'" & STRBDTODAY & "' AND RIGHT(M_DOB,4) < '" & strBDUpcomingDay & "') ORDER BY Right(M_DOB,4) ASC"
Set rsUp=my_Conn.Execute(strSql1)
If not rsUp.EOF Then
rsUp.MoveFirst
Do while not rsUp.EOF
strBD=strToDate(rsUp("M_DOB") & "000000")
Response.Write " <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & profileLink(rsUp("M_Name"), rsUp("Member_ID"))
If intAge=1 Then
Response.Write DisplayUsersAge(rsUp(M_DOB)&"000000")+1 & " ans le "
End If
Response.Write " (& day(strBD) & " " & monthName(Datepart("m",strBD, true)) & ")"
intCnt=intCnt-1
If intCnt>0 Then Response.Write ", "
Response.Write "</font>" & vbNewLine
rsUp.MoveNext
Loop
rsUp.Close
End If
Set rsUp=Nothing
rsC.Close
End If
Set rsC=Nothing
Response.Write "</td></tr>"
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
%>
|
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 05 January 2014 : 08:16:19
|
It's working fine now, Carefree!
Thank you so much for your help!
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Carefree
Advanced Member
Philippines
4207 Posts |
Posted - 05 January 2014 : 09:59:06
|
| You're welcome. |
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 23 December 2014 : 18:28:43
|
Carefree, I am having the problem again of the Birthday Mod not listing the updating birthdays. I hate to ask but do you feel up to helping with this? If not, could someone else help?
|
"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 |
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 26 December 2014 : 00:32:18
|
I got the Birthday Mod to list the upcoming birthdays again, but it's now listing the January birthdays before the remaining ones for December.  And in the recent birthdays section, it's listing the November birthdays before the December birthdays.
I just noticed the date of when I first started this post and it's this same time last year. Could the ending of the year be affecting the mod in some way? Just thought it was strange that it's the same time of year and I was having the exact same problem with this mod.
Here's my inc_birthdays.asp if someone has time to look at it for me.
|
"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 26 December 2014 00:36:33 |
|
|
|
Carefree
Advanced Member
Philippines
4207 Posts |
Posted - 26 December 2014 : 06:36:41
|
quote:
And in the recent birthdays section, it's listing the November birthdays before the December birthdays.
That's not difficult to change. Just select in reverse chronological order. Try this:
<%
'###############################################################################
'##
'## Snitz Forums 2000 v3.4.07
'##
'###############################################################################
'##
'## Copyright © 2000-09 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free. You can redistribute and/or modify it under the
'## terms of the GNU General Public License as published by the Free Software
'## Foundation; either version 2 or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000 must remain intact in
'## the scripts and in the HTML output. The "powered by" text/logo with a
'## link back to http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful but
'## WITHOUT ANY WARRANTY; without even an implied warranty of MERCHANTABILITY
'## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
'## for more details.
'##
'## You should have received a copy of the GNU General Public License along
'## with this program; if not, write to:
'##
'## Free Software Foundation, Inc.
'## 59 Temple Place, Suite 330
'## Boston, MA 02111-1307
'##
'## Support can be obtained from our support forums at:
'##
'## http://forum.snitz.com
'##
'## Correspondence and marketing questions can be sent to:
'##
'## manderson@snitz.com
'##
'###############################################################################
'## 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 = "Yesterday: "
strUpcomingBD = "Tomorrow: "
Else
strRecentBD = "Recent: "
strUpcomingBD = "Upcoming: "
End If
strTodaysBD = ""
If NOT rsBirthday.EOF Then
arrBD = rsBirthday.GetRows()
bolBDFound = True
rsBirthday.Close
Else
bolBDFound = False
End If
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) & " on "
End If
strTodaysBD = strTodaysBD & monthName(Datepart("m",strBirthDate)) & " " & day(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) & " on "
End If
strRecentBD = strRecentBD & monthName(Datepart("m",strBirthDate)) & " " & day(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) & " on "
End If
strRecentBD = strRecentBD & monthName(Datepart("m",strBirthDate)) & " " & day(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 & " on "
End If
strUpcomingBD = strUpcomingBD & monthName(Datepart("m",strBirthDate), true) & " " & day(strBirthDate) & ")"
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 & " on "
End If
strUpcomingBD = strUpcomingBD & monthName(Datepart("m",strBirthDate), true) & " " & day(strBirthDate) & ")"
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 = "None."
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,"Expand This Category","") & "</a> <b>Birthdays</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,"Collapse This Category","") & "</a> <b>Birthdays</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
strSqlC="SELECT COUNT(MEMBER_ID) AS CNT FROM " & strMemberTablePrefix & "MEMBERS WHERE (M_STATUS=1 AND RIGHT(M_DOB,4)>'" & STRBDTODAY & "' AND RIGHT(M_DOB,4) < '" & strBDUpcomingDay & "')"
Set rsC=my_conn.Execute(strSqlC)
intCnt=0
If not rsC.EOF Then
intCnt=rsC("Cnt")
strSql1="SELECT MEMBER_ID, M_NAME, M_DOB FROM " & strMemberTablePrefix & "MEMBERS WHERE (M_STATUS=1 AND RIGHT(M_DOB,4)>'" & STRBDTODAY & "' AND RIGHT(M_DOB,4) < '" & strBDUpcomingDay & "') ORDER BY Right(M_DOB,4) DESC"
Set rsUp=my_Conn.Execute(strSql1)
If not rsUp.EOF Then
rsUp.MoveFirst
Do while not rsUp.EOF
strBD=strToDate(rsUp("M_DOB") & "000000")
Response.Write " <font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & profileLink(rsUp("M_Name"), rsUp("Member_ID")) & " (" & monthName(Datepart("m",strBD, true)) & " " & day(strBD) & ")"
intCnt=intCnt-1
If intCnt>0 Then Response.Write ", "
Response.Write "</font>" & vbNewLine
rsUp.MoveNext
Loop
rsUp.Close
End If
Set rsUp=Nothing
rsC.Close
End If
Set rsC=Nothing
Response.Write "</td></tr>"
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
%>
|
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 26 December 2014 : 12:15:28
|
That didn't work, Carefree. And, it also removed the upcoming birthday list.
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Topic |
|
|
|
