events.asp

一个不错的ASP论坛源码

				<tr>
					<td>
					<% call emitpastEvents %>
					<br>
					<br>
					</td>
				</tr>
			</table>
		</td>
		<td bgcolor="<% =strForumCellColor %>" valign="top" width=100%>
			<table border="0" cellpadding="0" cellspacing="0" width="100%" height="100%">
				<tr>
					<td valign=top>
						<%if smode = "" then
							emitmonths2 
						else%>
									
						<table bgcolor="<% =strForumCellColor %>" border="0" cellpadding="2" cellspacing="0" width="100%">
							<tr>
								<td align="center" bgcolor="<% =strHeadCellColor %>" nowrap><b><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor %>">
								<% call emitEvents()%>
								</font></b></td>
							</tr>
							<tr>
								<td>
								<font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>"><a href=events.asp>回到月历首页</a></font>
								</td>
							</tr>
						</table>
						<%end if%>		
					</td>
				</tr>
			</table>
		</td>
	</tr>
</table>
<!--#INCLUDE FILE="inc_footer.asp" -->
<%
	'------------------------------------------------------------
	' This function finds the last date of the given month
	'------------------------------------------------------------
	Function GetLastDay(intMonthNum, intYearNum)
		Dim dNextStart
		If CInt(intMonthNum) = 12 Then
			dNextStart = CDate( "1/1/" & intYearNum)
		Else
			dNextStart = CDate(intMonthNum + 1 & "/1/" & intYearNum)
		End If
		GetLastDay = Day(dNextStart - 1)
	End Function
	
	'-------------------------------------------------------------------------
	' This routine prints the individual table divisions for days of the month
	'-------------------------------------------------------------------------
	Sub Write_TD(sValue, sClass)
		Response.Write "		<TD ALIGN='RIGHT' WIDTH=20 HEIGHT=15 VALIGN='BOTTOM' CLASS='" & sClass & "'> " & sValue & "</TD>" & vbCrLf
	End Sub

	Sub Write_TD3(sValue, sClass)
		Response.Write "		<TD HEIGHT='80' WIDTH='14%' ALIGN='left' VALIGN='top' CLASS='" & sClass & "'> <font face=" & strDefaultFontFace & " size=" & strDefaultFontSize  & ">" & sValue & "</font></TD>" & vbCrLf
	End Sub

' This routines presents the form to the user. Depending on the mode, the
' form fields are filled with data or blank.
Sub Show_Form()
	Dim sButtonMsg
	If sMode = "edit" Then
		sButtonMsg = "更新事项"
	Else
		sButtonMsg = "新增事项"
	End If
	
	' Set the title of the page depending on if an error occurred during
	' form submission or not
	If bError = True Then
		sTitle = "送出资料有误"
	Else
		sTitle = "新增或修改事项"
	End If
%>
	 

<table border="0" cellspacing="0" cellpadding="0" align="center">
  <tr>
    <td bgcolor="<% =strPopUpBorderColor %>">

	<table border="0" cellspacing="1" cellpadding="4">
	<form NAME="eventfrm" ACTION="<% =sScript %>" METHOD="POST">

		<tr>
			<td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="right" WIDTH="25%"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">开始日期：</font></td>
			<td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="LEFT" WIDTH="75%" ><input TYPE="TEXT" SIZE="12" MAXLENGTH="12" NAME="START_DATE" VALUE="<%if Server.HTMLEncode(sStart_Date) <> "" then Response.write Server.HTMLEncode(sStart_Date) else Response.Write(Request.QueryString("date")) end if%>">
			<input type="Checkbox" name="isPrivateEvent" value="1" <% if intPrivateEvent = 1 then response.write "checked" %>>私人事项</td>
		</tr>

		<tr>
			<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 %>" >&nbsp;</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