以前收集的一些资料---使用ASP编写农历算法(一)_自动测试脚本语言

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

发表于：2007-06-30来源：作者：点击数：标签：

使用ASP编写农历算法新年将近，呵呵，写了一个阴历和阳历的ASP程序，就当给大家的新年贺礼（呵呵，这下蓝先生满意啦把，就当我送给你的圣诞礼物把。。。）希望大家能够喜欢。。。大家可以很方便的将这个农历加入到自己的主页中中国人使用中国人自己的日历

使用ASP编写农历算法
    新年将近，呵呵，写了一个阴历和阳历的ASP程序，就当给大家的新年贺礼
（呵呵，这下蓝先生满意啦把，就当我送给你的圣诞礼物把。。。）
希望大家能够喜欢。。。大家可以很方便的将这个农历加入到自己的主页中
中国人使用中国人自己的日历，呵呵，希望大家以后能够支持Chinaasp的
共同进步。。。
一共两个文件cal.asp和cal2.inc(主要是常量的定义)
cal.asp代码如下

<%
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>

原文转自：http://www.ltesting.net

软件测试 > 测试开发技术 > 软件测试开发语言 > 自动测试脚本语言 >