首页 > 编程 > VBScript > 正文

提供个可以显示农历的VBS代码

2020-06-26 18:05:18
字体:
来源:转载
供稿:网友
代码如下:

<script language=vbscript> 
Function nl() 
'获取当前系统时间 
curTime = Now() 
Dim WeekName(7), MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11), ShuXiang(11), DayName(30), MonName(12) 
'星期名 
WeekName(0) = " * " 
WeekName(1) = "星期日" 
WeekName(2) = "星期一" 
WeekName(3) = "星期二" 
WeekName(4) = "星期三" 
WeekName(5) = "星期四" 
WeekName(6) = "星期五" 
WeekName(7) = "星期六" 

'天干名称 
TianGan(0) = "甲" 
TianGan(1) = "乙" 
TianGan(2) = "丙" 
TianGan(3) = "丁" 
TianGan(4) = "戊" 
TianGan(5) = "己" 
TianGan(6) = "庚" 
TianGan(7) = "辛" 
TianGan(8) = "壬" 
TianGan(9) = "癸" 

'地支名称 
DiZhi(0) = "子" 
DiZhi(1) = "丑" 
DiZhi(2) = "寅" 
DiZhi(3) = "卯" 
DiZhi(4) = "辰" 
DiZhi(5) = "巳" 
DiZhi(6) = "午" 
DiZhi(7) = "未" 
DiZhi(8) = "申" 
DiZhi(9) = "酉" 
DiZhi(10) = "戌" 
DiZhi(11) = "亥" 
'属相名称 
ShuXiang(0) = "鼠" 
ShuXiang(1) = "牛" 
ShuXiang(2) = "虎" 
ShuXiang(3) = "兔" 
ShuXiang(4) = "龙" 
ShuXiang(5) = "蛇" 
ShuXiang(6) = "马" 
ShuXiang(7) = "羊" 
ShuXiang(8) = "猴" 
ShuXiang(9) = "鸡" 
ShuXiang(10) = "狗" 
ShuXiang(11) = "猪" 
'农历日期名 
DayName(0) = "*" 
DayName(1) = "初一" 
DayName(2) = "初二" 
DayName(3) = "初三" 
DayName(4) = "初四" 
DayName(5) = "初五" 
DayName(6) = "初六" 
DayName(7) = "初七" 
DayName(8) = "初八" 
DayName(9) = "初九" 
DayName(10) = "初十" 
DayName(11) = "十一" 
DayName(12) = "十二" 
DayName(13) = "十三" 
DayName(14) = "十四" 
DayName(15) = "十五" 
DayName(16) = "十六" 
DayName(17) = "十七" 
DayName(18) = "十八" 
DayName(19) = "十九" 
DayName(20) = "二十" 
DayName(21) = "廿一" 
DayName(22) = "廿二" 
DayName(23) = "廿三" 
DayName(24) = "廿四" 
DayName(25) = "廿五" 
DayName(26) = "廿六" 
DayName(27) = "廿七" 
DayName(28) = "廿八" 
DayName(29) = "廿九" 
DayName(30) = "三十" 
'农历月份名 
MonName(0) = "*" 
MonName(1) = "正" 
MonName(2) = "二" 
MonName(3) = "三" 
MonName(4) = "四" 
MonName(5) = "五" 
MonName(6) = "六" 
MonName(7) = "七" 
MonName(8) = "八" 
MonName(9) = "九" 
MonName(10) = "十" 
MonName(11) = "十一" 
MonName(12) = "腊" 
'公历每月前面的天数 
MonthAdd(0) = 0 
MonthAdd(1) = 31 
MonthAdd(2) = 59 
MonthAdd(3) = 90 
MonthAdd(4) = 120 
MonthAdd(5) = 151 
MonthAdd(6) = 181 
MonthAdd(7) = 212 
MonthAdd(8) = 243 
MonthAdd(9) = 273 
MonthAdd(10) = 304 
MonthAdd(11) = 334 
'农历数据 
NongliData(0) = 2635 
NongliData(1) = 333387 
NongliData(2) = 1701 
NongliData(3) = 1748 
NongliData(4) = 267701 
NongliData(5) = 694 
NongliData(6) = 2391 
NongliData(7) = 133423 
NongliData(8) = 1175 
NongliData(9) = 396438 
NongliData(10) = 3402 
NongliData(11) = 3749 
NongliData(12) = 331177 
NongliData(13) = 1453 
NongliData(14) = 694 
NongliData(15) = 201326 
NongliData(16) = 2350 
NongliData(17) = 465197 
NongliData(18) = 3221 
NongliData(19) = 3402 
NongliData(20) = 400202 
NongliData(21) = 2901 
NongliData(22) = 1386 
NongliData(23) = 267611 
NongliData(24) = 605 
NongliData(25) = 2349 
NongliData(26) = 137515 
NongliData(27) = 2709 
NongliData(28) = 464533 
NongliData(29) = 1738 
NongliData(30) = 2901 
NongliData(31) = 330421 
NongliData(32) = 1242 
NongliData(33) = 2651 
NongliData(34) = 199255 
NongliData(35) = 1323 
NongliData(36) = 529706 
NongliData(37) = 3733 
NongliData(38) = 1706 
NongliData(39) = 398762 
NongliData(40) = 2741 
NongliData(41) = 1206 
NongliData(42) = 267438 
NongliData(43) = 2647 
NongliData(44) = 1318 
NongliData(45) = 204070 
NongliData(46) = 3477 
NongliData(47) = 461653 
NongliData(48) = 1386 
NongliData(49) = 2413 
NongliData(50) = 330077 
NongliData(51) = 1197 
NongliData(52) = 2637 
NongliData(53) = 268877 
NongliData(54) = 3365 
NongliData(55) = 531109 
NongliData(56) = 2900 
NongliData(57) = 2922 
NongliData(58) = 398042 
NongliData(59) = 2395 
NongliData(60) = 1179 
NongliData(61) = 267415 
NongliData(62) = 2635 
NongliData(63) = 661067 
NongliData(64) = 1701 
NongliData(65) = 1748 
NongliData(66) = 398772 
NongliData(67) = 2742 
NongliData(68) = 2391 
NongliData(69) = 330031 
NongliData(70) = 1175 
NongliData(71) = 1611 
NongliData(72) = 200010 
NongliData(73) = 3749 
NongliData(74) = 527717 
NongliData(75) = 1452 
NongliData(76) = 2742 
NongliData(77) = 332397 
NongliData(78) = 2350 
NongliData(79) = 3222 
NongliData(80) = 268949 
NongliData(81) = 3402 
NongliData(82) = 3493 
NongliData(83) = 133973 
NongliData(84) = 1386 
NongliData(85) = 464219 
NongliData(86) = 605 
NongliData(87) = 2349 
NongliData(88) = 334123 
NongliData(89) = 2709 
NongliData(90) = 2890 
NongliData(91) = 267946 
NongliData(92) = 2773 
NongliData(93) = 592565 
NongliData(94) = 1210 
NongliData(95) = 2651 
NongliData(96) = 395863 
NongliData(97) = 1323 
NongliData(98) = 2707 
NongliData(99) = 265877 
'生成当前公历年、月、日 ==> GongliStr 
curYear = Year(curTime) 
curMonth = Month(curTime) 
curDay = Day(curTime) 
GongliStr = curYear & "年" 
If (curMonth < 10) Then 
    GongliStr = GongliStr & "0" & curMonth & "月" 
