Problemas com eventos asp

hully · Março 28, 2008

Pessoal, o formato da data que aparece é assim: mm/dd/aaaa, preciso que apareça assim dd/mm/aaaa segue o código me ajudem:

<%

Function GetLastDay(intMonthNum, intYearNum)

Dim dNextStart

If CInt(intMonthNum) = 12 Then

dNextStart = CDate( "01/01/" & intYearNum)

Else

dNextStart = CDate(intMonthNum + 1 & "/01/" & intYearNum)

End If

GetLastDay = Day(dNextStart - 1)

End Function

Sub Write_TD(sValue, sClass)

Response.Write " <TD ALIGN='CENTER' WIDTH=20 HEIGHT=15 VALIGN='BOTTOM' CLASS='" & sClass & "'> " & sValue & "</TD>" & vbCrLf

End Sub

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, PRIVATE, PENDING, " & strDBNTSQLName & ", event_details FROM " & strTAblePrefix & "EVENTS Inner JOIN " & strMemberTablePrefix & "Members ON " & strTablePrefix & "EVENTS.added_by = " & strMemberTablePrefix & "Members.Member_ID " & _

"WHERE PENDING = 0 and Start_Date <= '" & DateToStr(dDate) & "' AND End_date >= '" & DateToStr(dDate) & "' ORDER BY Event_ID "

'Response.Write sSql

rsEvents.Open sSQL, my_Conn

'Response.Write rsEvents("event_title")

do while not(rsevents.EOF)

sETitle = chkString(trim(rsEvents("event_title")), "display")

if len(sETitle) > 17 then

sETitle = mid(sETitle,1,18) & "..."

end if

if (rsEvents("PRIVATE") <> 1) or (rsEvents("PRIVATE") = 1 and lcase(rsEvents(strDBNTSQLNAME)) = lcase(strDBNTUSerName)) and rsEvents("PENDING") = 0 then

Response.Write "<br><a href=""java script:openWindow3('pop_event.asp?event_id=" & rsEvents("event_id") & "')""><font face=" & strDefaultFontFace & " size=" & strFooterFontSize & ">" & sETitle & "</font></a>"

end if

rsEvents.MoveNext

loop

Response.Write "</TD>" & vbCrLf

rsEvents.Close

set rsevents = nothing

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 = "Atualizar Evento"

Else

sButtonMsg = "Adicionar Evento"

End If

' Set the title of the page depending on if an error occurred during

' form submission or not

If bError = True Then

sTitle = "Error in form submission"

Else

sTitle = "Adicionar/Atualizar um Evento"

End If

mwpThemeSmallBlock_open()%>

<td bgColor="<% =strPopUpTableColor %>" ALIGN="right"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>"><b>Tamanho </b></font></td>

</select></font></td></form></tr>

<form name="PostTopic" ACTION="<% =sScript %>" METHOD="POST">

<tr><td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="right" WIDTH="25%"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>"><b>Data Inicial </b></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(myDate) end if%>">

<input type="Checkbox" name="isPrivateEvent" value="1" <% if intPrivateEvent = 1 then response.write "checked" %>><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>"><b>Evento Particular</b></font></td></tr>

<tr><td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="right" ><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>"><b>Data Final </b></font></td>

<td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="LEFT" ><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(myDate) end if%>"></td></tr>

<tr><td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="right"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>"><b>Título do Evento </b></font></td>

<td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="LEFT"><input TYPE="TEXT" SIZE="30" MAXLENGTH="50" NAME="EVENT_TITLE" VALUE="<% =Server.HTMLEncode(sEvent_Title) %>" tabindex="1"></td></tr>

<tr><td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" colspan="2"></td></tr>

<option value="1">Ajuda </option>

<option selected value="0">Prompt </option>

<option value="2">Basico </option>

</select></font></td>

</tr></table></td></tr>

<tr><td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="right"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>"><b>Detalhes do Evento </b></font></td>

<td bgColor="<% =strPopUpTableColor %>" VALIGN="TOP" ALIGN="LEFT"><textarea COLS="45" ROWS="6" name="Message" WRAP="PHYSICAL" onfocus="getActiveText(this)" onclick="getActiveText(this)" onchange="getActiveText(this)" onkeyup="getActiveText(this)" onselect="getActiveText(this)" tabindex="2"><% =Trim(CleanCode(sEvent_Details)) %></textarea></td></tr>

