📄 calendar_week.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 intWeek 'Holds the week to view
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 dtmNow 'Holds the present date according to any server off-set
Dim intMonthSmCalendar 'Holds the month for the small calendars
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 intAge 'Holds the age for birthdays
Dim blnShowBirthdays 'Holds if birthdays are hidden or not
'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") = "2" Then
Response.Redirect("calendar_year.asp?Y=" & Request.QueryString("Y") & strQsSID3)
End If
'Intilise variables
blnShowBirthdays = CBool(showBirthdays())
dtmNow = getNowDate()
intDay = 1
intView = 2
'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
'Read in the week to view
If Cint(Request.QueryString("W")) => 1 AND CInt(Request.QueryString("W")) =< 6 Then
intWeek = CInt(Request.QueryString("W"))
'Else use this month as the month to view
Else
intWeek = 1
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")
'Initilise the month variable for the small calendars
intMonthSmCalendar = intMonth
'Calulate the start date for the week
Select Case intWeek
Case 2
intDay = 8 - (intFistDayOfMonth - 1)
Case 3
intDay = 15 - (intFistDayOfMonth - 1)
Case 4
intDay = 22 - (intFistDayOfMonth - 1)
Case 5
intDay = 29 - (intFistDayOfMonth - 1)
Case 6
intDay = 36 - (intFistDayOfMonth - 1)
End Select
'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, intWeek)
'SQL Query Array Look Up table
'0 = Author_ID
'1 = Username
'2 = DOB
'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_week.asp?Y=" & intYear & "&M=" & intMonth & "&W=" & intWeek, 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 & " <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 & "/* *******************************************************" & _
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -