⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 calendar_week.asp

📁 简单的asp论坛源码系统,很适用于初学者!界面简洁,功能齐全
💻 ASP
📖 第 1 页 / 共 2 页
字号:
<% @ 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 & "&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 & "/* *******************************************************" & _

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -