📄 events.asp
字号:
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="<% Response.Write strForumCellColor %>" <%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=''><B>开始于：</B>" & 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'><B>开始于：</B>" & strToDate(Rs("Start_Date")) & vbCrLf
Response.Write "</FONT><P>"
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" 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="<% Response.Write strForumCellColor %>" BORDERCOLOR="Gray">
<tr>
<td WIDTH="10%" HEIGHT="10" ALIGN="center" VALIGN="MIDDLE" bgcolor="<% =strForumCellColor %>"><a HREF="<% =sScript%>?month=<% =IntPrevMonth %>&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 %>&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
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -