博客上常用的日历函数的写法

来源:半月设计 发布人:guobar 发布时间:2005-7-1 10:47:38 人气: 所属栏目:ASP研究-ASP

主程序代码:
Sub Calendar(C_Year,C_Month,C_Day)  ’BLOG日历
 ReDim Link_Days(2,0)
 Dim Link_Count
 Link_Count=0
 Dim This_Year,This_Month,This_Day,RS_Month,Link_TF
 IF C_Year=Empty Then C_Year=Year(Now())
 IF C_Month=Empty Then C_Month=Month(Now())
 IF C_Day=Empty Then C_Day=0
 C_Year=Cint(C_Year)
 C_Month=Cint(C_Month)
 C_Day=Cint(C_Day)
 This_Year=C_Year
 This_Month=C_Month
 This_Day=C_Day
 Dim To_Day,To_Month,To_Year
 To_Day=Cint(Day(Now()))
 To_Month=Cint(Month(Now()))
 To_Year=Cint(Year(Now()))
 
 SQL="SELECT log_PostYear,log_PostMonth,log_PostDay FROM blog_Content WHERE log_PostYear="&C_Year&" AND log_PostMonth="&C_Month&" ORDER BY log_PostDay"

 Set RS_Month=Server.CreateObject("ADODB.RecordSet")
 RS_Month.Open SQL,Conn,1,1
 SQLQueryNums=SQLQueryNums+1
 Dim the_Day
 the_Day=0
 Do While NOT RS_Month.EOF
  IF RS_Month("log_PostDay")<>the_Day Then
   the_Day=RS_Month("log_PostDay")
   ReDim PreServe Link_Days(2,Link_Count)
   Link_Days(0,Link_Count)=RS_Month("log_PostMonth")
   Link_Days(1,Link_Count)=RS_Month("log_PostDay")
   Link_Days(2,Link_Count)="default.asp?log_Year="&RS_Month("log_PostYear")&"&log_Month="&RS_Month("log_PostMonth")&"&log_Day="&RS_Month("log_PostDay")
   Link_Count=Link_Count+1
  End IF
  RS_Month.MoveNext
 Loop
 RS_Month.Close
 Set RS_Month=Nothing
 
 Dim Month_Name(12)
 Month_Name(0)=""
 Month_Name(1)="1"
 Month_Name(2)="2"
 Month_Name(3)="3"
 Month_Name(4)="4"
 Month_Name(5)="5"
 Month_Name(6)="6"
 Month_Name(7)="7"
 Month_Name(8)="8"
 Month_Name(9)="9"
 Month_Name(10)="10"
 Month_Name(11)="11"
 Month_Name(12)="12"
 
 Dim Month_Days(12)
 Month_Days(0)=""
 Month_Days(1)=31
 Month_Days(2)=28
 Month_Days(3)=31
 Month_Days(4)=30
 Month_Days(5)=31
 Month_Days(6)=30
 Month_Days(7)=31
 Month_Days(8)=31
 Month_Days(9)=30
 Month_Days(10)=31
 Month_Days(11)=30
 Month_Days(12)=31
 
 If IsDate("February 29, " & This_Year) Then Month_Days(2)=29
 
 Dim Start_Week
 Start_Week=WeekDay(C_Month&"-1-"&C_Year)-1
 
 Dim Next_Month,Next_Year,Pro_Month,Pro_Year
 Next_Month=C_Month+1
 Next_Year=C_Year
 IF Next_Month>12 then 
  Next_Month=1
  Next_Year=Next_Year+1
 End IF
 Pro_Month=C_Month-1
 Pro_Year=C_Year
 IF Pro_Month<1 then 
  Pro_Month=12
  Pro_Year=Pro_Year-1
 End IF
 
 Response.Write("<div class=""siderbar_head""><img src=""images/sider_calendar.gif"" align=""absmiddle"" border=""0"" /> GUOBAR日历</div><table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"" background=""images/calendar/month"&Month_Name(C_Month)&".gif""><tr><td colspan=""7"" align=""center""><a href=""default.asp?log_Year="&C_Year-1&""" title=""last year""><span class=""arrow"">7</span></a><a href=""default.asp?log_Year="&Pro_Year&"&log_Month="&Pro_Month&""" title=""last month""><span class=""arrow"">3</span></a> <strong>"&C_Year&"  - "&Month_Name(C_Month)&"</strong> <a href=""default.asp?log_Year="&Next_Year&"&log_Month="&Next_Month&""" title=""next month""><span class=""arrow"">4</span></a><a href=""default.asp?log_Year="&C_Year+1&""" title=""next year""><span class=""arrow"">8</span></a></td></tr><tr bgcolor=""#F8F8F8"" class=""calendar-week"">")
 Response.Write("<td>日</td><td>一</td><td>二</td><td>三</td><td>四</td><td>五</td><td>六</td></tr><tr>")
 Dim i,j,k,l,m
 For  i=0 TO Start_Week-1
  Response.Write("<td>&nbsp;</td>")
 Next
 Dim This_BGColor
 j=1
 While j<=month_Days(This_Month)
   For k=start_Week To 6
   This_BGColor="calendar"
   IF j=To_Day AND This_Year=To_Year AND This_Month=To_Month Then This_BGColor="calendar-today"
   IF j=This_Day Then This_BGColor="calendar-thisday"
   Response.Write("<td class="""&This_BGColor&""">")
   Link_TF="Flase"
   For l=0 TO Ubound(Link_Days,2)
    IF Link_Days(0,l)<>"" Then
     IF Link_Days(0,l)=This_Month AND Link_Days(1,l)=j Then
      Response.Write("<a href="""&Link_Days(2,l)&""">")
      Link_TF="True"
     End IF
    End IF
   Next
  IF j<=Month_Days(This_Month) Then Response.Write(j)
  IF Link_TF="True" Then Response.Write("</a>")
        Response.Write("</td>")
  j=j+1
 Next
 Start_Week=0
 Response.Write("</tr>")
 Wend
 Response.Write("</table>")
End Sub




生成时间:2006-5-27 9:00:42