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