ASP农历与公历互转类

hlxNongLiGongLi 类:
<%
'##########################################################
'Class hlxNongLiGongLi 用于农历与公历间的相互转换
'本类可处理1950-2050年(农历)之间的公农历转换
'本类不输出错误信息,如输出结果为1900-1-1则意味发生错误。
'编写:SY
'日期:2007-12-18
'网址:http://www.oneti.cn/hlx/
'邮箱:sunyi3210@163.com
'版权:可自由传播,请保留所有版权及注释信息
'应用示例:
' Dim hlxNongGong
' Set hlxNongGong = New hlxNongLiGongLi

'公历转农历(查询日期范围1950-2-17至2051-2-10,格式yyyy-mm-dd)
' Response.Write NongGong.GongToNong("1984-12-10")

'农历转公历(查询日期范围1950-1-1至2050-12-29,格式yyyy-mm-dd,Ntype为"闰"或"1",表示查询农历的月份是闰月;Ntype为""或其他值,表示不是闰月)
' Response.Write NongGong.NongToGong("1984-10-18",Ntype)
'##########################################################

Class hlxNongLiGongLi

    Dim GongLi(12),NongLiStart,NongLi(100)

    Sub Class_Initialize()
    '定义公历月份天数
    GongLi(1)=31
    GongLi(2)=28
    GongLi(3)=31
    GongLi(4)=30
    GongLi(5)=31
    GongLi(6)=30
    GongLi(7)=31
    GongLi(8)=31
    GongLi(9)=30
    GongLi(10)=31
    GongLi(11)=30
    GongLi(12)=31

    '定义农历数据
    NongLiStart=1950    '农历从1950年开始
    '差:该年的农历正月初一到该年公历1月1日的天数;1~12:农历月份天数;闰:如有闰月,记录该月平月天数
            '  差  1  2  3  4  5  6  7  8  9 10 11 12 闰
    NongLi(0)="47,29,30,30,29,30,30,29,29,30,29,30,29"
    NongLi(1)="36,30,29,30,30,29,30,29,30,29,30,29,30"
    NongLi(2)="26,29,30,29,30,59,29,30,30,29,30,29,30,29"    '五月29 闰五月30
    NongLi(3)="44,29,30,29,29,30,30,29,30,30,29,30,29"
    NongLi(4)="33,30,29,30,29,29,30,29,30,30,29,30,30"
    NongLi(5)="23,29,30,59,29,29,30,29,30,29,30,30,30,29"    '三月29 闰三月30
    NongLi(6)="42,29,30,29,30,29,29,30,29,30,29,30,30"
    NongLi(7)="30,30,29,30,29,30,29,29,59,30,29,30,29,30"    '八月30 闰八月29
    NongLi(8)="48,30,30,30,29,30,29,29,30,29,30,29,30"
    NongLi(9)="38,29,30,30,29,30,29,30,29,30,29,30,29"
    NongLi(10)="27,30,29,30,29,30,59,30,29,30,29,30,29,30"    '六月30 闰六月29
    NongLi(11)="45,30,29,30,29,30,29,30,30,29,30,29,30"
    NongLi(12)="35,29,30,29,29,30,29,30,30,29,30,30,29"
    NongLi(13)="24,30,29,30,58,30,29,30,29,30,30,30,29,29"    '四月29 闰四月29
    NongLi(14)="43,30,29,30,29,29,30,29,30,29,30,30,30"
    NongLi(15)="32,29,30,29,30,29,29,30,29,29,30,30,29"
    NongLi(16)="20,30,30,59,30,29,29,30,29,29,30,30,29,30"    '三月30 闰三月29
    NongLi(17)="39,30,30,29,30,30,29,29,30,29,30,29,30"
    NongLi(18)="29,29,30,29,30,30,29,59,30,29,30,29,30,30"    '七月30 闰七月29
    NongLi(19)="47,29,30,29,30,29,30,30,29,30,29,30,29"
    NongLi(20)="36,30,29,29,30,29,30,30,29,30,30,29,30"
    NongLi(21)="26,29,30,29,29,59,30,29,30,30,30,29,30,30"    '五月30 闰五月29
    NongLi(22)="45,29,30,29,29,30,29,30,29,30,30,29,30"
    NongLi(23)="33,30,29,30,29,29,30,29,29,30,30,29,30"
    NongLi(24)="22,30,30,29,59,29,30,29,29,30,30,29,30,30"    '四月30 闰四月29
    NongLi(25)="41,30,30,29,30,29,29,30,29,29,30,29,30"
    NongLi(26)="30,30,30,29,30,29,30,29,59,29,30,29,30,30"    '八月30 闰八月29
    NongLi(27)="48,30,29,30,30,29,30,29,30,29,30,29,29"
    NongLi(28)="37,30,29,30,30,29,30,30,29,30,29,30,29"
    NongLi(29)="27,30,29,29,30,29,60,29,30,30,29,30,29,30"    '六月30 闰六月30
    NongLi(30)="46,30,29,29,30,29,30,29,30,30,29,30,30"
    NongLi(31)="35,29,30,29,29,30,29,29,30,30,29,30,30"
    NongLi(32)="24,30,29,30,58,30,29,29,30,29,30,30,30,29"    '四月29 闰四月29
    NongLi(33)="43,30,29,30,29,29,30,29,29,30,29,30,30"
    NongLi(34)="32,30,29,30,30,29,29,30,29,29,59,30,30,30"    '十月30 闰十月29
    NongLi(35)="50,29,30,30,29,30,29,30,29,29,30,29,30"
    NongLi(36)="39,29,30,30,29,30,30,29,30,29,30,29,29"
    NongLi(37)="28,30,29,30,29,30,59,30,30,29,30,29,29,30"    '六月30 闰六月29
    NongLi(38)="47,30,29,30,29,30,29,30,30,29,30,30,29"
    NongLi(39)="36,30,29,29,30,29,30,29,30,29,30,30,30"
    NongLi(40)="26,29,30,29,29,59,29,30,29,30,30,30,30,30"    '五月30 闰五月29
    NongLi(41)="45,29,30,29,29,30,29,29,30,29,30,30,30"
    NongLi(42)="34,29,30,30,29,29,30,29,29,30,29,30,30"
    NongLi(43)="22,29,30,59,30,29,30,29,29,30,29,30,29,30"    '三月30 闰三月29
    NongLi(44)="40,30,30,30,29,30,29,30,29,29,30,29,30"
    NongLi(45)="30,29,30,30,29,30,29,30,59,29,30,29,30,30"    '八月30 闰八月29
    NongLi(46)="49,29,30,29,30,30,29,30,29,30,30,29,29"
    NongLi(47)="37,30,29,30,29,30,29,30,30,29,30,30,29"
    NongLi(48)="27,30,29,29,30,58,30,30,29,30,30,29,30,29"    '五月29 闰五月29
    NongLi(49)="46,30,29,29,30,29,29,30,29,30,30,30,29"
    NongLi(50)="35,30,30,29,29,30,29,29,30,29,30,30,29"
    NongLi(51)="23,30,30,29,59,30,29,29,30,29,30,29,30,30"    '四月30 闰四月29
    NongLi(52)="42,30,30,29,30,29,30,29,29,30,29,30,29"
    NongLi(53)="31,30,30,29,30,30,29,30,29,29,30,29,30"
    NongLi(54)="21,29,59,30,30,29,30,29,30,29,30,29,30,30"    '二月30 闰二月29
    NongLi(55)="39,29,30,29,30,29,30,30,29,30,29,30,29"
    NongLi(56)="28,30,29,30,29,30,29,59,30,30,29,30,30,30"    '七月30 闰七月29
    NongLi(57)="48,29,29,30,29,29,30,29,30,30,30,29,30"
    NongLi(58)="37,30,29,29,30,29,29,30,29,30,30,29,30"
    NongLi(59)="25,30,30,29,29,59,29,30,29,30,29,30,30,30"    '五月30 闰五月29
    NongLi(60)="44,30,29,30,29,30,29,29,30,29,30,29,30"
    NongLi(61)="33,30,29,30,30,29,30,29,29,30,29,30,29"
    NongLi(62)="22,30,29,30,59,30,29,30,29,30,29,30,29,30"    '四月30 闰四月29
    NongLi(63)="40,30,29,30,29,30,30,29,30,29,30,29,30"
    NongLi(64)="30,29,30,29,30,29,30,29,30,59,30,29,30,30"    '九月30 闰九月29
    NongLi(65)="49,29,30,29,29,30,29,30,30,30,29,30,29"
    NongLi(66)="38,30,29,30,29,29,30,29,30,30,29,30,30"
    NongLi(67)="27,29,30,29,30,29,59,29,30,29,30,30,30,29"    '六月29 闰六月30
    NongLi(68)="46,29,30,29,30,29,29,30,29,30,29,30,30"
    NongLi(69)="35,30,29,30,29,30,29,29,30,29,29,30,30"
    NongLi(70)="24,29,30,30,59,30,29,29,30,29,30,29,30,30"    '四月30 闰四月29
    NongLi(71)="42,29,30,30,29,30,29,30,29,30,29,30,29"
    NongLi(72)="31,30,29,30,29,30,30,29,30,29,30,29,30"
    NongLi(73)="21,29,59,29,30,30,29,30,30,29,30,29,30,30"    '二月30 闰二月29
    NongLi(74)="40,29,30,29,29,30,29,30,30,29,30,30,29"
    NongLi(75)="28,30,29,30,29,29,59,30,29,30,30,30,29,30"    '六月30 闰六月29
    NongLi(76)="47,30,29,30,29,29,30,29,29,30,30,30,29"
    NongLi(77)="36,30,30,29,30,29,29,30,29,29,30,30,29"
    NongLi(78)="25,30,30,30,29,59,29,30,29,29,30,30,29,30"    '五月30 闰五月29
    NongLi(79)="43,30,30,29,30,29,30,29,30,29,29,30,30"
    NongLi(80)="33,29,30,29,30,30,29,30,29,30,29,30,29"
    NongLi(81)="22,29,30,59,30,29,30,30,29,30,29,30,29,30"    '三月30 闰三月29
    NongLi(82)="41,30,29,29,30,29,30,30,29,30,30,29,30"
    NongLi(83)="30,29,30,29,29,30,29,30,29,30,30,59,30,30"    '十一月30 闰十一月29
    NongLi(84)="49,29,30,29,29,30,29,30,29,30,30,29,30"
    NongLi(85)="38,30,29,30,29,29,30,29,29,30,30,29,30"
    NongLi(86)="27,30,30,29,30,29,59,29,29,30,29,30,30,29"    '六月29 闰六月30
    NongLi(87)="45,30,30,29,30,29,29,30,29,29,30,29,30"
    NongLi(88)="34,30,30,29,30,29,30,29,30,29,29,30,29"
    NongLi(89)="23,30,30,29,30,59,30,29,30,29,30,29,29,30"    '五月30 闰五月29
    NongLi(90)="42,30,29,30,30,29,30,29,30,30,29,30,29"
    NongLi(91)="31,29,30,29,30,29,30,30,29,30,30,29,30"
    NongLi(92)="21,29,59,29,30,29,30,29,30,30,29,30,30,30"    '二月30 闰二月29
    NongLi(93)="40,29,30,29,29,30,29,29,30,30,29,30,30"
    NongLi(94)="29,30,29,30,29,29,30,58,30,29,30,30,30,29"    '七月29 闰七月29
    NongLi(95)="47,30,29,30,29,29,30,29,29,30,29,30,30"
    NongLi(96)="36,30,29,30,29,30,29,30,29,29,30,29,30"
    NongLi(97)="25,30,29,30,30,59,29,30,29,29,30,29,30,29"    '五月29 闰五月30
    NongLi(98)="44,29,30,30,29,30,30,29,30,29,29,30,29"
    NongLi(99)="32,30,29,30,29,30,30,29,30,30,29,30,29"
    NongLi(100)="22,29,30,59,29,30,29,30,30,29,30,30,29,29"    '三月29 闰三月30
    End Sub
    
    '公历该月的天数(y:年份; m:月份)
    Function GongliMonth(y,m)
        If m=2 And ((y Mod 400 =0) or (y Mod 4 =0 And y Mod 100 <> 0)) Then
            GongliMonth=29
        Else
            GongliMonth=GongLi(m)
        End If
    End Function

    '农历月份名称转换(m:月份)
    Function NongliMonth(m)
        If m>=1 And m<=12 Then
            MonthStr=",正,二,三,四,五,六,七,八,九,十,十一,十二"
            MonthStr=Split(MonthStr,",")
            NongliMonth=MonthStr(m)
        Else
            NongliMonth=m
        End If
    End Function

    '农历月份名称转换(d:日)
    Function NongliDay(d)
        If d>=1 And d<=30 Then
            DayStr=",初一,初二,初三,初四,初五,初六,初七,初八,初九,初十,十一,十二,十三,十四,十五,十六,十七,十八,十九,二十,廿一,廿二,廿三,廿四,廿五,廿六,廿七,廿八,廿九,三十"
            DayStr=Split(DayStr,",")
            NongliDay=DayStr(d)
        Else
            NongliDay=d
        End If
    End Function

    '公历转农历(Gdate:公历日期)
    Function GongToNong(Gdate)
        If IsDate(Gdate)=False Then
            response.write "<script language=javascript>alert('出错!非日期类型,错误会输出1900-1-1')</script>"
            GongToNong="1900-1-1"
            Exit Function
        End If

        If CDate(Gdate) < #1950-2-17# or CDate(Gdate) > #2051-2-10# Then
            response.write "<script language=javascript>alert('出错!目前公历只支持1950-2-17至2051-2-10,错误会输出1900-1-1')</script>"
            GongToNong="1900-1-1"
            Exit Function
        End If


        Dim Gyear,Gmonth,Gday,Glen,Narr,Nyear,Nmonth,Nday,Ni,Ntype

        Gyear=Year(Gdate)
        Gmonth=Month(Gdate)
        Gday=Day(Gdate)

        Glen=DateDiff("d",Gyear &"-1-1",Gdate)+1    '获取查询日期到当年1月1日的天数
        Narr=Split(NongLi(Gyear-NongLiStart),",")    '获取相应年度农历数据,化成数组Narr
        If Glen<=CInt(Narr(0)) Then
            Nyear=Gyear-1
            Glen=CInt(Narr(0))-Glen
            Narr=Split(NongLi(Nyear-NongLiStart),",")
            If Glen<CInt(Narr(12)) Then
                Nmonth=12
                Nday=CInt(Narr(12))-Glen
            Else
                Nmonth=11
                Glen=Glen-CInt(Narr(12))
                Nday=CInt(Narr(11))-Glen
            End If
        Else
            Nyear=Gyear
            Glen=Glen-CInt(Narr(0))
            For Ni=1 To 12
                If Glen>CInt(Narr(Ni)) Then
                    Glen=Glen-CInt(Narr(Ni))
                Else
                    If Glen>30 Then
                        Glen=Glen-CInt(Narr(13))
                        Ntype="闰"    '闰月
                    End If
                    Nmonth=Ni
                    Nday=Glen
                    Exit For
                End If
            Next
        End If