<font FACE="Verdana" SIZE="2"><input TYPE="SUBMIT" VALUE="<% =sButtonMsg %>" id="SUBMIT1" name="SUBMIT1" tabindex="3"></font>

</td></tr></form><%mwpThemeSmallBlock_close()%>

<%

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("Message")

' 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

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 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") & "',PRIVATE = " & intPrivateEvent

if mLev >= 3 or intPrivateEvent = 1 then

sSQL = sSQL & ", PENDING = 0"

else

sSQL = sSQL & ", PENDING = 2"

end if

sSQL = sSQL & ", Event_Details = '" & chkstring(Request.Form("Message"), "message") & "', date_added = '" & DateToStr(strForumTimeAdjust) & "' WHERE PENDING = 0 and Event_ID=" & chkstring(request.form("EVENT_ID"), "sqlstring")

my_Conn.Execute sSQL

Else

sSQL = "INSERT INTO " & strTablePrefix & "EVENTS (Start_Date, End_Date, Event_Title, Event_Details, Date_Added, Added_by, PRIVATE, PENDING) Values ('" & DateToStr(Request.Form("START_DATE")) & "', '" & DateToStr(enddate) & "',' " & chkstring(Request.Form("EVENT_TITLE"), "message") & "', '" & chkstring(Request.Form("Message"), "message") & "', '" & DateToStr(strForumTimeAdjust) & "', " & memberid & "," & intPrivateEvent

if mLev >= 3 or intPrivateEvent = 1 then

sSQL = sSQL & ",0" & ")"

else

sSQL = sSQL & ",1" & ")"

end if

my_Conn.Execute sSQL

End If

if not mLev >= 3 and not intPrivateEvent = 1 then

If sUpdateMode = "ADD" Then

sTitle = "Event has been accepted for review.<br>Please wait 1-3 days for your event to be reviewed and added."

Else

sTitle = "Event has been accepted for review.<br>Please wait 1-3 days for your event to be reviewed and added."

End If

end if

Else

If sUpdateMode = "ADD" Then

sTitle = "<font color=red>There was a problem.</font><br>"

sTitle = sTitle & "Event was not added.<br>Try Again!"

Else

sTitle = "<font color=red>There was a problem.</font><br>"

sTitle = sTitle & "Event was not editted.<br>Try Again!"

End If

End Sub

Function DisplayMonth_small()

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

if Request.QueryString("month") = "" then

intLastMonth = DatePart( "m", DateAdd( "m", -1, strForumDateAdjust))

else

if Request.QueryString("month") = 1 then

intLastMonth = 12

else

intLastMonth = Request.QueryString("month") - 1

end if

if Request.QueryString("year") = "" then

intPrevYear = DatePart( "yyyy", DateAdd( "m", -1, strForumDateAdjust))

else

if Request.QueryString("month") = 1 then

intPrevYear = Request.QueryString("year") - 1

else

intPrevYear = Request.QueryString("year")

end if

LastMonthDate = GetLastDay(intLastMonth, intPrevYear) - intFirstWeekDay + 2

NextMonthDate = 1

' Initialize the print day to 1

intPrintDay = 1

' These dates are used in the SQL

dFirstDay = DateToStr(intThisMonth & "/01/" & intThisYear)

dLastDay = DateToStr(intThisMonth & "/" & intLastDay & "/" & intThisYear)

sSQL = "SELECT event_id, start_date, end_date, event_title, PRIVATE, PENDING, " & strDBNTSQLName & ", event_details FROM " & strTablePrefix & "EVENTS Inner JOIN " & strMemberTablePrefix & "Members ON " & strTablePrefix & "EVENTS.added_by = " & strMemberTablePrefix & "Members.Member_ID WHERE " & _

"(Start_Date >='" & dFirstDay & "' AND Start_Date <= '" & dLastDay & "') " & _

"OR " & _

"(End_Date >='" & dFirstDay & "' AND End_Date <= '" & dLastDay & "') " & _

"OR " & _

"(Start_Date < '" & dFirstDay & "' AND End_Date > '" & dLastDay & "' )" & _

"ORDER BY Start_Date"

dim rs

set rs = server.CreateObject("adodb.recordset")

rs.Open ssql, my_Conn

%>

