calendar.asp

简单的asp论坛源码系统,很适用于初学者!界面简洁,功能齐全

<% @ Language=VBScript %>
<% Option Explicit %>
<!--#include file="common.asp" -->
<!--#include file="language_files/calendar_language_file_inc.asp" -->
<!--#include file="functions/functions_date_time_format.asp" -->
<!--#include file="functions/functions_calendar.asp" -->
<%
'****************************************************************************************
'**  Copyright Notice    
'**
'**  Web Wiz Forums(TM)
'**  http://www.webwizforums.com
'**                            
'**  Copyright (C)2001-2008 Web Wiz(TM). All Rights Reserved.
'**  
'**  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS UNDER LICENSE FROM 'WEB WIZ'.
'**  
'**  IF YOU DO NOT AGREE TO THE LICENSE AGREEMENT THEN 'WEB WIZ' IS UNWILLING TO LICENSE 
'**  THE SOFTWARE TO YOU, AND YOU SHOULD DESTROY ALL COPIES YOU HOLD OF 'WEB WIZ' SOFTWARE
'**  AND DERIVATIVE WORKS IMMEDIATELY.
'**  
'**  If you have not received a copy of the license with this work then a copy of the latest
'**  license contract can be found at:-
'**
'**  http://www.webwizguide.com/license
'**
'**  For more information about this software and for licensing information please contact
'**  'Web Wiz' at the address and website below:-
'**
'**  Web Wiz, Unit 10E, Dawkins Road Industrial Estate, Poole, Dorset, BH15 4JD, England
'**  http://www.webwizguide.com
'**
'**  Removal or modification of this copyright notice will violate the license contract.
'**
'****************************************************************************************



'*************************** SOFTWARE AND CODE MODIFICATIONS **************************** 
'**
'** MODIFICATION OF THE FREE EDITIONS OF THIS SOFTWARE IS A VIOLATION OF THE LICENSE  
'** AGREEMENT AND IS STRICTLY PROHIBITED
'**
'** If you wish to modify any part of this software a license must be purchased
'**
'****************************************************************************************



'Set the response buffer to true as we maybe redirecting
Response.Buffer = True



'Make sure this page is not cached
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 2
Response.AddHeader "pragma","no-cache"
Response.AddHeader "cache-control","private"
Response.CacheControl = "No-Store"


'Dimension variables
Dim sarryEvents		'Holds the event recordset in an array
Dim saryBirthdays	'Holds the birthdays recordset in an array
Dim strSubject		'Holds the event subject
Dim strMessage		'Holds the event message
Dim strMonth		'Holds the month name
Dim intMonth		'Holds the integer value for the month
Dim intYear		'Holds the year
Dim intFistDayOfMonth	'Holds the first day of the month as an interger
Dim intWeekLoop		'Week Loop counter
Dim intDayLoopCounter	'Day loop counter
Dim intDay		'Holds the day
Dim intMaxNoMonthDays	'Holds total number of days for the month
Dim dtmNow		'Holds the present date according to any server off-set
Dim intView		'Holds the type of view (1=monh, 2=week, 3=year)
Dim dtmDbStartDate	'Holds the database search start date
Dim dtmDbEndDate	'Holds the database search end date
Dim intDbArrayLoop	'Database array loop counter
Dim intNoOfBirthdays	'Holds the number of birthdays
Dim intAge		'Holds the age for birthdays
Dim strMemBirthdays	'Holds the members birthdays
Dim strUserName		'Holds the username of the member with a birthday
Dim lngUserProfile	'Holds the user profile number
Dim blnShowBirthdays	'Holds if birthdays are hidden or not
Dim strPageRedirect	'Holds the page redirect details



'If the calendar system is disabled send the user away
If blnCalendar = False OR blnACode Then 
	
	'Clean up
	Call closeDatabase()
	
	'Send to default page
	Response.Redirect("default.asp" & strQsSID1)
End If




'If this is a year view redirect to the year calendar view page
If Request.QueryString("V") = "3" Then
	strPageRedirect = "calendar_year.asp?Y=" & Request.QueryString("Y")
	If Request.QueryString("DB") <> "" Then strPageRedirect = strPageRedirect & "&DB=" & Request.QueryString("DB")
	Response.Redirect(strPageRedirect & strQsSID3)
'Else if week view
ElseIf Request.QueryString("V") = "2" Then
	strPageRedirect = "calendar_week.asp?M=" & Request.QueryString("M") & "&Y=" & Request.QueryString("Y")
	If Request.QueryString("DB") <> "" Then strPageRedirect = strPageRedirect & "&DB=" & Request.QueryString("DB")
	Response.Redirect(strPageRedirect & strQsSID3)
End If


'Intilise variables
dtmNow = getNowDate()
blnShowBirthdays = CBool(showBirthdays())
intDay = 0


'Read in the year to view
If Cint(Request.QueryString("Y")) => 1900 AND  Cint(Request.QueryString("Y")) =< Cint(Year(dtmNow)+20) Then
	intYear = CInt(Request.QueryString("Y"))
'Else use this year as the month to view
Else
	intYear = Year(dtmNow)
End If


'Read in the month to view
If Cint(Request.QueryString("M")) => 1 AND  CInt(Request.QueryString("M")) =< 12 Then
	intMonth = CInt(Request.QueryString("M"))
'Else use this month as the month to view
Else
	intMonth = Month(dtmNow)
End If


'Get the first day of the month (use internation ISO date fomat (yyyy-mm-dd) for server compatibility)
intFistDayOfMonth = WeekDay(intYear & "-" & intMonth & "-01")