'        GongToNong="农历"& Nyear &"年"& Ntype & NongliMonth(Nmonth) &"月"& NongliDay(Nday)    '效果:农历2000年(闰)四月初六
'        GongToNong="农历"& Nyear &"年"& Ntype & Nmonth &"月"& Nday &"日"     '效果:农历2000年(闰)4月6日
        GongToNong=Nyear &"-"& Nmonth &"-"& Nday &" "& Ntype         '效果:2000-4-6 (闰)
    End Function

    '农历转公历(Ndate:农历日期; Ntype:是否闰月)
    Function NongToGong(Ndate,Ntype)
        If IsDate(Ndate)=False And Right(Ndate,4)<>"2-29" And Right(Ndate,4)<>"2-30" Then
            response.write "<script language=javascript>alert('出错!非日期类型,错误会输出1900-1-1')</script>"
            NongToGong="1900-1-1"
            Exit Function
        End If
        If CInt(Left(Ndate,4)) < 1950 or Left(Ndate,4) > 2050 Then
            response.write "<script language=javascript>alert('出错!目前农历只支持1950-1-1至2050-12-29,错误会输出1900-1-1')</script>"
            NongToGong="1900-1-1"
            Exit Function
        End If

        Dim Nyear,Nmonth,Nday,Narr,Nlen,Ni,Gyear,Gmonth,Gday,Gi