<table ALIGN="CENTER" BORDER="1" CELLSPACING="0" CELLPADDING="2" style="border-collapse: collapse" BGCOLOR="<% =strForumCellColor %>" BORDERCOLOR="<% =strTableBorderColor %>">

<td WIDTH="20" HEIGHT="18" ALIGN="LEFT" VALIGN="MIDDLE"><a HREF="<% =sScript%>?month=<% =IntPrevMonth %>&year=<% =IntPrevYear %>"><img SRC="prev.gif" WIDTH="10" HEIGHT="18" BORDER="0" ALT="Previous Month"></a></td>

<td WIDTH="20" HEIGHT="18" ALIGN="RIGHT" VALIGN="MIDDLE"><a HREF="<% =sScript %>?month=<% =IntNextMonth %>&year=<% =IntNextYear %>"><img SRC="next.gif" WIDTH="10" HEIGHT="18" BORDER="0" ALT="Next Month"></a></td>

</tr><tr>

</tr><tr><td HEIGHT="1" ALIGN="MIDDLE" COLSPAN="7"><img SRC="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

' If the date falls within the range of dates in the recordset, then

' the day has an event. Make the events flag True

If ((rs("PRIVATE") <> 1) or ((rs("PRIVATE") = 1) and (lcase(rs(strDBNTSQLNAME)) = lcase(strDBNTUSerName)))) and (dToday >= strToDate(Rs("Start_Date")) AND dToday <= strToDate(Rs("End_Date"))) and Rs("PENDING") = 0 then

select case dtoday

case strForumDateAdjust

Write_TD "<A HREF=" & sScript & "?date="& dToday & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='EVENT'> " & intPrintDay & "</A>", "Today"

case cdate(ddate)

Write_TD "<A HREF=" & sScript & "?date="& dToday & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='EVENT'> " & intPrintDay & "</A>", "Selected"

case else

Write_TD "<A HREF=" & sScript & "?date="& dToday & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='EVENT'> " & intPrintDay & "</A>", "HL"

end select

bEvents = True

'end if

' 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 strForumDateAdjust

Write_TD "<A HREF=" & sScript & "?date="& dToday & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='NOEVENT'> " & intPrintDay & "</A>", "TODAY"

case cdate(ddate)

Write_TD "<A HREF=" & sScript & "?date="& dToday & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='NOEVENT'> " & intPrintDay & "</A>", "Selected"

case else

Write_TD "<A HREF=" & sScript & "?date="& dToday & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='NOEVENT'> " & intPrintDay & "</A>", "SOME"

end select

End If

' Increment the date. Done once in the loop.

intPrintDay = intPrintDay + 1

End If

' Move to the next day in the week

Loop

Rs.Close

set rs = nothing

%>

</table></td></tr></table>

</td></tr>

<%

end function

Function DisplayMonth_full()

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

if Request.QueryString("month") = "" then

intLastMonth = DatePart( "m", DateAdd( "m", -1, strForumDateAdjust))

else

if Request.QueryString("month") = 1 then

intLastMonth = 12

else

intLastMonth = Request.QueryString("month") - 1

end if

if Request.QueryString("year") = "" then

intPrevYear = DatePart( "yyyy", DateAdd( "m", -1, strForumDateAdjust))

else

if Request.QueryString("month") = 1 then

intPrevYear = Request.QueryString("year") - 1

else

intPrevYear = Request.QueryString("year")

end if

' 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, PRIVATE, PENDING, " & strDBNTSQLName & ", event_details FROM " & strTablePrefix & "EVENTS Inner JOIN " & strMemberTablePrefix & "Members ON " & strTablePrefix & "EVENTS.added_by = " & strMemberTablePrefix & "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

dim rs

Set Rs = Server.CreateObject("ADODB.RecordSet")

rs.Open ssql, my_Conn

if strCMessage <> "" then

%>

<table bgcolor="<% =strTableBorderColor %>" border="0" cellpadding="0" cellspacing="0" width="450" ALIGN=CENTER>

<tr><td align="center" bgcolor="<% =strCategoryCellColor %>"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor%>">Events Message</font></td></tr>

<tr><td align="center" bgcolor="<% =strForumCellColor %>"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strForumFontColor%>"><%= strCMessage%></font>

<p align="center"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>"><a href="events.asp">Voltar Events Page</font></a></p>

</td></tr></table>

