events.asp

一个不错的ASP论坛源码

												End If
												'Response.Write Replace(Rs("Event_Details") & " ", vbCrLf, "<BR>")
												%>
												<font color="<% =strForumFontColor %>" face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>"><% =formatStr(rs("event_details")) %><a href="#top"><img src="<%=strImageURL %>icon_go_up.gif" height="15" width="15" border="0" align="right" alt="回到页首"></a></font></td>
											</td>
										</tr>
									</table>
								</td>
							</tr>
						</table>
			
			<br>
			<% end if
				Rs.MoveNext
			Loop
		else
			if Request.QueryString("date") = "" then
				Response.Write "<br><font face=" & strDefaultFontFace & " size=" & strDefaultFontSize & ">这个月没有任何事项。</font>"
			else
				Response.Write "<br><font face=" & strDefaultFontFace & " size=" & strDefaultFontSize & ">今天没有任何事项。</font>"
			end if
		End If

	rs.close
	set rs = nothing
end function

function emitupcomingevents
	dim rs
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	strSql = "SELECT start_date, event_title, M_Name,PRIVATE FROM FORUM_EVENTS Inner JOIN Forum_Members ON FORUM_EVENTS.added_by = Forum_Members.Member_ID WHERE start_date >= '" & DateToStr(date()) & "' and start_date < '" & DateToStr(DateAdd("d",30,date())) & "' Order by start_date, event_id ASC"
		
	rs.Open strSql, my_Conn
	do until rs.EOF
	sEName = lcase(rs("M_NAME"))
		if (rs("PRIVATE") <> 1) or (rs("PRIVATE") = 1 and sEName = lcase(strDBNTUSerName)) and strDBNTUSerName <> "" then
			Response.Write "<font face=" & strDefaultFontFace & " size=" & strDefaultFontSize & "><a href=events.asp?date=" & strToDate(rs("Start_Date")) & ">" & rs("Event_Title") & "</a></font><br>"
		end if
		rs.MoveNext
	loop
	rs.Close
	set rs = nothing
end function

function emitpastEvents
	dim rs
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	strSql = "SELECT start_date, event_title, M_Name,PRIVATE FROM FORUM_EVENTS Inner JOIN Forum_Members ON FORUM_EVENTS.added_by = Forum_Members.Member_ID WHERE start_date < '" & DateToStr(date()) & "' and start_date > '" & DateToStr(DateAdd("d",-30,date())) & "' Order by start_date desc"
		
	rs.Open strSql, my_Conn
	do until rs.EOF
	sEName = lcase(rs("M_NAME"))

		if (rs("PRIVATE") <> 1) or (rs("PRIVATE") = 1 and sEName = lcase(strDBNTUSerName)) and strDBNTUSerName <> "" then
			Response.Write "<font face=" & strDefaultFontFace & " size=" & strDefaultFontSize & "><a href=events.asp?date=" & strToDate(rs("Start_Date")) & ">" & rs("Event_Title") & "</a></font><br>"
		end if
		rs.MoveNext
	loop
	rs.Close
	set rs = nothing
end function

Function emitmonths2()

	'start with previous month
	'intthismonth =  intThisMonth - 1

	'show 3 months
	'for i = 0 to 2
		strMonthName = MonthName(intThisMonth)
		datFirstDay = DateSerial(intThisYear, intThisMonth, 1)
		intFirstWeekDay = WeekDay(datFirstDay, vbSunday)
		intLastDay = GetLastDay(intThisMonth, intThisYear)
		
		' Get the previous month and year
		intPrevMonth = intThisMonth - 1
		If intPrevMonth = 0 Then
			intPrevMonth = 12
			intPrevYear = intThisYear - 1
		Else
			intPrevYear = intThisYear	
		End If
		
		' Get the next month and year
		intNextMonth = intThisMonth + 1
		If intNextMonth > 12 Then
			intNextMonth = 1
			intNextYear = intThisYear + 1
		Else
			intNextYear = intThisYear
		End If

		' Get the last day of previous month. Using this, find the sunday of
		' last week of last month
