正确计算天干地支生肖的函数(.net)---更正版

来源：互联网发布：fc2最新域名官方编辑：程序博客网时间：2024/04/28 02:20

因为要用到一个算干支的函数
但在网上找了好长时间，没有发现算的正确的(按春节划分如20070217丙戌-20070218则为丁亥)
所以就自写了一个，夜深了，有的地方就草草写了，有错请回复提出

注：
用的XML数据库，有兴趣的朋友可以将之转为其它数据库
如果大家需要的话我可以把文件打个包。

-----邹健

====================================================
后注：愿来的函数没做时间合法性判断，又重新修正更改了

因为我用的是ASP.net所以要调用的XML文件名直接写在了web.config的appSettings
代码如下
目录结构
/App_code/strcl.vb本类库文件
|
/xml/AnimalSign.xml    十二生肖及地支文件
|        Date.xml                  1900-2100春节时间
|          SkyTree.xml          天干列表
|
/web.config 网站配置文件

本文将按以下顺序给出代码
datecl.vb
web.config
Date.xml
AnimalSign.xml
SkyTree.xml

=====================================datecl.vb=================================

Imports Microsoft.VisualBasic
Public Class Datecl
    Public Enum SkyTreeText
        天干 = 0
        地支 = 1
    End Enum
    Shared Function ftime(ByRef d As DateTime) As String
        If DateDiff(DateInterval.Day, d, Now()) >= 1 Then
            Return Format(d, "MM-dd")
        Else
            Return Format(d, "HH:mm")
        End If
    End Function
    Overloads Shared Function SkyTree(ByRef dat As DateTime, ByRef i As SkyTreeText) As Byte
        '得到干支序号
        Dim Dom As New System.Xml.XmlDocument
        Dom.Load(My.Request.MapPath("/") & ConfigurationManager.AppSettings("AnimalSignDate"))
        Dim Node As System.Xml.XmlNode
        Dim y As Int16 = Int16.Parse(Year(dat))
        Dim m As Byte = Byte.Parse(Month(dat))
        Dim d As Byte = Byte.Parse(Day(dat))
        Node = Dom.SelectSingleNode("//item[@year=" & y & "]")
        Dim start As Int16
        Dim n As Byte
        Dim result As Byte
        If i = 1 Then
            start = 1901
            n = 12
        Else
            start = 1905
            n = 10
        End If
        result = ((y - start) Mod n) + 2
        result = IIf(result <= 0, result + n, result)
        If Byte.Parse(Node.Attributes("month").InnerXml) > m Then result = result - 1
        If Byte.Parse(Node.Attributes("month").InnerXml) = m And Byte.Parse(Node.Attributes("day").InnerXml) > d Then result = result - 1
        result = IIf(result = 0, n, result)
        result = IIf(result = n + 1, 1, result)
        Return result
        '本最多用时16MS一般1MS内可以完成
    End Function
    Overloads Shared Function SkyTree(ByRef dats As String, ByRef i As SkyTreeText) As Byte '得到干支序号
        If Not IsDate(dats) Then Return 0
        Return SkyTree(DateTime.Parse(dats), i)
    End Function
    Shared Function XmlItemName(ByRef Xpath As String, ByRef name As String, ByRef xmlfilename As String) As String '通用读取XML
        Dim Dom As New System.Xml.XmlDocument
        Dom.Load(My.Request.MapPath("/") & ConfigurationManager.AppSettings(xmlfilename))
        Dim Node As System.Xml.XmlNode
        Node = Dom.SelectSingleNode(Xpath)
        Return Node.Attributes(name).InnerXml
    End Function
    Overloads Shared Function AnimalSignName(ByRef Num As Byte) As String '返回生肖名
        Return XmlItemName("//item[@id=" & Num.ToString & "]", "name", "AnimalSign")
    End Function
    Overloads Shared Function AnimalSignName(ByRef dat As DateTime) As String '返回生肖名
        Return AnimalSignName(SkyTree(dat, SkyTreeText.地支))
    End Function
    Overloads Shared Function AnimalSignName(ByRef dats As String) As String '返回生肖名
        If Not IsDate(dats) Then Return ""
        Return AnimalSignName(SkyTree(DateTime.Parse(dats), SkyTreeText.地支))
    End Function

    Overloads Shared Function TreeName(ByRef dat As DateTime) As String '返回为地支名
        Return XmlItemName("//item[@id=" & SkyTree(dat, SkyTreeText.地支) & "]", "tree", "AnimalSign")
    End Function
    Overloads Shared Function TreeName(ByRef dats As String) As String '返回为地支名
        If Not IsDate(dats) Then Return ""
        Return TreeName(DateTime.Parse(dats))
    End Function
    Overloads Shared Function SkyName(ByRef dat As DateTime) As String '返回天干名
        Return XmlItemName("//item[@id=" & SkyTree(dat, SkyTreeText.天干).ToString & "]", "tree", "SkyTree")
    End Function
    Overloads Shared Function SkyName(ByRef dats As String) As String '返回天干名
        If Not IsDate(dats) Then Return ""
        Return SkyName(DateTime.Parse(dats))
    End Function
    Overloads Shared Function SkyTreeName(ByRef dat As DateTime) As String '返回天干地支
        Return SkyName(dat) & TreeName(dat)
    End Function
    Overloads Shared Function SkyTreeName(ByRef dats As String) As String '返回天干地支
        Return SkyName(dats) & TreeName(dats)
    End Function
    Overloads Shared Function StarSignName(ByRef dats As String) As String
        Return StarSignName(StarSign(dats))
    End Function
    Overloads Shared Function StarSignName(ByRef dat As DateTime) As String
        Return StarSignName(StarSign(dat))
    End Function
    Overloads Shared Function StarSignName(ByRef Num As Byte) As String
        Return XmlItemName("/root/item[@id=" & Num.ToString & "]", "name", "StarSign")
    End Function
    Shared Function StarSign(ByRef dats As String) As Byte
        If Not IsDate(dats) Then Return 0
        Return StarSign(DateTime.Parse(dats))
    End Function
    Shared Function StarSign(ByRef dat As DateTime) As Byte
        If Not IsDate(dat) Then Return 0
        Dim m As Byte = Byte.Parse(Month(dat))
        Dim d As Byte = Byte.Parse(Day(dat))
        Dim y As Int16 = 2007
        Dim temp As DateTime = DateTime.Parse(m & "/" & d & "/2007")
        Select Case temp
            Case #3/21/2007# To #4/19/2007#
                StarSign = 1
            Case #4/20/2007# To #5/20/2007#
                StarSign = 2
            Case #5/21/2007# To #6/21/2007#
                StarSign = 3
            Case #6/22/2007# To #7/22/2007#
                StarSign = 4
            Case #7/23/2007# To #8/22/2007#
                StarSign = 5
            Case #8/23/2007# To #9/22/2007#
                StarSign = 6
            Case #9/23/2007# To #10/23/2007#
                StarSign = 7
            Case #10/24/2007# To #11/21/2007#
                StarSign = 8
            Case #11/22/2007# To #12/21/2007#
                StarSign = 9
            Case #12/22/2007# To #12/31/2007#
                StarSign = 10
            Case #1/1/2007# To #1/19/2007#
                StarSign = 10
            Case #1/20/2007# To #2/18/2007#
                StarSign = 11
            Case #2/19/2007# To #3/20/2007#
                StarSign = 12
            Case Else
                StarSign = 0
        End Select
        Return StarSign
    End Function
End Class

==============web.config中加以下结点