📄 events.asp
字号:
<td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="RIGHT" WIDTH="30%"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">结束日期：</font></td>
<td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="LEFT" WIDTH="70%"><input TYPE="TEXT" SIZE="12" MAXLENGTH="12" NAME="END_DATE" VALUE="<%if Server.HTMLEncode(sEnd_Date) <> "" then Response.write Server.HTMLEncode(sEnd_Date) else Response.Write(Request.QueryString("date")) end if%>"></td>
</tr>
<tr>
<td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="RIGHT"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">事项名称：</font></td>
<td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="LEFT"><input TYPE="TEXT" SIZE="30" MAXLENGTH="100" NAME="EVENT_TITLE" VALUE="<% =Server.HTMLEncode(sEvent_Title) %>"></td>
</tr>
<tr>
<td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="RIGHT"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">事项内容：</font></td>
<td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="LEFT"><textarea COLS="33" ROWS="15" NAME="EVENT_DETAILS" WRAP="PHYSICAL"><% =Server.HTMLEncode(sEvent_Details) %></textarea></td>
</tr>
<tr>
<td bgColor="<% =strPopUpTableColor %>" > </td>
<td bgColor="<% =strPopUpTableColor %>" >
<input TYPE="HIDDEN" NAME="event" VALUE="<%if sMode = "add" then Response.Write "ADD" else Response.write sMode %>">
<input TYPE="HIDDEN" NAME="event_id" VALUE="<% =Request.QueryString("EVENT_ID") %>">
<input TYPE="SUBMIT" VALUE="<% =sButtonMsg %>" id="SUBMIT1" name="SUBMIT1">
</td>
</tr>
</form>
</table>
</td>
</tr>
</table>
<%
End Sub
Sub Update_Event(sUpdateMode)
'Dim sErrImage, Rs, sSQL, sTitle, enddate, imgStart_date, imgEnd_date, imgEvent_Title, imgEvent_details
dim enddate, memberid
bError = False
' Get the form data into variables
sStart_Date = Request.Form("START_DATE")
sEnd_Date = Request.Form("END_DATE")
sEvent_Title = Request.Form("EVENT_TITLE")
sEvent_Details = Request.Form("EVENT_DETAILS")
' The error checking routines start here. If any of the fields fails
' error check, the bError flag is raised, and the corresponding image
' string is set to the image source
' Check to see if Start date is a valid date
If NOT IsDate(sStart_Date) Then
bError = True
'imgStart_Date = sErrImage
End If
' Check if the End date is a valid date provided it is not empty
If Trim(sEnd_Date) <> "" AND NOT IsDate(sEnd_Date) Then
bError = True
'imgEnd_Date = sErrImage
End If
' Check if the event title field is blank
If Trim(sEvent_Title) = "" Then
bError = True
'imgEvent_Title = sErrImage
End If
' Check if the event details field is blank
If Trim(sEvent_Details) = "" Then
bError = True
'imgEvent_Details = sErrImage
End If
' Check if the start date and end date correspond to a valid range
' so that Start date is always prior to the end date
If IsDate(sStart_Date) AND IsDate(sEnd_Date) Then
If CDate(sStart_Date) > CDate(sEnd_Date) Then
bError = True
'imgStart_Date = sErrImage
'imgEnd_Date = sErrImage
End If
End If
If bError = False Then
' If the end date is blank, it equals start date
If Trim(sEnd_Date) <> "" Then
enddate = CDate(Request.Form("END_DATE"))
Else
enddate = CDate(Request.Form("START_DATE"))
End If
sSql = "Select Member_ID from " & strMemberTablePrefix & "Members where " & strDBNTSQLName & " = '" & strDBNTUserName & "'"
dim rs
set rs = server.CreateObject("adodb.recordset")
rs.Open sSql, my_Conn
memberid = rs("Member_ID")
rs.close
set rs = nothing
' Depending on the Mode, open the Recordset in eith Add or Edit mode
if Request.Form("isPrivateEvent") <> "1" then
intPrivateEvent = 0
else
isPrivateEvent = 1
end if
If sUpdateMode = "edit" Then
sSQL = "UPDATE " & strTablePrefix & "EVENTS SET Start_Date = '" & DateToStr(Request.Form("START_DATE")) & "', End_Date = '" & DateToStr(enddate) & "', Event_Title = '" & chkstring(Request.Form("EVENT_TITLE"), "message") & "', Event_Details = '" & chkstring(Request.Form("EVENT_Details"), "message") & "',PRIVATE = " & intPrivateEvent & ", date_added = '" & DateToStr(now()) & "' WHERE Event_ID=" & Request.Form("Event_ID")
my_Conn.Execute sSQL
Else
sSQL = "INSERT INTO " & strTablePrefix & "EVENTS (Start_Date, End_Date, Event_Title, Event_Details, Date_Added, Added_by,PRIVATE) Values ('" & DateToStr(Request.Form("START_DATE")) & "', '" & DateToStr(enddate) & "',' " & chkstring(Request.Form("EVENT_TITLE"), "message") & "', '" & chkstring(Request.Form("EVENT_Details"), "message") & "', '" & DateToStr(now()) & "', '" & memberid & "'," & intPrivateEvent & ")"
my_Conn.Execute sSQL
End If
If sUpdateMode = "ADD" Then
sTitle = "事项已加入<br>感谢你的使用！"
Else
sTitle = "事项已更新<br>感谢你的使用！"
End If
Else
If sUpdateMode = "ADD" Then
sTitle = "<font color=red>发生问题</font><br>"
sTitle = sTitle & "事项并未加入<br>请重试一遍！"
Else
sTitle = "<font color=red>发生问题</font><br>"
sTitle = sTitle & "事项并未修改<br>请重试一遍！"
End If
End If
End Sub
function fixQuote(fstring)
fString = Replace(fString, "'", "''")
fixquote = fstring
end function
Function emitmonths()
'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
%>
<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 %>&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 %>&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>"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -