<%@ LANGUAGE="VBSCRIPT" %> <%Response.Buffer = True%> LinkButler.com has 1,000s of Links to windows ,dos, linux, unix, os2, macintosh shareware, freeware, themes, wallpaper, screen saver downloads

 

 Enter a 4 digit year: 

<% '**** May 2001 ************************************* 'Author: Joel Denton 'joeldenton@hotmail.com ' 'A year view calendar with the ability of marking 'and linking dates to specific meetings or scheduled 'transactions '*************************************************** 'The name of THIS page sScriptName = Request.ServerVariables("SCRIPT_NAME") 'Number of months across iMonthCols = 4 'URL for meeting id sMeetingLink = "../cgi-bin/Search.asp?se=" If request("year") = "" Then 'If no year is specified, show the current year sYear = datePart("yyyy",date()) Else 'Increment or decrement the specified year sYear = cStr(cInt(request("year")) + cInt(request("direction"))) End If 'Just some sample meeting data. You could build this array 'from a table of meetings from your application, the first element 'is a unique meeting id, the second is the date. dim aryMeetings(1,10) aryMeetings(0,0) = "1" aryMeetings(1,0) = "1/1/2001" aryMeetings(0,1) = "2" aryMeetings(1,1) = "2/2/2001" aryMeetings(0,2) = "3" aryMeetings(1,2) = "2/19/2001" aryMeetings(0,3) = "4" aryMeetings(1,3) = "4/15/2001" aryMeetings(0,4) = "5" aryMeetings(1,4) = "5/28/2001" aryMeetings(0,5) = "7" aryMeetings(1,5) = "7/4/2001" aryMeetings(0,6) = "9" aryMeetings(1,6) = "9/3/2001" aryMeetings(0,7) = "10" aryMeetings(1,7) = "10/8/2001" aryMeetings(0,8) = "11" aryMeetings(1,8) = "11/12/2001" aryMeetings(0,9) = "12" aryMeetings(1,9) = "11/22/2001" aryMeetings(0,10) = "25" aryMeetings(1,10) = "12/25/2001" 'Check the array for a meeting on given date 'If a meeting exists, return the position in the array Function HasMeeting(dDate) If isEmpty(aryMeetings) Then HasMeeting = -1 Else For i = 0 to ubound(aryMeetings,2) If cDate(aryMeetings(1,i)) = dDate Then HasMeeting = i Exit Function End If Next HasMeeting = -1 End If End Function 'Write the cell with the correct colors and applicable link Sub WriteCell(iCellPos,dDate) sHTMLOut = "" 'If this is Sunday, start a new If iCellPos mod 7 = 1 Then sHTMLOut = sHTMLOut & "" End If If IsNull(dDate) Then 'Write an empty cell sHTMLOut = sHTMLOut & " " Else 'Check to see if date is a weekend If datePart("w",dDate) = 1 or datePart("w",dDate) = 7 Then 'Write a weekend cell lMeetingId = HasMeeting(dDate) If lMeetingId >= 0 Then sHTMLOut = sHTMLOut & "" sHTMLOut = sHTMLOut & "" & datePart("d",dDate) & "" Else sHTMLOut = sHTMLOut & "" & datePart("d",dDate) & "" End If Else 'Write a weekday cell lMeetingId = HasMeeting(dDate) If lMeetingId >= 0 Then sHTMLOut = sHTMLOut & "" sHTMLOut = sHTMLOut & "" & datePart("d",dDate) & "" Else sHTMLOut = sHTMLOut & "" & datePart("d",dDate) & "" End If End If End If 'If this is Saturday, end the If iCellPos mod 7 = 0 Then sHTMLOut = sHTMLOut & "" End If Response.Write sHTMLOut End Sub 'Write the month table Sub WriteMonth(sDate) sHTMLOut = "" dValue = cDate(sDate) iStartDay = datePart("w",dValue) iMonth = datePart("m",dValue) iDateIncrement = 0 'Write the month table header sHTMLOut = sHTMLOut & "" sHTMLOut = sHTMLOut & "" sHTMLOut = sHTMLOut & "" sHTMLOut = sHTMLOut & "" sHTMLOut = sHTMLOut & "" sHTMLOut = sHTMLOut & "" sHTMLOut = sHTMLOut & "" sHTMLOut = sHTMLOut & "" sHTMLOut = sHTMLOut & "" sHTMLOut = sHTMLOut & "" sHTMLOut = sHTMLOut & "" Response.Write sHTMLOut 'Step through each cell in the month table For iCell = 1 to 42 'Check to see if we can start writing days If bValidCell or iCell = iStartDay Then bValidCell = True 'Bump up the date dValue = cDate(sDate) + iDateIncrement iDateIncrement = iDateIncrement + 1 'If we're not in the current month, we've gone too far If datePart("m",dValue) <> iMonth Then 'Invalid cell, write a blank cell bValidCell = False Call WriteCell(iCell,null) Else 'Still in this month, write the day Call WriteCell(iCell,dValue) End If Else 'We're either before or after the month day range, 'just write a blank cell Call WriteCell(iCell,null) End If Next 'Finish up the month table Response.Write "
" & MonthName(iMonth) & "
SMTWTFS
" End Sub %> method=POST> <% 'Write all twelve months For j = 1 to 12 'Start a new row after specified number of month columns If (j-1) mod iMonthCols = 0 Then Response.Write "" End If sDate = cStr(j) & "/1/" & sYear Response.Write "" 'End the row after specified number of month columns If j mod iMonthCols = 0 Then Response.Write "" End If Next %>
>
  <<  Linkbutler.com <%=sYear%>  >>  
" Call WriteMonth(sDate) Response.Write "