'        Nyear=Year(Ndate)
'        Nmonth=Month(Ndate)
'        Nday=Day(Ndate)
        '因为农历日期存在2月29或30,故人工截取年、月、日
        Nyear=Split(Ndate,"-")(0)
        Nmonth=Split(Ndate,"-")(1)
        Nday=Split(Ndate,"-")(2)
        If Ntype="闰" or Ntype="1" Then Ntype="闰" Else Ntype=""        '判断查询日期是否是闰月

        Narr=Split(NongLi(Nyear-NongLiStart),",")        '获取相应年度农历数据,化成数组Narr
        If Ntype="闰" And UBound(Narr)<=12 Then
            response.write "<script language=javascript>alert('农历"& Ndate &"无闰月,将按照平月计算')</script>"
        End If

        '如果查询的农历是闰月并该年度农历数组存在闰月数据就获取
        If Narr(Nmonth)>30 And Ntype="闰" And UBound(Narr)>=13 Then
            Nday=CInt(Narr(13))+Nday
        End If

        '获取该年农历日期到公历1月1日的天数
        Nlen=Nday
        For Ni=0 To Nmonth-1
            Nlen=Nlen+CInt(Narr(Ni))
        Next

        If Nlen>366 or (GongliMonth(Nyear,2)<>29 And Nlen>365) Then
        '当查询农历日期距离公历1月1日超过一年时
            Gyear=Nyear+1
            If GongliMonth(Nyear,2)<>29 Then Nlen=Nlen-365 Else Nlen=Nlen-366
            If Nlen>GongLi(1) Then
                Gmonth=2
                Gday=Nlen-GongLi(1)
            Else
                Gmonth=1
                Gday=Nlen
            End If
        Else
            Gyear=Nyear
            For Gi=1 To 12
                If Nlen>GongliMonth(Gyear,Gi) Then
                    Nlen=Nlen-GongliMonth(Gyear,Gi)
                Else
                    Gmonth=Gi
                    Gday=Nlen
                    Exit For
                End If
            Next
        End If

        NongToGong=Gyear &"-"& Gmonth &"-"& Gday
    End Function