<p align="center"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>"><a href="<%= sScript %>?month=<%=month(myDate)%>&year=<%= year(myDate)%>">Voltar visualização mensal</a></font></p>

<% exit function

end if

if sTitle <> "" then%>

<table bgcolor="<% =strTableBorderColor %>" border="0" cellpadding="0" cellspacing="0" width="450" ALIGN=CENTER>

<tr><td align="center" bgcolor="<% =strCategoryCellColor %>"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor%>">Events Message</font></td></tr>

<tr><td align="center" bgcolor="<% =strForumCellColor %>"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strForumFontColor%>"><%= sTitle%></font> <br><br>

</td></tr></table>

</td></tr></table><br><br>

<%

end if%>

<table WIDTH="99%" ALIGN="CENTER" BORDER="1" CELLSPACING="0" CELLPADDING="2" style="border-collapse: collapse" BGCOLOR="<% =strForumCellColor %>" BORDERCOLOR="<% =strTableBorderColor %>">

<tr><td WIDTH="10%" HEIGHT="10" ALIGN="center" VALIGN="MIDDLE" bgcolor="<% =strForumCellColor %>"><a HREF="<% =sScript%>?month=<% =IntPrevMonth %>&year=<% =IntPrevYear %>"><img SRC="prev2.gif" WIDTH="11" HEIGHT="8" BORDER="0" ALT="Previous Month"></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="next2.gif" WIDTH="11" HEIGHT="8" BORDER="0" ALT="Next Month"></a></td>

</tr><tr>

<td HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>">Dom</td>

<td HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>">Seg</td>

<td HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>">Ter</td>

<td HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>">Qua</td>

<td HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>">Qui</td>

<td HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>">---</td>

<td HEIGHT="20" WIDTH="14%" ALIGN="center" VALIGN="middle"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>">Sab</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 ((rs("PRIVATE") <> 1) or ((rs("PRIVATE") = 1) and (lcase(rs(strDBNTSQLNAME)) = lcase(strDBNTUSerName)))) and (dToday >= strToDate(Rs("Start_Date")) AND dToday <= strToDate(Rs("End_Date"))) and Rs("PENDING") = 0 then

if dtoday = strForumDateAdjust then

' Print the date in a highlighted font

Write_TD2 "<A HREF=" & sScript & "?date="& 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=" & sScript & "?date="& 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 = strForumDateAdjust then

Write_TD3 "<A HREF=" & sScript & "?date="& dToday & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='NOEVENT'> " & intPrintDay & "</A>", "TODAY"

else

Write_TD3 "<A HREF=" & sScript & "?date="& dToday & "&month=" & month(dToday) & "&year=" & year(dToday) & " CLASS='NOEVENT'> " & intPrintDay & "</A>", "SOME"

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

Loop

Rs.Close

set rs = nothing

%>

</table></td></tr><tr><td>

<%

end function

function DisplayEvents()

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, PRIVATE, event_details FROM " & strTablePrefix & "EVENTS WHERE PENDING = 0 and Event_ID = " & strRqEventID

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 = chkstring(Rs("Event_Title"), "display")

sEvent_Details = Rs("Event_Details")

iEvent_Private = RS("PRIVATE")

end if

Response.Write "Edit: " & sEvent_Title

%></td></tr><tr><td <% =strPopUpBorderColor %> align="center">

<%

if mlev >= intAllowed then

Show_Form()

else

%>

<table bgcolor="<% =strTableBorderColor %>" border="0" cellpadding="0" cellspacing="0" width="450" ALIGN=CENTER>

<tr><td align="center" bgcolor="<% =strForumCellColor %>"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">Only Moderators can edit an event.</font></td></tr>

</table></td></tr></table>

<%

end if

rs.close

set rs = nothing

exit function

end if

if smode = "add" then

Response.Write "Adicionar um Evento" & sEvent_Title

%>

</td></tr><tr><td align="center">

<%

if mlev >= intAllowed then

Show_Form()

else

%>

<br><br><table bgcolor="<% =strTableBorderColor %>" border="0" cellpadding="0" cellspacing="0" width="450" ALIGN=CENTER>

<tr><td align="center" bgcolor="<% =strForumCellColor %>"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">Only Moderators can add an event.</font></td></tr>

</table></td></tr></table>