Else 
    GongliStr = GongliStr & curMonth & "月" 
End If 
If (curDay < 10) Then 
    GongliStr = GongliStr & "0" & curDay & "日" 
Else 
    GongliStr = GongliStr & curDay & "日" 
End If 
'生成当前公历星期 ==> WeekdayStr 
curWeekday = Weekday(curTime) 
WeekdayStr = WeekName(curWeekday) 
'计算到初始时间1921年2月8日的天数:1921-2-8(正月初一) 
TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38 
If ((curYear Mod 4) = 0 And curMonth > 2) Then 
    TheDate = TheDate + 1 
End If 
'计算农历天干、地支、月、日 
isEnd = 0 
m = 0 
Do 
    If (NongliData(m) < 4095) Then 
        k = 11 
    Else 
        k = 12 
    End If 
    n = k 
    Do 
        If (n < 0) Then 
            Exit Do 
        End If 
    '获取NongliData(m)的第n个二进制位的值 
    bit = NongliData(m) 
    For i = 1 To n Step 1 
        bit = Int(bit / 2) 
    Next 
    bit = bit Mod 2 
    If (TheDate <= 29 + bit) Then 
        isEnd = 1 
        Exit Do 
    End If 
    TheDate = TheDate - 29 - bit 
    n = n - 1 
  Loop 
  If (isEnd = 1) Then 
      Exit Do 
  End If 
  m = m + 1 
Loop 
curYear = 1921 + m 
curMonth = k - n + 1 
curDay = TheDate 
If (k = 12) Then 
    If (curMonth = (Int(NongliData(m) / 65536) + 1)) Then 
        curMonth = 1 - curMonth 
    ElseIf (curMonth > (Int(NongliData(m) / 65536) + 1)) Then 
        curMonth = curMonth - 1 
    End If 
End If 
'生成农历天干、地支、属相 ==> NongliStr 
NongliStr = "农历" & TianGan(((curYear - 4) Mod 60) Mod 10) & DiZhi(((curYear - 4) Mod 60) Mod 12) & "年" 
NongliStr = NongliStr & "(" & ShuXiang(((curYear - 4) Mod 60) Mod 12) & ")" 
'生成农历月、日 ==> NongliDayStr 
If (curMonth < 1) Then 
    NongliDayStr = "闰" & MonName(-1 * curMonth) 
Else 
    NongliDayStr = MonName(curMonth) 
End If 
NongliDayStr = NongliDayStr & "月" 
NongliDayStr = NongliDayStr & DayName(curDay) 
nl = NongliStr & NongliDayStr 
End Function 
msgbox nl 
</script>
发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表