End Class
%>

应用示例:

<!--#include file="hlxNongLiGongLi.asp"-->
<%
Dim refType,refDate,mudi,Ntype

refType=request.Form("refType")
refDate=request.Form("refDate")

If refType<>"" And refDate<>"" Then mudi="deal"


Select Case mudi
    Case "deal"
        Dim hlxNongGong
        Set hlxNongGong = New hlxNongLiGongLi

            If refType="公历" Then
        Response.Write refType &":"& refDate &" -》 农历:"& hlxNongGong.GongToNong(refDate)
            Else
        If InStr(refType,"闰")<>0 Then Ntype="闰" Else Ntype=""
        Response.Write refType &":"& refDate &" -》 公历:"& hlxNongGong.NongToGong(refDate,Ntype)
            End If
        Response.Write "<br><br><br><a href='javascript:history.back()'>[返回]</a>"

    Case Else
%>
<h3 align=center>公历与农历互转</h3><br><br>

<script language=javascript>
//检测查询日志表单
function CheckForm(form){
    if (form.refDate.value == "")
        {alert("查询日期不能为空");form.refDate.focus();return false}
}
</script>


<center>
<form method=post onsubmit="return CheckForm(this)">
    <select name="refType"><option value="公历">公历</option><option value="农历">农历</option><option value="农历(闰月)">农历(闰月)</option></select>
    <input type="text" name="refDate" size=15>
    <input type="submit" value="查询">
</form>

<br><br>
<font color=red>提示:查询日期格式为yyyy-mm-dd,如2000-5-9,1998-11-25等</font>
</center>
<%
End Select
%>


评论: 0 | 引用: 0 | 查看次数: 3532
发表评论
登录后再发表评论!