注册 | 登录 | 网址 欢迎访问八百站长

[原创]ASP2015新版日历显示类

2015-07-21 23:03:57 作者:站长日记 来源:八百站长 浏览:3027次

  ASP新版日历显示类,支持1901-2099年日历,公历、农历、节气、节日、放假调休等功能一体完成,只需简单调用几个函数,超级简便。

<%
'////获取公历y年m月全部日历的ASP类/////////////////////////////////////////////////////////////////
'Dim cale
'Set cale=New CalendarClass         '默认日期为今天
'cale.setDate 2015,7                '设置当前日历为2015年7月
'                                   '默认农历日期显示为完整版(六月初六)
'cale.simple=true                   '设置农历日期显示为简单版(初六,六月小(初一时))
'Response.Write cale.curDays        '输出当前月的天数
'Response.Write cale.curWeekday     '输出当前月1日是星期三(3)(星期一(1)-星期日(7))
'Dim i
'For i=1 to cale.curDays
'  Response.Write cale.Lunar(i)     '循环输出每天农历日期
'  Response.Write cale.Festival(i)  '循环输出每天节日,可去除分隔符"|":Trim(Replace(cale.Festival(i),"|"," "))
'  Response.Write cale.Holiday(i)   '循环输出每天是否休假或上班(#为休假,*为上班)
'Next
'Set cale=Nothing
'/////////////////////////////////////////////////////////////////////////////////////////////////////
Class CalendarClass
 'Lunar(31)每天中文农历显示日期,Festival(31)每天节日节气,Holiday每天休假或上班(#为休假,*为上班)
 Public Lunar(31),Festival(31),Holiday(31)
 
  'cYear本年,cMonth本月,cDays本月天数,cWeekday本月1日星期几,today今天日期
 'LunarDate(31)(3)每天农历年月日,lYear(3)本月农历年,lMonth(3)本月农历月(闰月为负),lDays(3)本月农历月天数,lDay本月1日农历日
 Private cYear,cMonth,cDays,cWeekday,today
 Private LunarDate(31),lYear(3),lMonth(3),lDays(3),lDay
 Private LunarInfo,Holidays,sFtv,lFtv,wFtv
 Private simp,getinfo  'simp农历日期是否简单显示,默认为否(完整显示)。getinfo是否已获取农历信息,默认为否
 
 '初始化
 Private Sub Class_Initialize()
   '//每年的公休假放假调休信息 #为放假日 *为上班日
  Holidays=Array("20150101#","20150102#","20150103#","20150104*","20150218#","20150219#","20150220#","20150221#","20150222#","20150223#","20150224#","20150215*","20150228*","20150404#","20150405#","20150406#","20150501#","20150502#","20150503#","20150620#","20150621#","20150622#","20150903#","20150904#","20150905#","20150906*","20150926#","20150927#","20151001#","20151002#","20151003#","20151004#","20151005#","20151006#","20151007#","20151010*")
  '//公历节日
  '格式:起始年(yyyy)+月(mm)+日(dd) #为放假日
  sFtv=Array("00000101#元旦","00000214 情人节","19100308 妇女节","19790312 植树节","19830315 消费者权益日","15640401 愚人节","19380501#劳动节","19500504 青年节","19500601 儿童节","19210701 建党节","19270801 建军节","19450903 抗战胜利日","19850910 教师节","19491001#国庆节","00001101 万圣节","00001225 圣诞节")
  '//农历节日 30表示该月最后一天(没有30则为29)
  '格式:月(mm)+日(dd) #为放假日
  lFtv=Array("0101#春节","0115 元宵节","0202 龙抬头","0505#端午节","0707 七夕节","0815#中秋节","0909 重阳节","1208 腊八节","1223 祭灶","1230#除夕")
  '//公历节日:某月第几个星期几 #为放假日
  '起始年(4位)+月(2位)+第几个(1位1-5)+星期几(1位0-6),倒数第几个用10-n(n=6-9)
  wFtv=Array("19140520 母亲节","19340630 父亲节","18631144 感恩节")
  
  '//以下信息不可更改
  LunarInfo = Array("4bd8","4ae0","a570","54d5","d260","d950","5554","56af","9ad0","55d2","4ae0","a5b6","a4d0","d250","d295","b54f","d6a0","ada2","95b0","4977","497f","a4b0","b4b5","6a50","6d40","ab54","2b6f","9570","52f2","4970","6566","d4a0","ea50","6a95","5adf","2b60","86e3","92ef","c8d7","c95f","d4a0","d8a6","b55f","56a0","a5b4","25df","92d0","d2b2","a950","b557","6ca0","b550","5355","4daf","a5b0","4573","52bf","a9a8","e950","6aa0","aea6","ab50","4b60","aae4","a570","5260","f263","d950","5b57","56a0","96d0","4dd5","4ad0","a4d0","d4d4","d250","d558","b540","b6a0","95a6","95bf","49b0","a974","a4b0","b27a","6a50","6d40","af46","ab60","9570","4af5","4970","64b0","74a3","ea50","6b58","5ac0","ab60","96d5","92e0","c960","d954","d4a0","da50","7552","56a0","abb7","25d0","92d0","cab5","a950","b4a0","baa4","ad50","55d9","4ba0","a5b0","5176","52bf","a930","7954","6aa0","ad50","5b52","4b60","a6e6","a4e0","d260","ea65","d530","5aa0","76a3","96d0","4afb","4ad0","a4d0","d0b6","d25f","d520","dd45","b5a0","56d0","55b2","49b0","a577","a4b0","aa50","b255","6d2f","ada0","4b63","937f","49f8","4970","64b0","68a6","ea5f","6b20","a6c4","aaef","92e0","d2e3","c960","d557","d4a0","da50","5d55","56a0","a6d0","55d4","52d0","a9b8","a950","b4a0","b6a6","ad50","55a0","aba4","a5b0","52b0","b273","6930","7337","6aa0","ad50","4b55","4b6f","a570","54e4","d260","e968","d520","daa0","6aa6","56df","4ae0","a9d4","a4d0","d150","f252","d520") '农历信息 1900年-2100年
  
  today=Date()
  cYear=Year(today)
  cMonth=Month(today)
  simp=false
  getinfo=false
  End Sub
 Public Property Get curYear 
  curYear = cYear
 End Property 
 Public Property Get curMonth
  curMonth = cMonth
 End Property 
 Public Property Get curDays
  curDays = cDays
 End Property 
 Public Property Get curWeekday
  curWeekday = cWeekday
 End Property 
 '给日期赋值(日期型da)
 Public Property Let Simple(ByVal s) 
  If s=true or s="true" and simp=false Then
    simp=true
   Call GetSimpleLunar()
  ElseIf s=false or s="false" and simp=true Then
    simp=false
    Call GetLunar()
  End If
 End Property 
 '设置日期(y,m)
 Public Function SetDate(ByVal y,ByVal m)
  If (y>=1901 And y<=2100) And (m>=1 And m<=12) Then
   cYear=y
   cMonth=m
   SetDate=True
  Else
   SetDate=False
  End If
  If simp=false Then Call GetLunar() Else Call GetSimpleLunar()
  Call GetFestival()
 End Function
 
 '获取农历信息
 Private Sub GetLunarInfo()
  '计算第一个月的农历信息()
  dim curDate
  curDate=DateSerial(cYear,cMonth,1)
  cDays=GetDays(cYear,cMonth)
  cWeekday=Weekday(curDate,2)
  
  dim i,leap,temp,ly,k
  leap=0: temp=0
  dim baseDate,offset,isleap
  baseDate=DateSerial(1900,1,31)
  offset=DateDiff("d",baseDate,curDate)
  for i=1900 to 2100
   if offset<=0 then exit for
   temp=lYearDays(i)
   offset=offset-temp
  next
  if offset<0 Then
   offset=offset+temp
   i=i-1
  end if
  lYear(0)=i
  leap=leapMonth(i)
  isLeap=false
  ly=i
  i=1
  do
   if leap>0 and i=(leap+1) and isLeap=false then
    i=i-1
    isLeap=true
    temp=leapDays(ly)
   else
    temp=monthDays(ly,i)
   end if
   if isLeap=true and i=(leap+1) then isLeap=false
   offset=offset-temp
   i=i+1
  loop while offset>0 and i<=13
  if offset=0 then
   if leap>0 and i=leap+1 then
    if isLeap=true then
     isLeap=false
     temp=monthDays(ly,i)
    else
     i=i-1
     isLeap=true
     temp=leapDays(ly)
    end if
   else
    temp=monthDays(ly,i)
   end if
  else
   offset=offset+temp
   i=i-1
  end if
  lMonth(0)=i
  if isLeap=true then lMonth(0)=-i 
  lDay=offset+1
  lDays(0)=temp
  
  '计算第二个月的农历信息
  offset=offset+cDays
  offset=offset-temp
  if offset>0 then
   if isLeap=false and leap=i then
    lYear(1)=lYear(0)
    lMonth(1)=-i
    isLeap=true
   else
    i=i+1
    if isLeap=true then isLeap=false
    if i>12 then
     lYear(1)=lYear(0)+1
     lMonth(1)=1
    else
     lYear(1)=lYear(0)
     lMonth(1)=i
    end if
   end if
   if isLeap=true then
    temp=leapDays(lYear(1))
   else
    temp=monthDays(lYear(1),lMonth(1))
   end if
   lDays(1)=temp
   offset=offset-temp
   
   '计算第三个月的农历信息
   if offset>0 then
     if isLeap=false and leap=i then
     lMonth(2)=-i
     isLeap=true
    else
     if isLeap=true then isLeap=false
     i=i+1
     if i>12 then
      lYear(2)=lYear(1)+1
      lMonth(2)=1
     else
      lYear(2)=lYear(1)
      lMonth(2)=i
     end if
    end if
    if isLeap=true then
     temp=leapDays(lYear(2))
    else
     temp=monthDays(lYear(2),lMonth(2))
    end if
    lDays(2)=temp
   end if
  end if
 End Sub
 '获取当月每天农历年月日
 Public Sub GetLunarDate()
  Call GetLunarInfo()
  Dim i,days1,days2
  days1=ldays(0)-lday+1
  days2=days1+ldays(1)
  For i=1 To cdays
   If i<=days1 Then
    LunarDate(i)=Array(lyear(0),lmonth(0),lday+i-1)
   Elseif i<=days2 Then
     LunarDate(i)=Array(lyear(1),lmonth(1),i-days1)
   Else
     LunarDate(i)=Array(lyear(2),lmonth(2),i-days2)
   End if
  Next
  getinfo=True
 End Sub
 '获取当月每天农历日期显示完整版(九月初九、九月初一)
 Public Sub GetLunar()
   Dim i
  If getinfo=false Then Call GetLunarDate()
  For i=1 to cdays
   Lunar(i)=LunarMonth(LunarDate(i)(1))&LunarDay(LunarDate(i)(2))
  Next
 End Sub
 '获取当月每天农历日期显示简单版(初九、九月大(初一时))
 Public Sub GetSimpleLunar()
  If getinfo=false Then Call GetLunarDate()
  Dim i,mm,days
  For i=1 to cdays
   If LunarDate(i)(2)=1 Then
     mm=LunarDate(i)(1)
    If mm>0 Then days=monthDays(LunarDate(i)(0),mm) Else days=leapDays(LunarDate(i)(0))
    If days=30 Then Lunar(i)=LunarMonth(mm)&"大" Else Lunar(i)=LunarMonth(mm)&"小"
   Else
    Lunar(i)=LunarDay(LunarDate(i)(2))
   End If
  Next
 End Sub
 '返回农历y年(干支纪年)
 Public Function LunarYear(lY)
  Dim Gan,Zhi,Shu,yy
  Gan=Array("甲","乙","丙","丁","戊","己","庚","辛","壬","癸")
  Zhi=Array("子","丑","寅","卯","辰","巳","午","未","申","酉","戌","亥")
  Shu=Array("鼠","牛","虎","兔","龙","蛇","马","羊","猴","鸡","狗","猪")
  yy=lY-1900+36
  LunarYear=Gan(yy mod 10)&Zhi(yy mod 12)&"["&Shu(yy mod 12)&"]年"
 End Function
 '返回农历m月
 Public Function LunarMonth(lM)
  Dim nStrM
  nStrM=Array("","正","二","三","四","五","六","七","八","九","十","冬","腊")
  If lM>0 Then
   LunarMonth=nStrM(lM)&"月"
  Else
   LunarMonth="闰"&nStrM(-lM)&"月"
  End If
 End Function
 '返回农历d日
 Public Function LunarDay(lD)
  Dim nStr1,nStr2
  nStr1=Array("","一","二","三","四","五","六","七","八","九","十")
  nStr2=Array("初","十","廿","初十","二十","三十")
  If lD mod 10=0 Then
   LunarDay=nStr2(lD\10+2)
  Else
   LunarDay=nStr2(lD\10)&nStr1(lD mod 10)
  End If
 End Function
 '返回当月节日
 Public Sub GetFestival
  call sFestival(curYear,curMonth)
  call lFestival(curYear,curMonth)
  call tFestival(curYear,curMonth)
  call wFestival(curYear,curMonth)
  call gFestival(curYear,curMonth)
  call rwHoliday(curYear,curMonth)
 End Sub
 '//返回公历m月的放假上班信息
 Private Function rwHoliday(y,m)
   Dim i,d
  For i=0 to UBound(Holidays)
   If Int(Left(Holidays(i),4))=y and Int(Mid(Holidays(i),5,2))=m Then
    d=Int(Mid(Holidays(i),7,2))
    If d>=1 and d<=31 Then Holiday(d)=Mid(Holidays(i),9)
   End If
  Next
 End Function
 '//返回公历m月的节日
 Private Function sFestival(y,m)
  Dim i,d
  For i=0 to UBound(sFtv)
   If Int(Left(sFtv(i),4))<=y and Int(Mid(sFtv(i),5,2))=m Then
    d=Int(Mid(sFtv(i),7,2))
    If d>=1 and d<=31 Then
      Festival(d)=Festival(d)&Mid(sFtv(i),10)&"|"
     If Mid(sFtv(i),9,1)="#" Then Holiday(d)="#"
    End If
   End If
  Next
 End Function
 '//返回公历m月第n个星期w的星期节日
 Private Function wFestival(y,m)
  Dim i,w,k,n,e,d
  For i=0 to UBound(wFtv)
   If Int(Left(wFtv(i),4))<=y and Int(Mid(wFtv(i),5,2))=m Then
    k=Int(Mid(wFtv(i),8,1))
    n=Int(Mid(wFtv(i),7,1))
    if n<5 then
     w=GetWeekday(y,m,1)-1
     if k>=w then d=(k-w+1)+7*(n-1) else d=(k-w+8)+7*(n-1)
    else
     e=GetDays(y,m)
     w=GetWeekday(y,m,e)
     if w>k then
      d=e-(w-k-1)+7*(n-9)
     elseif w<k then
       d=e-(w-k+6)+7*(n-9)
     else
       d=e
     end if
    end if
    Festival(d)=Festival(d)&Mid(wFtv(i),10)&"|"
    If Mid(wFtv(i),9,1)="#" Then Holiday(d)="#"
   End If
  Next
 End Function
 '//返回农历m月d日的节日
 Private Function lFestival(y,m)
  Dim i,mm,dd,t1,d
  For i=0 to UBound(lFtv)
    mm=Int(Mid(lFtv(i),1,2))
   dd=Int(Mid(lFtv(i),3,2))
   If mm=lMonth(0) Then
     if dd=30 and lDays(0)=29 then dd=29
    if dd>=lDay and dd<=lDays(0) then
     d=dd-lDay+1
     Festival(d)=Festival(d)&Mid(lFtv(i),6)&"|"
     If Mid(lFtv(i),5,1)="#" Then Holiday(d)="#"
    end if
   ElseIf mm=lMonth(1) Then
     if dd=30 and lDays(0)=29 then dd=29
    if dd>=1 and dd<=lDays(1)-(lDays(0)-lDay+1) then
      d=dd+(lDays(0)-lDay+1)
      Festival(d)=Festival(d)&Mid(lFtv(i),6)&"|"
     If Mid(lFtv(i),5,1)="#" Then Holiday(d)="#"
    end if
   ELseIf mm=lMonth(2) and dd=1 Then
    d=(lDays(0)-lDay+1)+lDays(1)+1
    Festival(d)=Festival(d)&Mid(lFtv(i),6)&"|"
    If Mid(lFtv(i),5,1)="#" Then Holiday(d)="#"
   End If
  Next
 End Function
 '获取当月节气名称
 Private Function tFestival(sY,sM)
  dim solarTerm,d,t
  solarTerm=Array("小寒","大寒","立春","雨水","惊蛰","春分","清明","谷雨","立夏","小满","芒种","夏至","小暑","大暑","立秋","处暑","白露","秋分","寒露","霜降","立冬","小雪","大雪","冬至") '节气数据
  d=sTerm(sY,(sM-1)*2)
  t=solarTerm((sM-1)*2)
  if t="清明" then t="清明节"
  Festival(d)=Festival(d)&t&"|"
  d=sTerm(sY,(sM-1)*2+1)
  t=solarTerm((sM-1)*2+1)
  Festival(d)=Festival(d)&t&"|"
 End Function
 '返回y年第n个节气为几日(从0小寒起算)
 Private Function sTerm(y,n)
  Dim sTermInfo21,sTermInfo20,sTermYear21,sTermYear20,yy,dd,ss,cc,aa
  sTermInfo21=Array(5.4055,20.12,3.87,18.73,5.63,20.646,4.81,20.1,5.52,21.04,5.678,21.37,7.108,22.83,7.5,23.13,7.646,23.042,8.318,23.438,7.438,22.36,7.18,21.94)
  sTermInfo20=Array(6.11,20.84,4.15,18.74,5.63,20.646,5.59,20.888,6.318,21.86,6.5,22.20,7.928,23.65,8.35,23.95,8.44,23.822,9.098,24.218,8.218,23.08,7.9,22.60)
  sTermYear21=Array(-2019,2082,0,-2026,0,2084,0,0,0,2088,0,0,2016,0,2002,0,0,0,0,2089,2089,0,0,-2021)
  sTermYear20=Array(1982,0,0,0,0,0,0,0,1911,0,0,1928,1925,1922,0,0,1927,1942,0,0,0,1978,1954,-1918)
  yy=y mod 100 : dd=0.2422
  If y>2000 Then
    cc=sTermInfo21(n)
   aa=sTermYear21(n)
  Else
    cc=sTermInfo20(n)
   aa=sTermYear20(n)
  End If
  If n<4 Then ss=Int(yy*dd+cc)-Int((yy-1)/4) Else ss=Int(yy*dd+cc)-Int(yy/4)
  If y=abs(aa) Then ss=ss+sgn(aa)
  sTerm=ss
 End Function
 '获取与节气和干支相关的日期信息
 Private Function gFestival(y,m)
  '初伏/中伏/三伏
  If m=7 or m=8 Then
   Dim fu
   fu=Fu1(y)
   If m=7 Then Festival(Day(fu))=Festival(Day(fu))&"初伏|"
   fu=DateAdd("d",10,fu)
   If Month(fu)=m Then Festival(Day(fu))=Festival(Day(fu))&"中伏|"
   fu=Fu3(y)
   If m=8 Then Festival(Day(fu))=Festival(Day(fu))&"三伏|"
  End If
  
  '复活节
  If m=3 or m=4 Then
   Dim east
    east=Easter(y)
   If Month(east)=m Then Festival(Day(east))=Festival(Day(east))&"复活节|"
  End If
  
  '数九
  If m=12 or m<=3 Then
   Dim jiu,Jius,i,yy
   Jius=Array("一九","二九","三九","四九","五九","六九","七九","八九","九九")
   If m=12 Then yy=y Else yy=y-1
   For i=0 to 8
     If i=0 Then jiu=DateSerial(y,12,sTerm(y,23)) Else jiu=DateAdd("d",9,jiu)
     If Month(jiu)=m Then Festival(Day(jiu))=Festival(Day(jiu))&Jius(i)&"|"
   Next
  End If
 End Function
 '初伏
 Private Function Fu1(y)
   Dim term,gan,dd
  term=DateSerial(y,6,sTerm(y,11)) '夏至日
  gan=(DateDiff("d",#1900-1-1#,term)+10) mod 10
  If gan<6 Then dd=DateAdd("d",6-gan+20,term) Else dd=DateAdd("d",16-gan+20,term)
  Fu1=dd
 End Function
 '三伏
 Private Function Fu3(y)
   Dim term,gan,dd
  term=DateSerial(y,8,sTerm(y,14)) '立秋日
  gan=(DateDiff("d",#1900-1-1#,term)+10) mod 10
  If gan<6 Then
   dd=DateAdd("d",6-gan,term)
  Else
   dd=DateAdd("d",16-gan,term)
  End If
  Fu3=dd
 End Function
 '复活节
 Private Function Easter(y)
   Dim n,a,q,b,m,w,e
  n=y-1900
  a=n mod 19
  q=n \ 4
  b=(7*a+1)\19
  m=(11*a+4-b) mod 29
  w=(n+q+31-m) mod 7
  e=25-m-w
  Easter=DateAdd("d",e,DateSerial(y,3,31))
 End Function
 '获取农历y年干支(0-59,0为甲子)
 Private Function cyclicalYear(y)
   cyclicalYear=(y-1900+36) mod 60
 End Function
 '获取农历y年m月干支(0-59,0为甲子)
 Private Function cyclicalMonth(y,m)
   cyclicalMonth=((y-1900)*12+m+12) mod 60
 End Function
 '获取农历y年m月d日干支(0-59,0为甲子)
 Private Function cyclicalDay(y,m,d)
  cyclicalDay=DateDiff("d",#1900-1-1#,DateSerial(y,m,d))+10
 End Function
 '获取星期几
 Public Function GetWeekday(y,m,d)
  GetWeekday=Weekday(DateSerial(y,m,d),2)
 End Function
 '获取中文星期几
 Public Function GetWeek(w)
  Dim nStr1
  nStr1=Array("","一","二","三","四","五","六","日")
  GetWeek="星期"&nStr1(w)
 End Function
 '获取公历y年m月的天数
 Public Function GetDays(y,m)
  Dim Days
  Days=Array(0,31,28,31,30,31,30,31,31,30,31,30,31)
  GetDays=Days(m)
  If m=2 And IsLeap(y) Then GetDays=GetDays+1
 End Function
 '判断公历y年是否闰年
 Public Function IsLeap(y)
  If (y mod 400=0) Or ((y mod 4=0) And (y mod 100<>0)) Then IsLeap=True Else IsLeap=False
 End Function
 '返回农历y年的总天数
 Private Function lYearDays(y)
  dim sum,i
  sum=348
  for i=1 to 12
   sum=sum+int(get1(LunarInfo(y-1900),i))
  next
  sum=sum+leapdays(y)
  lyeardays=sum
 End Function
 '返回农历y年闰哪个月(1-12,无闰月返回0)
 Private Function leapMonth(y)
  dim lmon,i,l
  lmon=get4(LunarInfo(y-1900))
  if lmon="1111" then
   leapMonth=0
  else
   leapMonth=0
   for i=1 to 4
    l=int(mid(lmon,i,1))
    leapMonth=leapMonth+l*2^(4-i)
   next
  end if
 End Function
 '返回农历y年闰月的天数
 Private Function leapDays(y)
  if leapMonth(y) then
   if get4(LunarInfo(y-1899))="1111" then leapDays=30 else leapDays=29
  else
   leapDays=0
  end if
 End Function
 '返回农历y年m月的天数(不是闰月)
 Private Function monthDays(y,m)
  if get1(LunarInfo(y-1900),m)="1" then monthDays=30 else monthDays=29
 End Function
 '返回农历y年m月下个月份,其中m如果为负,则为闰月
 Public Function nextMonth(y,m)
  if m<0 then
   nextMonth=-m+1
  else
   if m=leapMonth(y) then nextMonth=-m else nextMonth=m+1
  end if
  if nextMonth>12 then nextMonth=1
 End Function
 '**十进制数n转换成二进制数
 private function to2(n)
  dim s,i,m
  s=array("0000","0001","0010","0011","0100","0101","0110","0111","1000","1001","1010","1011","1100","1101","1110","1111")
  for i=1 to 4
   m=mid(n,i,1)
   to2=to2&s(cint("&H"&m))
  next
 end function
 '**获取二进制数n第m位数(共16位)
 private function get1(n,m)
  get1=mid(to2(n),m,1)
 end function
 '**获取二进制数n的后四位数
 private function get4(n)
  get4=right(to2(n),4)
 end function
End Class
%>