'Get the number of days in the month
intMaxNoMonthDays = getMonthDayNo(intMonth, intYear)

'Get the month in name format
strMonth = getMonthName(intMonth)








'Calculate the db serach start date
If intMonth = 1 Then
	dtmDbStartDate = internationalDateTime(intYear-1 & "-12-1")
Else
	dtmDbStartDate = internationalDateTime(intYear & "-" & intMonth-1 & "-1")
End If

'Calculate the db serach end date
If intMonth = 12 Then
	dtmDbEndDate = internationalDateTime(intYear+1 & "-01-" & getMonthDayNo(1, intYear+1))
Else
	dtmDbEndDate = internationalDateTime(intYear & "-" & intMonth+1 & "-" & getMonthDayNo(intMonth+1, intYear))
End If

'SQL Server doesn't like ISO dates with '-' in them, so remove the '-' part
If strDatabaseType = "SQLServer" Then
	dtmDbStartDate = Replace(dtmDbStartDate, "-", "", 1, -1, 1)
	dtmDbEndDate = Replace(dtmDbEndDate, "-", "", 1, -1, 1)
End If

'Place the date in SQL safe # or '
If strDatabaseType = "Access" Then
	dtmDbStartDate = "#" & dtmDbStartDate & "#"
	dtmDbEndDate = "#" & dtmDbEndDate & "#"
Else
	dtmDbStartDate = "'" & dtmDbStartDate & "'"
	dtmDbEndDate = "'" & dtmDbEndDate & "'"
End If





'Call the sub procedure to get the events from the database
Call getEvents()
		
'SQL Query Array Look Up table
'0 = Topic_ID
'1 = Subject
'2 = Hide
'3 = Event_date
'4 = Message



'Call sub to get birthdays from the database
If blnDisplayBirthdays AND blnShowBirthdays Then Call getBirthdays(intMonth, 0)

'SQL Query Array Look Up table
'0 = Author_ID
'1 = Username
'2 = DOB


Dim intTotalRecordsPages
intTotalRecordsPages = 12
Dim intRecordPositionPageNum
Dim intPageLinkLoopCounter



'Clean up
Call closeDatabase()


'If active users is enabled update the active users application array
If blnActiveUsers Then
	'Call active users function
	saryActiveUsers = activeUsers(strTxtViewing & " " & strTxtCalendar, strMonth & " " & intYear, "calendar.asp?Y=" & intYear & "&M=" & intMonth, 0)
End If


'Set bread crumb trail
strBreadCrumbTrail = strBreadCrumbTrail & strNavSpacer & "<a href=""calendar.asp" & strQsSID1 & """>" & strTxtCalendar & "</a>" & strNavSpacer & strMonth & " " & intYear

'Status bar tools
strStatusBarTools = strStatusBarTools & "&nbsp;<a href=""RSS_calendar_feed.asp" & strQsSID1 & """ target=""_blank""><img src=""" & strImagePath & "rss." & strForumImageType & """ border=""0"" alt=""" & strTxtRSS & ": " & strTxtLatestEventFeed & """ title=""" & strTxtRSS & ": " & strTxtLatestEventFeed & """ /></a>"

%>
<!-- #include file="includes/browser_page_encoding_inc.asp" -->
<meta name="generator" content="Web Wiz Forums" />
<title><% = strMainForumName & " " & strTxtCalendar & ": " & strMonth & " " & intYear %></title>

<%
'***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ******
Response.Write("<!--//" & _
vbCrLf & "/* *******************************************************" & _
vbCrLf & "Software: Web Wiz Forums(TM) ver. " & strVersion & "" & _
vbCrLf & "Info: http://www.webwizforums.com" & _
vbCrLf & "Copyright: (C)2001-2008 Web Wiz(TM). All rights reserved" & _
vbCrLf & "******************************************************* */" & _
vbCrLf & "//-->" & vbCrLf)
'***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ******

'If RSS feed is enabled then have an alt link to it for browers that support RSS Feeds
If blnRSS Then Response.Write(vbCrLf & "<link rel=""alternate"" type=""application/rss+xml"" title=""RSS 2.0"" href=""RSS_calendar_feed.asp" & strQsSID1 & """ />")
%>
<link href="<% = strCSSfile %>default_style.css" rel="stylesheet" type="text/css" />
<!-- #include file="includes/header.asp" -->
<!-- #include file="includes/status_bar_header_inc.asp" -->
<table class="basicTable" cellspacing="0" cellpadding="3" align="center">
 <tr>
  <td align="left"><h1><% = strTxtCalendar & ": " & strMonth & " " & intYear %></h1></td>
 </tr>
</table>
<table class="basicTable" cellspacing="0" cellpadding="3" align="center">
 <tr>
  <td nowrap><!--#include file="includes/calendar_jump_inc.asp" --></td>
  <td align="right" nowrap><a href="calendar.asp?<% 
   
   	'Calculate if we need to chnage years
   	If intMonth = 1 Then 
		Response.Write("M=12&Y=" & intYear-1) 
	Else 
		Response.Write("M=" & intMonth-1 & "&Y=" & intYear) 
	End If
	
	%><% = strQsSID2 %>">&lt;&lt; <% = strTxtPrevious %></a>&nbsp;
   <select onchange="linkURL(this)" name="calSelect" id="calSelect"><%
    
    	Dim intJumpLoop
    	
    
    	'Setup list options
    	For intJumpLoop = 1 TO 12
    	
    		Response.Write(vbCrLf & "     <option value=""calendar.asp?M=" & intJumpLoop & "&Y=" & intYear & strQsSID2&"""")