以前收集的一些资料—使用ASP编写农历算法(一)

                 使用asp编写农历算法          
    新年将近，呵呵，写了一个阴历和阳历的asp程序，就当给大家的新年贺礼
（呵呵，这下蓝先生满意啦把，就当我送给你的圣诞礼物把。。。）
希望大家能够喜欢。。。大家可以很方便的将这个农历加入到自己的主页中
中国人使用中国人自己的日历，呵呵，希望大家以后能够支持chinaasp的
共同进步。。。
一共两个文件cal.asp和cal2.inc(主要是常量的定义)
cal.asp代码如下
<!–#include virtual="cal2.inc"–>
<%
function gongdataisvalid(m_date)
    if not isdate(m_date) then
        gongdataisvalid = false
        exit function
    else
        if year(m_date) >1950 and year(m_date) < 2050 then
            gongdataisvalid = true
            exit function
        else
            if year(m_date)=1950 then
                if month(m_date)>2 then
                    gongdataisvalid = true
                    exit function
                else
                    if month(m_date)=2 then
                        if day(m_date) > 16 then
                            gongdataisvalid = true
                            exit function
                        end if
                    end if
                end if
            end if
        end if
    end if
    gongdataisvalid = false
end function

function nongdataisvalid(m_date)
    if year(m_date) > 1949 and year(m_date) < 2049 then
        nongdataisvalid = true
        exit function
    else
        if year(m_date)=2049 then
            if month(m_date.month) < 12 then
                nongdataisvalid = true
                exit function
            else
                if month(m_date)=12 then
                    if day(m_date) < 8 then
                        nongdataisvalid = true
                        exit function
                    end if
                end if
            end if
        end if
    end if
    nongdataisvalid = false
end function

function converttogongli(m_nongli)
    dim days
    dim years
    dim alldays
    dim result
    
    days    = daysfromspringday(m_nongli)
    days    = days + getdaysfromstart(year(m_nongli))
    years   = year(m_nongli)        
    alldays = getgongyeardays(years)    
    if days > alldays then        
        days = days – alldays
        years = years + 1
    end if
    result  = calgongdate(years,days)    
    converttogongli = result
end function

function converttonongli(m_gongli)
    dim days
    dim years
    dim alldays
    dim result
    
    days    = daysfromnewyear(m_gongli)    
    alldays = getdaysfromstart(year(m_gongli))    
    years   = year(m_gongli)    
    if days <= alldays then        
        years = years – 1
        days  = days + getgongyeardays(years)    
    end if
    days = days – getdaysfromstart(years)
    result = calnongdate(years,days)    
    converttonongli = result
end function

function getdateafterdays(m_first,m_days)
    dim m_firstdays
    m_firstdays = daysfromnewyear(m_first) + m_days
    getdateafterdays = calgongdate(year(m_first),m_firstdays)
end function

function calgongdate(years,days)
    dim resultday,resultyear,resultmonth
    dim caldays
    caldays = 0
    resultyear = years
    for i=1 to 13 – 1
        caldays =caldays + getgongmonthdays(years,i)
        if caldays>=days then
            caldays = caldays – getgongmonthdays(year,i)
            resultmonth = i
            resultday=days-caldays
            exit for
        end if
    next
    calgongdate=resultyear & "-" & resultmonth & "-" & resultday
end function

function calnongdate(years,days)
    dim resultday,resultyear,resultmonth
    dim caldays
    caldays = 0
    
    resultyear = years
    isrunyue = false

    for i=1 to 12
        caldays = caldays + getnotrunnongmonthdays(years,i)    
        if caldays>=days then    
            caldays = caldays – getnotrunnongmonthdays(years,i)
            resultmonth = i
            resultday = days – caldays
            isrunyue = false
            exit for
        else
            if getnongrunyue(years) = i then   
                caldays = caldays + getnongrunyuedays(years)
                if caldays>=days then
                    caldays = caldays – getnongrunyuedays(years)
                    resultmonth = i
                    resultday = days – caldays
                    isrunyue = true
                    exit for
                end if
            end if
        end if
    next
    calnongdate=resultyear & "-" & resultmonth & "-" & resultday
end function

function getgongmonthdays(years,months)
    getgongmonthdays = 30
    if months = 2 then
        if yearisrunnian(years) then
            getgongmonthdays = 29
        else
            getgongmonthdays = 28
        end if
    else
        if gongmonthislarge(months) then
            getgongmonthdays = 31
        else
            getgongmonthdays = 30
        end if
    end if
