events.asp

一个不错的ASP论坛源码

		dFirstDay = intThisMonth & "/1/" & intThisYear
		dLastDay 	= intThisMonth & "/" & intLastDay & "/" & intThisYear

			sSQL = 	"SELECT event_id, start_date, end_date, event_title, event_details, M_Name, Private FROM FORUM_EVENTS Inner JOIN Forum_Members ON FORUM_EVENTS.added_by = Forum_Members.Member_ID WHERE " & _
						"(Start_Date >='" & DateToStr(dFirstDay) & "' AND Start_Date <= '" & DateToStr(dLastDay) & "') " & _
						"OR " & _
						"(End_Date >='" & DateToStr(dFirstDay) & "' AND End_Date <= '" & DateToStr(dLastDay) & "') " & _
						"OR " & _
						"(Start_Date < '" & DateToStr(dFirstDay) & "' AND End_Date > '" & DateToStr(dLastDay) & "' )"  & _
						"ORDER BY Start_Date"
		'Response.Write sSQL
		'Open the RecordSet with a static cursor. This cursor provides bi-directional navigation
		'Rs.Open sSQL, my_Conn, adOpenStatic, adLockReadOnly, adCmdText
		dim rs
		set rs = server.CreateObject("adodb.recordset")
		
		rs.Open ssql, my_Conn
	%>
					<tr>
						<td valign="top">
	<table ALIGN="CENTER" BORDER="1" CELLSPACING="1" CELLPADDING="4" BGCOLOR="White" BORDERCOLOR="Gray">
	<tr><td>
		<table WIDTH="140" BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#FFFFFF">
			<tr HEIGHT="18" BGCOLOR="Silver">
				<td WIDTH="20" HEIGHT="18" ALIGN="LEFT" VALIGN="MIDDLE"><a HREF="<% =sScript%>?month=<% =IntPrevMonth %>&amp;year=<% =IntPrevYear %>"><img src="<%=strImageURL %>prev.gif" WIDTH="10" HEIGHT="18" BORDER="0" ALT="上一个月"></a></td>
				<td WIDTH="120" COLSPAN="5" ALIGN="CENTER" VALIGN="MIDDLE" CLASS="SOME"><% = strMonthName & " " & intThisYear %></td>
				<td WIDTH="20" HEIGHT="18" ALIGN="RIGHT" VALIGN="MIDDLE"><a HREF="<% =sScript %>?month=<% =IntNextMonth %>&amp;year=<% =IntNextYear %>"><img src="<%=strImageURL %>next.gif" WIDTH="10" HEIGHT="18" BORDER="0" ALT="下一个月"></a></td>
			</tr>
		  <tr>
				<td ALIGN="RIGHT" CLASS="SOME" WIDTH="20" HEIGHT="15" VALIGN="BOTTOM">S</td>
				<td ALIGN="RIGHT" CLASS="SOME" WIDTH="20" HEIGHT="15" VALIGN="BOTTOM">M</td>
				<td ALIGN="RIGHT" CLASS="SOME" WIDTH="20" HEIGHT="15" VALIGN="BOTTOM">T</td>
				<td ALIGN="RIGHT" CLASS="SOME" WIDTH="20" HEIGHT="15" VALIGN="BOTTOM">W</td>
				<td ALIGN="RIGHT" CLASS="SOME" WIDTH="20" HEIGHT="15" VALIGN="BOTTOM">T</td>
				<td ALIGN="RIGHT" CLASS="SOME" WIDTH="20" HEIGHT="15" VALIGN="BOTTOM">F</td>
				<td ALIGN="RIGHT" CLASS="SOME" WIDTH="20" HEIGHT="15" VALIGN="BOTTOM">S</td>
		  </tr>
		  <tr><td HEIGHT="1" ALIGN="MIDDLE" COLSPAN="7"><img src="<%=strImageURL %>line.gif" HEIGHT="1" WIDTH="140" BORDER="0"></td></tr>
		  <%
				' Initialize the end of rows flag to false
				EndRows = False
				Response.Write vbCrLf
				
				' Loop until all the rows are exhausted
			 	Do While EndRows = False
					' Start a table row
					Response.Write "	<TR>" & vbCrLf
					' This is the loop for the days in the week
					For intLoopDay = cSUN To cSAT
						' If the first day is not sunday then print the last days of previous month in grayed font
						If intFirstWeekDay > cSUN Then
							Write_TD LastMonthDate, "NON"
							LastMonthDate = LastMonthDate + 1
							intFirstWeekDay = intFirstWeekDay - 1
						' The month starts on a sunday	
						Else
							' If the dates for the month are exhausted, start printing next month's dates
							' in grayed font
							If intPrintDay > intLastDay Then
								Write_TD NextMonthDate, "NON"
								NextMonthDate = NextMonthDate + 1
								EndRows = True 
							Else
								' If last day of the month, flag the end of the row
								If intPrintDay = intLastDay Then
									EndRows = True
								End If
								
								dToday = CDate(intThisMonth & "/" & intPrintDay & "/" & intThisYear)  
								If NOT Rs.EOF Then
									' Set events flag to false. This means the day has no event in it
									bEvents = False
								  Do While NOT Rs.EOF AND bEvents = False
								  sEName = lcase(RS("M_NAME"))
										' If the date falls within the range of dates in the recordset, then 
										' the day has an event. Make the events flag True
								    If dToday >= strToDate(Rs("Start_Date")) AND dToday <= strToDAte(Rs("End_Date")) AND ((Rs("PRIVATE") <> 1)  OR ( Rs("PRIVATE") = 1 and sEName = lcase(strDBNTUserName) ) and strDBNTUSerName <> "") Then
											' Print the date in a highlighted font
									select case dtoday
									case date()
								      Write_TD "<A HREF=events.asp?date="& Server.URLEncode(dToday) & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='EVENT'> " & intPrintDay & "</A>", "Today"
									case cdate(ddate)
								      Write_TD "<A HREF=events.asp?date="& Server.URLEncode(dToday) & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='EVENT'> " & intPrintDay & "</A>", "Selected"
									case else
								      Write_TD "<A HREF=events.asp?date="& Server.URLEncode(dToday) & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='EVENT'> " & intPrintDay & "</A>", "HL"
									end select
											bEvents = True
										' If the Start date is greater than the date itself, there is no point
										' checking other records. Exit the loop	
								    ElseIf dToday < strToDate(Rs("Start_Date")) Then
											Exit Do
										' Move to the next record
										Else	
									    Rs.MoveNext
										End If
								  Loop
									' Checks for that day
									Rs.MoveFirst
								End If
								
								' If the event flag is not raise for that day, print it in a plain font
								If bEvents = False Then
									select case dtoday
									case date()
									Write_TD "<A HREF=events.asp?date="& Server.URLEncode(dToday) & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='NOEVENT'> " & intPrintDay & "</A>", "TODAY"
									case cdate(ddate)
									Write_TD "<A HREF=events.asp?date="& Server.URLEncode(dToday) & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='NOEVENT'> " & intPrintDay & "</A>", "Selected"
									case else
									Write_TD "<A HREF=events.asp?date="& Server.URLEncode(dToday) & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='NOEVENT'> " & intPrintDay & "</A>", "SOME"
									end select
								End If
							End If 
							
							' Increment the date. Done once in the loop.
							intPrintDay = intPrintDay + 1
						End If
					
					' Move to the next day in the week
					Next
					Response.Write "	</TR>" & vbCrLf
					
				Loop 
				Rs.Close
				set rs = nothing
			%>
		</table>
		</td></tr>
	</table>
						</td>
					</tr>
	<%
		' Get the next month and year
		'intThisMonth = intThisMonth + 1
		'If intThisMonth > 12 Then
		'	intThisMonth = 1
		'	intThisYear = intThisYear + 1
		'Else
		'	intThisYear = intThisYear
		'End If
		'next

