优游旧版用户登录

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

[原创]ASP2014新版公历转农历的类

2014/5/6 14:15:56 作者:站长日记 来源:八百站长 优游旧版用户登录:5171次

摘要:ASP版公历转农历类从js版转换过来,支持1901-2099年公历转农历。公历类可以输出年、月、日、星期,当天的公历节日和节气。农历类可以输出年、月、日、是否闰月,当天的农历节日。

ASP版公历转农历类从js版转换过来,支持1901-2099年公历转农历。公历类可以输出年、月、日、星期,当天的公历节日和节气。农历类可以输出年、月、日、是否闰月,当天的农历节日。

<%
'////优游旧版用户登录公历年、月、日、星期的ASP类//////////////////////////////////////////
'Dim solar
'Set solar=New SolarClass        '默认日期为今天
'solar.sDate=#2014-5-6#          '或solar.setDate(2014,5,6)
'Response.Write solar.sYear      '输出年:2014
'Response.Write solar.sMonth     '输出月:5
'Response.Write solar.sDay       '输出日:6
'Response.Write solar.sWeek      '输出星期:3(3为星期二,星期日为1)
'Response.Write solar.YYMMDD()   '输出2014-05-06
'Response.Write solar.GetDate()  '输出2014年5月6日
'Response.Write solar.GetWeek()  '输出星期二
'Response.Write solar.GetSFtv()  '输出公历当天节日
'Response.Write solar.GetTerm()  '输出公历当天节气
'Set solar=Nothing
'/////////////////////////////////////////////////////////////////////////////
Class SolarClass
   Private sY,sM,sD,sW,sDa
   
   '//返回公历m月d日的节日
   Private Function sFestival(m,d)
      Dim sFtv,i
      '//公历节日  #表示为重要节日
      '格式:月(mm)+日(dd)
      sFtv=Array("00000101#元旦","00000214 情人节","19100308 三八妇女节","19790312 植树节","19830315 315消费者权益日","15640401 愚人节","19380501#五一劳动节","19500504 五四青年节","19500601 六一儿童节","19210701 七一建党节","19270801 八一建军节","19850910 教师节","19491001#十一国庆节","00001225 圣诞节")
      sFestival=""
      For i=0 to UBound(sFtv)
         If Int(Mid(sFtv(i),5,2))=m and Int(Mid(sFtv(i),7,2))=d Then
            sFestival=sFestival&Mid(sFtv(i),10)&"|"
         End If
      Next
      If sFestival<>"" Then sFestival=Left(sFestival,Len(sFestival)-1)
   End Function
   '//返回公历m月第n个星期w的星期节日
   Private Function wFestival(y,m,d)
      Dim wFtv,i,n,k
      '//公历节日:某月第几个星期几
      '起始年(4位)+月(2位)+第几个(1位1-5)+星期几(1位0-6),倒数第几个用10-n(6-9)
      wFtv=Array("19140520 母亲节","19340630 父亲节","18631144 感恩节")
      wFestival=""
      For i=0 to UBound(wFtv)
         If Int(Mid(wFtv(i),5,2))=m and Int(Mid(wFtv(i),8,1))=GetWeekday(y,m,d) Then
            n=Int(Mid(wFtv(i),7,1))
            k=Int((sD-1)/7)
            If k=n Or k=10-n Then wFestival=wFestival&Mid(wFtv,10)&"|"
         End If
      Next
      If wFestival<>"" Then wFestival=Left(wFestival,Len(wFestival)-1)
   End Function
   '优游旧版用户登录公历节日
   Public Function GetSFtv
      Dim Ftv1,Ftv2
      Ftv1=sFestival(sM,sD)
      Ftv2=wFestival(sY,sM,sD)
      If Ftv2="" Then
         GetSFtv=Ftv1
      ElseIf Ftv1="" Then
         GetSFtv=Ftv2
      Else
         GetSFtv=Ftv1&"|"&Ftv2
      End If
   End Function
   '初始化
   Private Sub Class_Initialize() 
      sDa=Date()
      Call YMD(sDa)
    End Sub
   Public Property Get sYear 
      sYear = sY
   End Property 
   Public Property Get sMonth
      sMonth = sM
   End Property 
   Public Property Get sDay 
      sDay = sD
   End Property
   Public Property Get sWeek 
      sWeek = sW
   End Property
   Public Property Get sDate 
      sDate = sDa
   End Property
   '给日期赋值(日期型da)
   Public Property Let sDate(ByVal da) 
      If VarType(da)=7 And (Year(da)>=1900 And Year(da)<=2100) Then sDa=da Else sDa=Date()
      Call YMD(sDa)
   End Property 
   '设置日期(y,m,d)
   Public Sub SetDate(ByVal y,ByVal m,ByVal d)
      If (y>=1900 And y<=2100) And (m>=1 And m<=12) And (d>=1 And d<=GetDays(y,m)) Then
         sDa=DateSerial(y,m,d)
      Else
         sDa=Date()
      End If
      Call YMD(sDate)
   End Sub
   '优游旧版用户登录年、月、日
   Private Sub YMD(da)
      sY=Year(da)
      sM=Month(da)
      sD=Day(da)
      sW=Weekday(da)
   End Sub
   '优游旧版用户登录星期几
   Private Function GetWeekday(y,m,d)
      GetWeekday=Weekday(DateSerial(y,m,d))
   End Function
   '优游旧版用户登录中文星期几
   Public Function GetWeek
      Dim nStr1
      nStr1=Array("日","一","二","三","四","五","六")
      GetWeek="星期"&nStr1(sW-1)
   End Function
   '优游旧版用户登录日期格式YYYYMMDD(字符串,分隔符"-")
   Public Function YYMMDD
      YYMMDD=sY&"-"&bu0(sM,2)&"-"&bu0(sD,2)
   End Function
   '优游旧版用户登录中文日期
   Public Function GetDate
      GetDate=sY&"年"&sM&"月"&sD&"日"
   End Function
   '优游旧版用户登录公历y年m月的天数
   Private 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年是否闰年
   Private 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
   '优游旧版用户登录当日节气名称
   Public Function GetTerm
      dim solarTerm,t1,t2
      solarTerm=Array("小寒","大寒","立春","雨水","惊蛰","春分","清明","谷雨","立夏","小满","芒种","夏至","小暑","大暑","立秋","处暑","白露","秋分","寒露","霜降","立冬","小雪","大雪","冬至")   '节气数据
      GetTerm=""
      t1=sTerm(sY,(sM-1)*2)
      t2=sTerm(sY,(sM-1)*2+1)
      if t1=sD then GetTerm=solarTerm((sM-1)*2)
      if t2=sD then GetTerm=solarTerm((sM-1)*2+1)
      if GetTerm="清明" then GetTerm="清明节"
   End Function
   '返回y年第n个节气为几日(从0小寒起算)
   Private Function sTerm(y,n)
      Dim sTermInfo,offDate
      sTermInfo = Array(0,21208,42467,63836,85337,107014,128867,150921,173149,195551,218072,240693,263343,285989,308563,331033,353350,375494,397447,419210,440795,462224,483532,504758)   '节气数据
      offDate=((31556925974.7*(y-1900)+sTermInfo(n)*60000)-2208549300000)
      sTerm=Day(DateAdd("s",offdate/1000,#1970-1-1#))
   End Function
   '前补0
   private function bu0(s,n)
      if len(s)<n then bu0=string(n-len(s),"0")&s else bu0=s
   end function
End Class
%>
<%
'////优游旧版用户登录农历年、月、日、是否闰月的ASP类//////////////////////////////////////
'Dim lunar
'Set lunar=New LunarClass        '默认日期为今天
'lunar.sDate=#2014-5-6#          '或lunar.setDate(2014,5,6)
'Response.Write lunar.lYear      '输出农历年:2014
'Response.Write lunar.lMonth     '输出农历月:4
'Response.Write lunar.lDay       '输出农历日:8
'Response.Write lunar.lLeap      '输出是否闰月:False(若为True表示为闰四月)
'Response.Write lunar.MMDD()     '输出四月初八
'Response.Write lunar.GetLDate() '输出甲午[马]年四月初八
'Response.Write lunar.GetLFtv()  '输出农历当天节日
'Set lunar=Nothing
'/////////////////////////////////////////////////////////////////////////////
Class LunarClass
   Private lY,lM,lD,lP,sDa
   Private LunarInfo
   
   '//返回农历m月d日的节日
   Private Function lFestival(y,m,d)
      Dim lFtv,i
      '//农历节日 99表示该月最后一天(29或30不定)
      '格式:月(mm)+日(dd)
      lFtv=Array("0101*春节","0115 元宵节","0505*端午节","0707 七夕情人节","0815*中秋节","0909 重阳节老人节","1208 腊八节","1223 祭灶","1299*除夕")
      lFestival=""
      For i=0 to UBound(lFtv)
         If Int(Mid(lFtv(i),1,2))=m Then
            If Int(Mid(lFtv(i),3,2))=d Or (Mid(lFtv(i),3,2)="99" And monthDays(y,m)=d) Then
               lFestival=lFestival&Mid(lFtv(i),6)&"|"
            End If
         End If
      Next
      If lFestival<>"" Then lFestival=Left(lFestival,Len(lFestival)-1)
   End Function
   '优游旧版用户登录公历节日
   Public Function GetLFtv
      GetLFtv=lFestival(lY,lM,lD)
   End Function
   '初始化
   Private Sub Class_Initialize()
      '以下信息不可更改
      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年
      sDa=Date()
      Call GetLunar(sDa)
    End Sub
   Public Property Get lYear 
      lYear = lY
   End Property 
   Public Property Get lMonth
      lMonth = lM
   End Property
   Public Property Get lDay 
      lDay = lD
   End Property 
   Public Property Get lLeap
      lLeap = lP
   End Property 
   Public Property Get sDate
      sDate = sDa
   End Property 
   '给日期赋值(日期型da、公历)
   Public Property Let sDate(ByVal da) 
      If VarType(da)=7 And (Year(da)>=1901 And Year(da)<=2099) Then sDa=da Else sDa=Date()
      Call GetLunar(sDa)
   End Property
   '设置日期(公历年月日y,m,d)
   Public Sub SetDate(y,m,d)
      If (y>=1901 And y<=2099) And (m>=1 And m<=12) And (d>=1 And d<=GetDays(y,m)) Then
         sDa=DateSerial(y,m,d)
      Else
         sDa=Date()
      End If
      Call GetLunar(sDa)
   End Sub
   '算出农历,返回农历日期(年lY, 月lM, 日lD, 是否闰月lP)
   Private Function GetLunar(objDate)
      dim i,leap,temp
      leap=0: temp=0
      dim baseDate,offset baseDate=DateSerial(1900,1,31)
      offset=DateDiff("d",baseDate,objDate)
      for i=1900 to 2099
         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
      lY=i
      leap=leapMonth(i)
      isLeap=false
      for i=1 to 13
         if offset<=0 then exit for
         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
      next
      if offset=0 and leap>0 and i=leap+1 then
         if isLeap then
            isLeap=false
         else
            isLeap=true
            i=i-1
         end if
      end if
      if offset<0 then
         offset=offset+temp
         i=i-1
      end if
      lM=i
      lD=offset+1
      lP=isLeap
   End Function
   '返回干支年
   Private Function Cyclical(y)
      Dim Gan,Zhi,Shu
      Gan=Array("甲","乙","丙","丁","戊","己","庚","辛","壬","癸")
      Zhi=Array("子","丑","寅","卯","辰","巳","午","未","申","酉","戌","亥")
      Shu=Array("鼠","牛","虎","兔","龙","蛇","马","羊","猴","鸡","狗","猪")
      yy=y-1900+36
      Cyclical=Gan(yy mod 10)&Zhi(yy mod 12)&"["&Shu(yy mod 12)&"]年"
   End Function
   '返回农历m月d日
   Public Function MMDD
      Dim nStr1,nStr2,nStrM
      nStr1=Array("日","一","二","三","四","五","六","七","八","九","十")
      nStr2=Array("初","十","廿","卅","初十","二十","三十")
      nStrM=Array("","正","二","三","四","五","六","七","八","九","十","冬","腊")
      If lD mod 10=0 Then
         MMDD=nStrM(lM)&"月"&nStr2(lD\10+3)
      Else
         MMDD=nStrM(lM)&"月"&nStr2(lD\10)&nStr1(lD mod 10)
      End If
      If lP Then MMDD="闰"&MMDD
   End Function
   '返回完整农历日期
   Public Function GetLDate
      GetLDate=Cyclical(lY)&MMDD
   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 lm,i,l
      lm=get4(LunarInfo(y-1900))
      if lm="1111" then
         leapMonth=0
      else
         leapMonth=0
         for i=1 to 4
            l=int(mid(lm,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
   '**十进制数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
   '返回公历y年m月的天数
   private 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年是否闰年
   private 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
End Class
%>
上一篇: 没有了 下一篇: [原创]ASP中上一篇下一篇的导航代码怎么写