end function

function getnonglidayname(mdays)
    dim i,j

    i = instr(mdays,"-")
    j = instr(i+1,mdays,"-")
    getnonglidayname = right(mdays,len(mdays) – j)
    getnonglidayname = nonglidayname(int(getnonglidayname) – 1)
end function

function getnonglimonthname(mdays)
    dim i,j

    i = instr(mdays,"-")
    j = instr(i+1,mdays,"-")
    getnonglimonthname = mid(mdays,i+1,j-i-1)
    getnonglimonthname = nonglimonthname(int(getnonglimonthname) – 1)
end function

function getnotrunnongmonthdays(years,months)
    if nongmonthislarge(years,months) then
        getnotrunnongmonthdays = 30
    else
        getnotrunnongmonthdays = 29
    end if
end function

function getnongmonthdays(years,months,m_run)
    dim days
    days = 0
    if m_run then
        days = getnongrunyuedays(years)
    else
        days = getnotrunnongmonthdays(years,months)
    end if
    getnongmonthdays = days
end function

function getgongyeardays(years)
    if yearisrunnian(years) then
        getgongyeardays = 366
    else
        getgongyeardays = 365
    end if
end function

function getnongyeardays(years)
    dim days
    days = 0
    for i=1 to 12
        days =days + getnongmonthdays(years,i,false)
    next
    days =days + getnongrunyuedays(years)
    getnongyeardays = days
end function

function getnongrunyuedays(years)
    if getnongrunyue(years) =0 then
        getnongrunyuedays = 0
        exit function
    end if
    if runyueislarge(years) then
        getnongrunyuedays = 30
    else
        getnongrunyuedays = 29
    end if
end function

function daysfromnewyear(m_day)
    dim days
    days = 0
    for i=1 to month(m_day) – 1
        days = days + getgongmonthdays(year(m_day),i)
    next
    days = days + day(m_day)
    daysfromnewyear = days
end function
function  daysfromspringday(m_day)
    dim days
    dim months
    days   = 0
    months = getnongrunyue(year(m_day))    
    if months < month(m_day) then            
        days = days + getnongrunyuedays(year(m_day))
    else
        if((months=month(m_day)) and isrunyue) then    
            days = days + getnongrunyuedays(year(m_day))
        end if
    end if
    for i=1 to month(m_day)
        days = days + getnongmonthdays(year(m_day),i,false)
    next
    days = days + day(m_day)
    daysfromspringday = days
end function

function cal2n(n)
    cal2n = 1
    for i=0 to n – 1
        cal2n = cal2n * 2
    next
end function

function getnnamein60(index)
    dim shengxiao
    dim tiangan
    dim dizhi
    dim buffer
    dim m_cur,m_this,tian,di
    shengxiao = array("鼠","牛","虎","兔","龙","蛇","马","羊","猴","鸡","狗","猪")
    tiangan   = array("甲","乙","丙","丁","戊","己","庚","辛","壬","癸")
    dizhi     = array("子","丑","寅","卯","辰","巳","午","未","申","酉","戌","亥")
    
    buffer = "农历"
    
    m_cur  = 0
    m_this = 0
    tian   = 0
    di     = 0
    for i=0 to 60 – 1
        tian = i mod 10
        di   = i mod 12
        if m_this = index then
            buffer = buffer & tiangan(tian)
            buffer = buffer & dizhi(di)
            buffer = buffer & "年，"
            buffer = buffer & shengxiao(di)
            buffer = buffer & "年"
        end if
        m_this = m_this + 1
    next
    getnnamein60 = buffer
end function

function getganzhi(m_nongyear)  
    dim m_index
    m_index = (m_nongyear – 1924) mod 60
    getganzhi = getnnamein60(m_index)
end function

function yearisrunnian(years)
    yearisrunnian = calendardata(years-m_minyear,0) and &h80
end function

function runyueislarge(years)
    runyueislarge = calendardata(years-m_minyear,0) and &h40
end function

function getdaysfromstart(years)
    getdaysfromstart = (calendardata(years-m_minyear,0) and &h3f)
end function

