quote:
Originally posted by Carefree
Sure
<%
'#################################################################################
'## Ver.3.4.07 multi-language Skin3D Portal V2
'#################################################################################
'## Copyright (C) 2001-07 Gaëtan Dupont All Rights Reserved
'##
'## By using this program, you are agreeing to the terms of the
'## GNU General Public License.
'##
'## 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 ImageForums2001 must remain intact
'## in the scripts and in the outputted HTML.
'## The "Image Forums 2001" text with a link back to
'## http://www.forums2001.ca in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## Support can be obtained from support forums at:
'## http://www.forums2001.ca
'##
'## Email: image_forum_2001@hotmail.com
'##
'#################################################################################
'## This Page Contains source code of Snitz Forums 2000
'#################################################################################
'## Snitz Forums 2000 v3.4.06
'#################################################################################
'## Copyright (C) 2000-06 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<!--#INCLUDE FILE="inc_sha256.asp"-->
<!--#INCLUDE FILE="inc_header.asp" -->
<!--#INCLUDE FILE="inc_func_member.asp" -->
<%
BirthdayPage = chkUserPermissions(intBirthdayPermission)
if BirthdayPage then
Response.Write " <table border=""0"" width=""100%"">"& vbNewLine & _
" <tr>"& vbNewLine & _
" <td width=""33%"" align=""left"" nowrap><font face=""" & strDefaultFontFace & """ size="""& strDefaultFontSize &""">"& vbNewLine & _
" " & getCurrentIcon(strIconFolderOpen,"","align=""absmiddle""") & " <a href=""default.asp"">" & fLang("strLangAll_Forums00010") & "</a><br>"& vbNewLine & _
" " & getCurrentIcon(strIconBar,"","align=""absmiddle""") & getCurrentIcon(strIconBdayCake,"","align=""absmiddle""") & " " & fLang("strLangI_Birthdays00110") & "</font>" & vbNewLine & _
" </td>"& vbNewLine & _
" </tr>"& vbNewLine & _
" </table><br />"& vbNewLine & _
" <table width=""75%"" align=""center"" border=""0"" cellspacing=""0"" cellpadding=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td " & TableBorderColor & " width=""100%"">" & vbNewLine
Call CornerTop
Response.Write " <table width=""100%"" align=""center"" border=""0"" " & Cellspacing & " cellpadding=""4"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td colspan=""2"" " & HeadCellColor & " width=""100%""><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ " & HeadFontColor & ">" & fLang("strLangCla00480") & "</font></b></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine
Call DisplayBirthdays2(1,1)
Response.Write " </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td " & CategoryCellColor & " width=""50%"" vAlign=""top""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ " & CategoryFontColor & "><b>" & fLang("strLangCla00490") & "</b></font></td>" & vbNewLine & _
" <td " & CategoryCellColor & " width=""50%"" vAlign=""top""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ " & CategoryFontColor & "><b>" & fLang("strLangCla00510") & "</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine
Call DisplayBirthdays(30,1)
Response.Write " </tr>" & vbNewLine & _
" </table>" & vbNewLine
Call CornerBottom
Response.Write " </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine
WriteFooter
Response.End
else
Response.redirect "default.asp"
end if
sub DisplayBirthdays(intRange,intAge)
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)>1 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 = fLang("strLangI_Birthdays00006") & ": "
strUpcomingBD = fLang("strLangI_Birthdays00010") & ": "
else
strRecentBD = fLang("strLangI_Birthdays00020") & ": "
strUpcomingBD = fLang("strLangI_Birthdays00030") & ": "
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")
'# Check if recent
if strDOB = strBDToday then
if bolTodaysBD = True then
strTodaysBD = strTodaysBD & " #149; "
end if
strTodaysBD = strTodaysBD & profileLink(strBDName,intBDID) & "("
if intAge = 1 then
strTodaysBD = strTodaysBD & DisplayUsersAge(strBirthdate) & fLang("strLangI_Birthdays00111")
end if
strTodaysBD = strTodaysBD & monthName(Datepart("m",strBirthDate), true) & "." & 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 & "<br />#149; "
end if
strRecentBD = strRecentBD & profileLink(strBDName,intBDID) & "."
if intAge = 1 then
strRecentBD = strRecentBD & fLang("strLangI_Birthdays00112") & " <b>" & DisplayUsersAge(strBirthdate) & "</b> " & fLang("strLangI_Birthdays00040")& ""
else
strRecentBD = strRecentBD & "("
end if
if strLangLCID=1040 then
strRecentBD = strRecentBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate), true)
else
strRecentBD = strRecentBD & monthName(Datepart("m",strBirthDate), true) & "." & day(strBirthDate)
end if
if intAge = 1 then
strRecentBD = strRecentBD & "."
else
strRecentBD = strRecentBD & ")"
end if
bolRecentBD = True
end if
else
if strDOB < strBDToday and strDOB >= strBDRecentDay then
if bolRecentBD = True then
strRecentBD = strRecentBD & "<br />#149; "
end if
strRecentBD = strRecentBD & profileLink(strBDName,intBDID) & " "
if intAge = 1 then
strRecentBD = strRecentBD & fLang("strLangI_Birthdays00112") & " <b>" & DisplayUsersAge(strBirthdate)+1 & "</b> " & fLang("strLangI_Birthdays00040")& " "
else
strRecentBD = strRecentBD & "("
end if
if strLangLCID=1040 then
strRecentBD = strRecentBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate), true)
else
strRecentBD = strRecentBD & monthName(Datepart("m",strBirthDate), true) & ". " & day(strBirthDate)
end if
if intAge = 1 then
strRecentBD = strRecentBD & "."
else
strRecentBD = strRecentBD & ")"
end if
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 & "<br /> #149; "
end if
strUpcomingBD = strUpcomingBD & profileLink(strBDName,intBDID) & " "
if intAge = 1 then
strUpcomingBD = strUpcomingBD & fLang("strLangI_Birthdays00111") & " <b>" & DisplayUsersAge(strBirthdate)+1 & "</b> " & fLang("strLangI_Birthdays00040")& " "
else
strUpcomingBD = strUpcomingBD & "("
end if
if strLangLCID=1040 then
strUpcomingBD = strUpcomingBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate), true)
else
strUpcomingBD= strUpcomingBD & monthName(Datepart("m",strBirthDate), true) & ". " & day(strBirthDate)
end if
if intAge = 1 then
strUpcomingBD = strUpcomingBD & "."
else
strUpcomingBD = strUpcomingBD & ")"
end if
bolUpcomingBD = True
end if
else
if strDOB > strBDToday and strDOB <= strBDUpcomingDay then
if bolUpcomingBD = True then
strUpcomingBD = strUpcomingBD & "<br />#149; "
end if
strUpcomingBD = strUpcomingBD & profileLink(strBDName,intBDID) & " "
if intAge = 1 then
strUpcomingBD = strUpcomingBD & fLang("strLangI_Birthdays00111") &" <b>" & DisplayUsersAge(strBirthdate)+1 & "</b> " & fLang("strLangI_Birthdays00040")& " "
else
strUpcomingBD = strUpcomingBD & "("
end if
if strLangLCID=1040 then
strUpcomingBD = strUpcomingBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate), true)
else
strUpcomingBD= strUpcomingBD & monthName(Datepart("m",strBirthDate), true) & " " & day(strBirthDate)
end if
if intAge = 1 then
strUpcomingBD = strUpcomingBD & "."
else
strUpcomingBD = strUpcomingBD & ")"
end if
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 = fLang("strLangI_Birthdays00050") & "."
end if
if bolUpcomingBD then
intBDRowSpan = intBDRowSpan + 1
strUpcomingBD = strUpcomingBD & ""
end if
Response.Write " <td " & ForumCellColor & " width=""50%"" vAlign=""top"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ " & ForumFontColor & ">"
if bolUpcomingBD then Response.Write("#149; " & strUpcomingBD) else Response.Write("<b>" & fLang("strLangCla00500") & "</b>")
Response.Write " </font></td>" & vbNewLine & _
" <td " & ForumCellColor & " width=""50%"" vAlign=top>" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ " & ForumFontColor & ">"
if bolRecentBD then Response.Write("#149; " & strRecentBD) else Response.Write("<b>" & fLang("strLangCla00520") & "</b>")
Response.Write " </font></td>" & vbNewLine
end sub
sub DisplayBirthdays2(intRange,intAge)
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)>1 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 = fLang("strLangI_Birthdays00006") & ": "
strUpcomingBD = fLang("strLangI_Birthdays00010") & ": "
else
strRecentBD = fLang("strLangI_Birthdays00020") & ": "
strUpcomingBD = fLang("strLangI_Birthdays00030") & ": "
end if
strTodaysBD = fLang("strLangI_Birthdays00008") & ""
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")
'# Check if recent
if strDOB = strBDToday then
if bolTodaysBD = True then
strTodaysBD = strTodaysBD & " #149; "
end if
strTodaysBD = strTodaysBD & profileLink(strBDName,intBDID) & " ("
if intAge = 1 then
strTodaysBD = strTodaysBD & " <b>" & DisplayUsersAge(strBirthdate) & "</b> " & fLang("strLangI_Birthdays00040")& " "
end if
if strLangLCID=1040 then
strTodaysBD = strTodaysBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate), true) & ")"
else
strTodaysBD= strTodaysBD & monthName(Datepart("m",strBirthDate), true) & ". " & day(strBirthDate) & ")"
end if
bolTodaysBD = True
end if
if strDOB < strBDToday and strDOB >= strBDRecentDay then
if bolRecentBD = True then
strRecentBD = strRecentBD & " #149; "
end if
strRecentBD = strRecentBD & profileLink(strBDName,intBDID) & " ("
if intAge = 1 then
strRecentBD = strRecentBD & fLang("strLangI_Birthdays00112") & " <b>" & DisplayUsersAge(strBirthdate)+1 & "</b> " & fLang("strLangI_Birthdays00040")& " "
end if
if strLangLCID=1040 then
strRecentBD = strRecentBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate), true) & ")"
else
strRecentBD= strRecentBD & monthName(Datepart("m",strBirthDate), true) & ". " & day(strBirthDate) & ")"
end if
bolRecentBD = True
end if
if strDOB > strBDToday and strDOB <= strBDUpcomingDay then
if bolUpcomingBD = True then
strUpcomingBD = strUpcomingBD & " #149; "
end if
strUpcomingBD = strUpcomingBD & profileLink(strBDName,intBDID) & " ("
if intAge = 1 then
strUpcomingBD = strUpcomingBD & " <b>" & DisplayUsersAge(strBirthdate)+1 & "</b> " & fLang("strLangI_Birthdays00040")& " "
end if
if strLangLCID=1040 then
strUpcomingBD = strUpcomingBD & day(strBirthDate) & " " & monthName(Datepart("m",strBirthDate), true) & ")"
else
strUpcomingBD= strUpcomingBD & monthName(Datepart("m",strBirthDate), true) & ". " & day(strBirthDate) & ")"
end if
bolUpcomingBD = True
end if
Next
end if
intBDRowSpan = 1
if bolRecentBD then
intBDRowSpan = intBDRowSpan + 1
strRecentBD = strRecentBD & ""
end if
if bolTodaysBD then
strTodaysBD = strTodaysBD & ""
else
strTodaysBD = fLang("strLangI_Birthdays00009") & ""
end if
if bolUpcomingBD then
intBDRowSpan = intBDRowSpan + 1
strUpcomingBD = strUpcomingBD & ""
end if
if (NOT bolTodaysBD) and (NOT bolUpcomingBD) and (NOT bolRecentBD) then
Response.Write " <td colspan=""2"" " & ForumCellColor & " width=""100%"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ " & ForumFontColor & "><b>" & fLang("strLangI_Birthdays00050") & ".</b></font></td>" & vbNewLine
else
Response.Write " <td colspan=""2"" " & ForumCellColor & " width=""100%"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ " & ForumFontColor & ">" & strTodaysBD & "</font></td>" & vbNewLine
if bolUpcomingBD then
Response.Write " <tr><td colspan=""2"" " & ForumCellColor & " width=""100%"" vAlign=top>" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ " & ForumFontColor & ">" & strUpcomingBD & "</font></td></tr>" & vbNewLine
end if
if bolRecentBD then
Response.Write " <tr><td colspan=""2"" " & ForumCellColor & " width=""100%"" vAlign=top>" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ " & ForumFontColor & ">" & strRecentBD & "</font></td></tr>" & vbNewLine
end if
end if
end sub
%>
Posted - 05 December 2012 : 11:21:15