<%

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(myDate) OR NOT IsDate(myDate) 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, PRIVATE, " & strDBNTSQLName & ", event_details FROM " & strTablePrefix & "EVENTS Inner JOIN " & strMemberTablePrefix & "Members ON " & strTablePrefix & "EVENTS.added_by = " & strMemberTablePrefix & "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 "Events for " & FormatDateTime(dDate, 1)

sSQL = "SELECT event_id, start_date, end_date, event_title, PRIVATE, " & strDBNTSQLName & ", event_details FROM " & strTablePrefix & "EVENTS Inner JOIN " & strMemberTablePrefix & "Members ON " & strTablePrefix & "EVENTS.added_by = " & strMemberTablePrefix & "Members.Member_ID " & _

"WHERE PENDING = 0 and Start_Date <= '" & DateToStr(dDate) & "' AND End_Date >= '" & DateToStr(ddate) & "' ORDER BY Event_ID "

End If

%>

</td></tr><tr><td align=center>

<% if strCMessage <> "" then

Response.Write "<font face=" & strDefaultFontFace & " size=" & strDefaultFontSize & ">" & strCMessage & "</font>"

%>

</td></tr><tr><td>

<% end if

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, PRIVATE, event_details FROM " & strTablePrefix & "EVENTS " & _

"WHERE PENDING = 0 and Start_Date <= '" & DateToStr(dDate) & "' AND End_Date >= '" & DateToStr(dDate) & "' ORDER BY Event_ID "

'response.write ssql

Rs.Open sSQL, my_Conn

MemberErased = true

end if

If NOT Rs.EOF Then

Do While NOT Rs.EOF

if (rs("PRIVATE") <> 1) or (rs("PRIVATE") = 1 and lcase(rs(strDBNTSQLNAME)) = lcase(strDBNTUSerName)) then%>

<br>

<%mwpThemeSmallBlock_open()%>

<tr><td align="left" <%= mwpThemeBlock_subTitleCell %>><b><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor %>">

<%Response.Write chkString(Trim(Rs("Event_Title")), "display")

strMessage = Rs("Event_Details")

if not(memberErased) then

Response.Write " - Adicionado by " & lcase(rs(strDBNTSQLNAME))

else

Response.Write " - Adicionado by Deleted User"

end if

%></font></b></td>

<%If (mlev >= intAllowed and lcase(strDBNTUSerName) = lcase(rs(strDBNTSQLNAME))) or mlev = 4 Then%>

<td align="center" <%= mwpThemeBlock_subTitleCell %> width="50">

<a HREF="<%= sScript %>?mode=edit&Event_ID=<%= Rs("Event_ID")%>&date=<%=ddate%>"><img SRC="icon_pencil.gif" BORDER="0" WIDTH="12" HEIGHT="12"></a>

<a HREF="<%= sScript %>?mode=delete&Event_ID=<%=Rs("Event_ID")%>&date=<%= myDate%>"><img SRC="icon_trashcan.gif" BORDER="0" WIDTH="12" HEIGHT="12"></a>

</td><%End If%></tr>

<tr><td height="30" BGCOLOR="<% =strForumCellColor %>" <%If mlev >= intAllowed or lcase(strDBNTUSerName) = lcase(rs(strDBNTSQLNAME)) 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='Verdana, Arial' SIZE=1 COLOR='" & strForumCellColor & "'>Starts: " & strToDate(Rs("Start_Date")) & vbCrLf

Response.Write "<BR>Ends: " & strToDate(Rs("End_Date")) & vbCrLf

Response.Write "</FONT><P>"

else

Response.Write "<FONT FACE='Verdana, Arial' SIZE=1 COLOR='" & strForumCellColor & "'>Starts: " & strToDate(Rs("Start_Date")) & vbCrLf

Response.Write "</FONT><P>"

End If

%>

</td></tr><%mwpThemeSmallBlock_close()%><br>

<%

end if

Rs.MoveNext

Loop

if mlev >= intAllowed then%><center>

<a HREF="<%= sScript %>?mode=add&date=<%if myDate= "" then Response.Write(strForumDateAdjust) else Response.Write(myDate)%>"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor%>">Add an event for this day</font></a></center>

<%

end if

else

if mlev >= intAllowed then

%>

<%

mwpThemeSmallBlock_open()%>

<tr><td align="center" bgcolor="<% =strCategoryCellColor %>"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor%>">Não existe evento para este dia.</font></td></tr>