function nongmonthislarge(years,months)
    nongmonthislarge = false
    if(months<9) then
        if(calendardata(years-m_minyear,1) and cal2n(8 – months)) then
            nongmonthislarge = true
        end if
    else
        ch=cal2n(12 – months)
        ch=movebit(ch)
        if(calendardata(years-m_minyear,2) and ch) then    nongmonthislarge = true
    end if
end function

function getnongrunyue(years)
    getnongrunyue = (calendardata(years-m_minyear,2) and &h0f)
end function

function gongmonthislarge(months)
    gongmonthislarge = false
    if months < 8 then
        if (months mod 2) <> 0 then
            gongmonthislarge = true
        end if
    else
        if ((months mod 2) = 0) then
            gongmonthislarge = true
        end if
    end if
end function

%>

<script language="jscript" runat=server>
function movebit(num)
{
    return num<<=4;
}
</script>

<%
dim displaynonglidate
function getdaysinmonth(imonth, iyear)
    select case imonth
        case 1, 3, 5, 7, 8, 10, 12
            getdaysinmonth = 31
        case 4, 6, 9, 11
            getdaysinmonth = 30
        case 2
            if isdate("february 29, " & iyear) then
                getdaysinmonth = 29
            else
                getdaysinmonth = 28
            end if
    end select
end function

function getweekdaymonthstartson(danydayinthemonth)
    dim dtemp
    dtemp = dateadd("d", -(day(danydayinthemonth) – 1), danydayinthemonth)
    getweekdaymonthstartson = weekday(dtemp)
end function

function subtractonemonth(ddate)
    subtractonemonth = dateadd("m", -1, ddate)
end function

function addonemonth(ddate)
    addonemonth = dateadd("m", 1, ddate)
end function

dim ddate     
dim idim      
dim idow      
dim icurrent  
dim iposition

if isdate(request.querystring("date")) then
    ddate = cdate(request.querystring("date"))
else
    if isdate(request.querystring("month") & "-" & request.querystring("day") & "-" & request.querystring("year")) then
        ddate = cdate(request.querystring("month") & "-" & request.querystring("day") & "-" & request.querystring("year"))
    else
        ddate = date()
        
        if len(request.querystring("month")) <> 0 or len(request.querystring("day")) <> 0 or len(request.querystring("year")) <> 0 or len(request.querystring("date")) <> 0 then
            response.write "对不起，你选择的日期非法，日期自动设置为当前日期.<br><br>"
        end if
    end if
end if

idim = getdaysinmonth(month(ddate), year(ddate))
idow = getweekdaymonthstartson(ddate)

%>

<table border=10 cellspacing=0 cellpadding=0>
<tr>
<td>
<table border=1 cellspacing=0 cellpadding=1 bgcolor=#99ccff>
    <tr>
        <td bgcolor=#000099 align="center" colspan=7>
            <table width=100% border=0 cellspacing=0 cellpadding=0>
                <tr>
                    <td align="right"><a href="./cal.asp?date=<%= subtractonemonth(ddate) %>"><font color=#ffff00 size="-1"><<</font></a></td>
                    <td align="center"><font color=#ffff00><b><%= monthname(month(ddate)) & "  " & year(ddate) %>  <%= getganzhi(year(ddate))%></b></font></td>
                    <td align="left"><a href="./cal.asp?date=<%= addonemonth(ddate) %>"><font color=#ffff00 size="-1">>></font></a></td>
                </tr>
            </table>
        </td>
    </tr>
    <tr>
        <td align="center" bgcolor=#0000cc><font color=#ffff00><b>星期日</b></font><br><img src="./images/spacer.gif" width=60 height=1 border=0></td>
        <td align="center" bgcolor=#0000cc><font color=#ffff00><b>星期一</b></font><br><img src="./images/spacer.gif" width=60 height=1 border=0></td>
        <td align="center" bgcolor=#0000cc><font color=#ffff00><b>星期二</b></font><br><img src="./images/spacer.gif" width=60 height=1 border=0></td>
        <td align="center" bgcolor=#0000cc><font color=#ffff00><b>星期三</b></font><br><img src="./images/spacer.gif" width=60 height=1 border=0></td>
        <td align="center" bgcolor=#0000cc><font color=#ffff00><b>星期四</b></font><br><img src="./images/spacer.gif" width=60 height=1 border=0></td>
        <td align="center" bgcolor=#0000cc><font color=#ffff00><b>星期五</b></font><br><img src="./images/spacer.gif" width=60 height=1 border=0></td>
        <td align="center" bgcolor=#0000cc><font color=#ffff00><b>星期六</b></font><br><img src="./images/spacer.gif" width=60 height=1 border=0></td>
    </tr>