end function

function emitEvents()

	if smode = "edit" then
			' Create a recordset and open the given event. If the Record is not found
			' set the mode to ADD
			sSQL = "SELECT start_date, end_date, event_title, event_details, PRIVATE FROM " & strTablePrefix & "EVENTS WHERE Event_ID = " & Request.QueryString("Event_ID")
			set rs = server.CreateObject("adodb.recordset")
			Rs.MaxRecords = 1
			Rs.Open sSQL, my_Conn
	
			If Not Rs.EOF Then
				sStart_Date = strToDate(Rs("Start_Date"))
				sEnd_Date = strToDate(Rs("End_Date"))
				sEvent_Title = Rs("Event_Title")
				sEvent_Details = Rs("Event_Details")
				iEvent_Private = RS("PRIVATE")
			end if
			Response.Write "编辑：" & sEvent_Title
%>
								</td>
							</tr>
							<tr>
								<td <% =strPopUpBorderColor %>>
<%
			if mlev >= 1 then
				Show_Form()
			else
				Response.Write "<font face=" & strDefaultFontFace & " size=" & strDefaultFontSize & " color=red>You need to be a member of " & strForumTitle & " in order to edit an event</font><br>"
				Response.Write "<font face=" & strDefaultFontFace & " size=" & strDefaultFontSize & " color=red>To become a member, <a href=policy.asp>register</a> here.</font>"
			end if
			rs.close
			set rs = nothing
			exit function
	end if

	if smode = "add" then

		Response.Write "新增一件事项" & sEvent_Title
%>
								</td>
							</tr>
							<tr>
								<td>
<%
		if mlev >= 1 then
			Show_Form()
		else
				Response.Write "<font face=" & strDefaultFontFace & " size=" & strDefaultFontSize & " color=red>You need to be a member of " & strForumTitle & " in order to edit an event</font><br>" 
				Response.Write "<font face=" & strDefaultFontFace & " size=" & strDefaultFontSize & " color=red>To become a member, <a href=policy.asp>register</a> here.</font>"
		end if
		exit function
	end if
		'if no date is set, select the events for the whole month, else select events for that day
		If IsEmpty(Request.QueryString("Date")) OR NOT IsDate(Request.QueryString("Date")) Then
			' These dates are used in the SQL

			strMonthName = MonthName(intThisMonth)
			intLastDay = GetLastDay(intThisMonth, intThisYear)
			dFirstDay = intThisMonth & "/1/" & intThisYear
			dLastDay 	= intThisMonth & "/" & intLastDay & "/" & intThisYear

			Response.Write "Events for " & strMonthName
			
			sSQL = 	"SELECT event_id, start_date, end_date, event_title, event_details, PRIVATE, M_Name FROM FORUM_EVENTS Inner JOIN Forum_Members ON FORUM_EVENTS.added_by = Forum_Members.Member_ID WHERE " & _
							"(Start_Date >='" & DateToStr(dFirstDay) & "' AND Start_Date <= '" & DateToStr(dLastDay) & "') " & _
							"OR " & _
							"(End_Date >='" & DateToStr(dFirstDay) & "' AND End_Date <= '" & DateToStr(dLastDay) & "') " & _
							"OR " & _
							"(Start_Date < '" & DateToStr(dFirstDay) & "' AND End_Date > '" & DateToStr(dLastDay) & "' )"  & _
							"ORDER BY Start_Date"
		Else
			
			Response.Write FormatDateTime(dDate, 1) & "的事项"
			
			sSQL = 	"SELECT event_id, start_date, end_date, event_title, event_details, M_Name,PRIVATE FROM FORUM_EVENTS Inner JOIN Forum_Members ON FORUM_EVENTS.added_by = Forum_Members.Member_ID " & _
					"WHERE Start_Date <= '" & DateToStr(dDate) & "' AND End_Date >= '" & DateToStr(dDate) & "' ORDER BY Event_ID "

		End If
%>

								</td>
							</tr>
							<tr>
								<td>
<%		if strCMessage <> "" then Response.Write "<font face=" & strDefaultFontFace & " size=" & strDefaultFontSize & ">" & strCMessage & "</font>"%>
<%		if sTitle <> "" then%>
									<% =sTitle %><br>

								</td>
							</tr>
							<tr>
								<td>
<%		end if

		' Open a record set of schedules
		'Response.Write ssql
		dim rs, strMessage
		Set Rs = Server.CreateObject("ADODB.RecordSet")
		'Response.Write ssql
		Rs.Open sSQL, my_Conn
		
		if rs.eof or rs.bof then
			rs.close
			sSQL = 	"SELECT event_id, start_date, end_date, event_title, event_details,PRIVATE FROM FORUM_EVENTS " & _
					"WHERE Start_Date <= '" & DateToStr(dDate) & "' AND End_Date >= '" & DateToStr(dDate) & "' ORDER BY Event_ID "
			Rs.Open sSQL, my_Conn
			MemberErased = true
		end if
		If NOT Rs.EOF Then

			Do While NOT Rs.EOF
			sEName = lcase(rs("M_NAME"))
		if (rs("PRIVATE") <> 1) or (rs("PRIVATE") = 1 and sEName = lcase(strDBNTUSerName)) and strDBNTUSerName <> "" then%>	
						<br>
						<table align="center" width="95%" cellpadding="0" cellspacing="0" border="0" bgcolor="gray">
							<tr>
								<td>
									<table WIDTH="100%" CELLSPACING="1" BORDER="0" CELLPADDING="3" align="center">
										<tr>
											<td align="left" bgcolor="<% =strHeadCellColor %>"><b><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor %>">
											<%Response.Write Trim(Rs("Event_Title"))
											strMessage = Rs("Event_Details")%>
											<%
											if not(memberErased) then
												Response.Write " - 加入者：" & RS("M_Name")
											else
												Response.Write " - 由已离开会员加入"
											end if
											%>											</font></b></td>
											<%If ((mlev >= 1) and (lcase(RS("M_Name")) = lcase(strDBNTUserName))) or mlev >=3 Then%>
											<%'If mlev > 2 or strDBNTUserName = RS("M_Name") Then%>
											<td align="center" BGCOLOR="<%= strCategoryCellColor%>" width="50">
												<a HREF="events.asp?mode=edit&Event_ID=<%= Rs("Event_ID")%>"><img src="<%=strImageURL %>icon_pencil.gif" BORDER="0" WIDTH="12" HEIGHT="12"></a>
												<a HREF="events.asp?mode=delete&Event_ID=<%=Rs("Event_ID")%>&date=<%= server.HTMLEncode(request.QueryString("date"))%>"><img src="<%=strImageURL %>icon_trashcan.gif" BORDER="0" WIDTH="12" HEIGHT="12"></a>
											</td>
											<%End If%>
										</tr>
										<tr>
											<td height="30" bgcolor="white" <%If mlev >=3 or lcase(strDBNTUserName) = lcase(RS("M_Name")) Then Response.Write "colspan=2"%>>
												<%
												' If the event lasts more than one day, indidate the start and end dates
												If Rs("Start_Date") <> Rs("End_Date") Then
													Response.Write "<FONT FACE='宋体, Arial' SIZE=1 COLOR='Gray'>开始於：" & strToDate(Rs("Start_Date")) & vbCrLf
													Response.Write "<BR>终止於：" & strToDate(Rs("End_Date")) & vbCrLf
													Response.Write "</FONT><P>"
												else
													Response.Write "<FONT FACE='宋体, Arial' SIZE=1 COLOR='Gray'>开始於：" & strToDate(Rs("Start_Date")) & vbCrLf
													Response.Write "</FONT><P>"