<tr><td align="center" bgcolor="<% =strForumCellColor %>"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strForumFontColor%>">

Gostaria de <a HREF="<%= sScript %>?mode=add&date=<%if myDate= "" then Response.Write(strForumDateAdjust) else Response.Write(myDate)%>">Adicionar um evento</a> para este dia?</font>

<%

end if

End If

rs.close

set rs = nothing

end function

function DisplayUpcomingEvents

strSql = "SELECT top " & intDisplay & " event_id, start_date, event_title, PRIVATE, " & strDBNTSQLName & " FROM " & strTablePrefix & "EVENTS Inner JOIN " & strMemberTablePrefix & "Members ON " & strTablePrefix & "EVENTS.added_by = " & strMemberTablePrefix & "Members.Member_ID WHERE PENDING = 0 and start_date >= '" & DateToStr(strForumDateAdjust) & "' and start_date < '" & DateToStr(DateAdd("d",30,strForumDateAdjust)) & "' Order by start_date, event_id ASC"

%>

<%

dim rs, strTitle

set rs = server.CreateObject("adodb.recordset")

rs.Open strSql, my_Conn

dim prevStartDate

if not rs.eof or not rs.bof then

do while not rs.EOF

if (rs("PRIVATE") <> 1) or (rs("PRIVATE") = 1 and lcase(rs(strDBNTSQLName)) = strDBNTUSerName) then

strTitle = chkString(rs("Event_Title"), "display")

if len(strTitle) > 23 then

strTitle = mid(strTitle,1,24) & "..."

end if

if prevStartDate <> rs("start_date") then

Response.Write "<tr>"

Response.Write "<td align=left width=100% valign=top><font face=" & strDefaultFontFace & " size=" & strDefaultFontSize-1 & "><b>" & strtodate(rs("Start_Date")) & "</b></font></td>"

Response.Write "</tr>"

end if

Response.Write "<tr>"

Response.Write "<td align=left width='100%'><a href=""java script:openWindow3('pop_event.asp?event_id=" & rs("event_id") & "')""><font face=" & strDefaultFontFace & " size=" & strFooterFontSize & ">" & strTitle & "</font></a></td>"

Response.Write "</tr>"

prevStartDate = rs("start_date")

end if

rs.MoveNext

loop

else%>

<tr><td valign="top"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor%>">Não existe novos eventos à caminho do mês</font></td></tr>

<%end if

rs.Close

set rs = nothing

%>

</table>

<%

end function

function DisplayPastEvents

strSql = "SELECT top " & intDisplay & " event_id, start_date, event_title, PRIVATE, " & strDBNTSQLName & " FROM " & strTablePrefix & "EVENTS Inner JOIN " & strMemberTablePrefix & "Members ON " & strTablePrefix & "EVENTS.added_by = " & strMemberTablePrefix & "Members.Member_ID WHERE PENDING = 0 and start_date < '" & DateToStr(strForumDateAdjust) & "' and start_date > '" & DateToStr(DateAdd("d",-30,strForumDateAdjust)) & "' Order by start_date desc"

%>

<%

dim rs, strTitle

Set Rs = Server.CreateObject("ADODB.RecordSet")

rs.Open strSql, my_Conn

dim prevStartDate

if not rs.eof or not rs.bof then

do while not rs.EOF

if (rs("PRIVATE") <> 1) or (rs("PRIVATE") = 1 and lcase(rs(strDBNTSQLName)) = strDBNTUSerName) then

strTitle = chkString(rs("Event_Title"), "display")

if len(strTitle) > 23 then

strTitle = mid(strTitle,1,24) & "..."

end if

if prevStartDate <> rs("start_date") then

Response.Write "<tr>"

Response.Write "<td align=left width=100% valign=top><font face=" & strDefaultFontFace & " size=" & strDefaultFontSize-1 & "><b>" & strtodate(rs("Start_Date")) & "</b></font></td>"

Response.Write "</tr>"

end if

Response.Write "<tr>"

Response.Write "<td align=left width='100%'><a href=""java script:openWindow3('pop_event.asp?event_id=" & rs("event_id") & "')""><font face=" & strDefaultFontFace & " size=" & strFooterFontSize & ">" & strTitle & "</font></a></td>"

Response.Write "</tr>"

prevStartDate = rs("start_date")

end if

