[原创]ASP2015新版日历显示类
2015/7/21 23:03:57 作者:站长日记 来源:八百站长 浏览:3261次
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 %>
上一篇:
关于UEditor ASP版本传到虚拟空间后无法上传的奇葩问题
下一篇:
没有了