'###################### Added below on 1/11/2001
		if Request.QueryString("month") = "" then
			intLastMonth = DatePart( "m", DateAdd( "m", -1, Date()))
		else
		   	if Request.QueryString("month") = 1 then
		   		intLastMonth = 12
			else
				intLastMonth = Request.QueryString("month") - 1
			end if
		end if	
		if Request.QueryString("year") = "" then
			intPrevYear = DatePart( "yyyy", DateAdd( "m", -1, Date()))
		else
			if Request.QueryString("month") = 1 then
		  		intPrevYear = Request.QueryString("year") - 1
			else
		  		intPrevYear = Request.QueryString("year")
			end if
		end if
'###################### Added above on 1/11/2001

		' Get the last day of previous month. Using this, find the sunday of
		' last week of last month
		LastMonthDate = GetLastDay(intLastMonth, intPrevYear) - intFirstWeekDay + 2
		NextMonthDate = 1

		' Initialize the print day to 1  
		intPrintDay = 1

		
		' These dates are used in the SQL
		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
	%>
	<table WIDTH="99%" ALIGN="CENTER" BORDER="1" CELLSPACING="1" CELLPADDING="4" BGCOLOR="White" BORDERCOLOR="Gray">
			<tr>
				<td WIDTH="10%" HEIGHT="10" ALIGN="center" VALIGN="MIDDLE" bgcolor="<% =strForumCellColor %>"><a HREF="<% =sScript%>?month=<% =IntPrevMonth %>&amp;year=<% =IntPrevYear %>"><img src="<%=strImageURL %>prev.gif" WIDTH="10" HEIGHT="18" BORDER="0" ALT="上一个月"></a></td>
				<td width="80%" colspan="5" align="center" valign="middle" bgcolor="<% =strCategoryCellColor %>"><b><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor %>">
					<% = strMonthName & " " & intThisYear %>
				</td>
				<td WIDTH="10%" HEIGHT="10" ALIGN="center" VALIGN="MIDDLE" bgcolor="<% =strForumCellColor %>"><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 HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">星期日</td>
				<td HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">星期一</td>
				<td HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">星期二</td>
				<td HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">星期三</td>
				<td HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">星期四</td>
				<td HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">星期五</td>
				<td HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">星期六</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_TD3 LastMonthDate, "NON2"
							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_TD3 NextMonthDate, "NON2"
								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
										' 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"))  then 
									  if dtoday = date() then
											' Print the date in a highlighted font
										Write_TD2 "<A HREF=events.asp?date="& Server.URLEncode(dToday) & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='EVENT'> " & intPrintDay & "</A>", "TODAY", dToday
									  else
											' Print the date in a highlighted font
										Write_TD2 "<A HREF=events.asp?date="& Server.URLEncode(dToday) & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='EVENT'> " & intPrintDay & "</A>", "HL", dToday
								      end if
											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
									if dtoday = date() then
									Write_TD3 "<A HREF=events.asp?date="& Server.URLEncode(dToday) & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='NOEVENT'> " & intPrintDay & "</A>", "TODAY"
									else
									Write_TD3 "<A HREF=events.asp?date="& Server.URLEncode(dToday) & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='NOEVENT'> " & intPrintDay & "</A>", "SOME"
									end if
								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>
	<tr>
		<td>
	<%
		' 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

	'-------------------------------------------------------------------------
	' This routine prints the individual table divisions for days of the month
	'-------------------------------------------------------------------------
	Sub Write_TD2(sValue, sClass, dDate)
		dim rsEvents, sETitle
		set rsevents = server.CreateObject("adodb.recordset")
		Response.Write "		<TD HEIGHT='80' WIDTH='14%' ALIGN='left' VALIGN='top' CLASS='" & sClass & "'> " & sValue 
			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 "
		
		'response.write sSQL
		rsEvents.Open sSQL, my_Conn
		do while not(rsevents.EOF)
			sETitle = rsEvents("event_title")
			sEName = lcase(rsEvents("M_NAME"))
			if len(sETitle) > 14 then
				sETitle = mid(sETitle,1,15) 
			end if
			if (rsEvents("PRIVATE") <> 1) or (rsEvents("PRIVATE") = 1 and sEName = lcase(strDBNTUSerName)) and strDBNTUSerName <> "" then
				Response.Write "<br><A HREF=events.asp?date="& Server.URLEncode(dToday) & ">" & sETitle & "</a>"
			end if
			rsEvents.MoveNext
		loop
		Response.Write "</TD>" & vbCrLf
		rsEvents.Close
		set rsevents = nothing
	End Sub

%>