rs.MoveNext

loop

else%>

<tr><td valign="top"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor%>">Não existe eventos recentes.</font></td></tr>

<%end if

rs.Close

set rs = nothing

%>

</table>

<%end function

function DisplayWeek()

dim dDispWeek

'get date to display week for

if myDate <> "" then

dDispWeek = myDate

else

dDispWeek = strForumDateAdjust

end if

' Need to figure out what the first Sunday of clicked week is

' Current Day in Day, month year format

strCurrentDay = FormatDateTime(dDispWeek,1)

' Current Static Date, and Figure out Left 3 Chars of Day

dDayDate = dDispWeek

strCurrentDay = left(strCurrentDay,3)

' Now that we know the current day we can count days from Sunday

intBack = 0

if strCurrentDay <> "Sun" then

FullWeekArray = Array("Sun","Mon","Tue","Wed","Thu","Fri","Sat","N/A")

Do while (intBack <= 8 AND strCurrentDay <> FullWeekArray(intBack) )

intBack = intBack + 1

loop

end if

' We found our sunday, now we can we also find the next sunday and prev sunday.

' and last day of the week, which is a sabado

dSunday = DateAdd("D",-intBack,dDispWeek)

dSaturday = DateAdd("D",6,dSunday)

dSundayNext = DateAdd("D",7,dSunday)

dSundayPrev = DateAdd("D",-7,dSunday)

%>

<tr>

<td width="80%" align="center" valign="middle" bgcolor="<% =strCategoryCellColor %>"><b><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor %>">

<%Response.Write FormatDateTime(dSunday, 1) & " - " & formatdatetime(dSaturday, 1)%>

</td>

</tr><tr>

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

<% if sTitle <> "" then%>

<% =sTitle %><br>

</td></tr><tr><td colspan="3">

<% end if

'set the current date to the sunday

dCurrentDate = dSunday

dim rs

Set Rs = Server.CreateObject("ADODB.RecordSet")

'display the events for the seven days

for counter = 1 to 7

'get the events for this day

strSQL = "SELECT event_id, start_date, end_date, event_title, PRIVATE, " & strDBNTSQLName & ", event_details FROM " & strTablePrefix & "EVENTS Inner JOIN " & strMemberTablePrefix & "Members ON " & strTablePrefix & "EVENTS.added_by = " & strMemberTablePrefix & "Members.Member_ID " & _

"WHERE PENDING = 0 and Start_Date <= '" & DateToStr(dCurrentDate) & "' AND End_Date >= '" & DateToStr(dCurrentDate) & "' ORDER BY Event_ID"

rs.Open strSql, my_Conn

%>

<br>

<b><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor %>"><%= formatdatetime(dCurrentDate,1)%></font></b></a>

</td></tr>

<%

if rs.eof then

%>

<tr><td height="30" BGCOLOR="<% =strForumCellColor %>"><font color="<% =strForumFontColor %>" face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">Não existe eventos para este dia</font></td></tr>

<%

else

'Display the events for that day

Do while not rs.eof

if (rs("PRIVATE") <> 1) or (rs("PRIVATE") = 1 and lcase(rs(strDBNTSQLNAME)) = lcase(strDBNTUSerName)) then

%>

<i><font color="<% =strForumFontColor %>" face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">Adicionado por <%=lcase(rs(strDBNTSQLNAME))%></font></i><br><br>

</td></tr>

<% end if

rs.movenext

loop

end if

%>

</table></td></tr></table>

<%

rs.Close

'move to the next day

dCurrentDate = DateAdd("D",counter,dSunday)

%>

</td></tr></table>

<%

end function

%>

jrcardozo · Março 28, 2008

movido do Laboratório de Scripts para o forum principal ASP

Salgado · Março 28, 2008

No "Laboratório de Scripts" há um tópico sobre isso, dê uma pesquisada antes.

Entrar

Arquivado

Problemas com eventos asp

Recommended Posts

hully 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

jrcardozo 4

Compartilhar este post

Link para o post

Compartilhar em outros sites

Salgado 4

Compartilhar este post

Link para o post

Compartilhar em outros sites

Fixar div até atingir uma certa altura

Ajuda com Extends e envio para o banco

PHP+Codeginiter - Orientação para Impressão

Este projeto é apoiado pelas empresas

Fóruns

Tempo Real

Informação importante