<%
if idow <> 1 then
    response.write vbtab & "<tr>" & vbcrlf
    iposition = 1
    do while iposition < idow
        response.write vbtab & vbtab & "<td> </td>" & vbcrlf
        iposition = iposition + 1
    loop
end if

icurrent = 1
iposition = idow
do while icurrent <= idim
    if iposition = 1 then
        response.write vbtab & "<tr>" & vbcrlf
    end if
    
    if icurrent = day(ddate) then
        response.write vbtab & vbtab & "<td bgcolor=#00ffff><font size=""-1""><b>" & icurrent & "</b></font><br>"
        displaynonglidate = converttonongli(formatdatetime(ddate,1))
        response.write vbtab & getnonglimonthname(displaynonglidate) & "月" & getnonglidayname(displaynonglidate) & "<br></td>" & vbcrlf
    else
        response.write vbtab & vbtab & "<td><a href=""./cal.asp?date=" & month(ddate) & "-" & icurrent & "-" & year(ddate) & """><font size=""-1"">" & icurrent & "</font></a><br>"
        displaynonglidate = converttonongli(formatdatetime(year(ddate) & "-" & month(ddate) & "-" & icurrent ,1))
        response.write vbtab & getnonglimonthname(displaynonglidate) & "月" & getnonglidayname(displaynonglidate) & "<br></td>" & vbcrlf
    end if
    
    if iposition = 7 then
        response.write vbtab & "</tr>" & vbcrlf
        iposition = 0
    end if
    
    icurrent = icurrent + 1
    iposition = iposition + 1
loop

if iposition <> 1 then
    do while iposition <= 7
        response.write vbtab & vbtab & "<td> </td>" & vbcrlf
        iposition = iposition + 1
    loop
    response.write vbtab & "</tr>" & vbcrlf
end if
%>
</table>
</td>
</tr>
</table>

<br>

<table border=0 cellspacing=0 cellpadding=0><tr><td align="center">
<form action="./cal.asp" method=get>
<select name="month">
    <option value=1>一月</option>
    <option value=2>二月</option>
    <option value=3>三月</option>
    <option value=4>四月</option>
    <option value=5>五月</option>
    <option value=6>六月</option>
    <option value=7>七月</option>
    <option value=8>八月</option>
    <option value=9>九月</option>
    <option value=10>十月</option>
    <option value=11>十一月</option>
    <option value=12>十二月</option>
</select>
<select name="day">
    <option value=1>1</option>
    <option value=2>2</option>
    <option value=3>3</option>
    <option value=4>4</option>
    <option value=5>5</option>
    <option value=6>6</option>
    <option value=7>7</option>
    <option value=8>8</option>
    <option value=9>9</option>
    <option value=10>10</option>
    <option value=11>11</option>
    <option value=12>12</option>
    <option value=13>13</option>
    <option value=14>14</option>
    <option value=15>15</option>
    <option value=16>16</option>
    <option value=17>17</option>
    <option value=18>18</option>
    <option value=19>19</option>
    <option value=20>20</option>
    <option value=21>21</option>
    <option value=22>22</option>
    <option value=23>23</option>
    <option value=24>24</option>
    <option value=25>25</option>
    <option value=26>26</option>
    <option value=27>27</option>
    <option value=28>28</option>
    <option value=29>29</option>
    <option value=30>30</option>
    <option value=31>31</option>
</select>
<select name="year">
    <option value=1990>1990</option>
    <option value=1991>1991</option>
    <option value=1992>1992</option>
    <option value=1993>1993</option>
    <option value=1994>1994</option>
    <option value=1995>1995</option>
    <option value=1996>1996</option>
    <option value=1997>1997</option>
    <option value=1998>1998</option>
    <option value=1999 selected>1999</option>
    <option value=2000>2000</option>
    <option value=2001>2001</option>
    <option value=2002>2002</option>
    <option value=2003>2003</option>
    <option value=2004>2004</option>
    <option value=2005>2005</option>
    <option value=2006>2006</option>
    <option value=2007>2007</option>
    <option value=2008>2008</option>
    <option value=2009>2009</option>
    <option value=2010>2010</option>
</select>
<br>
<input type="submit" value="在日历上显示该日期!">
</form>
</td></tr></table>