1
2'Option Explicit
3'***********************************************
4' 类名称：ChinaDay
5' 用途：
6' 根据输入的日期计算该日期的农历天干地支及当年属相
7' 使用方法：
8' 第一个参数为输入参数，不填写默认为当日，
9' 只计算1921-2-8之后的日期
10' ##-------------------------------------------##
11' Dim objChinaDay
12' Dim sDay, sWeekDay, sChinaDay, sChinaYear,sChinaAni
13' Set objChinaDay = New ChinaDay
14' Call objChinaDay.Action("",sDay,sWeekDay,sChinaYear,sChinaDay,sChinaAni)
15' Response.Write sDay&"
<br/>
1"
2' Response.Write sWeekDay&"
<br/>
1"
2' Response.Write sChinaYear&"
<br/>
1"
2' Response.Write sChinaDay&"
<br/>
1"
2' Response.Write sChinaAni&"
<br/>
1"
2' ##-------------------------------------------##
3' Modify By：Babyt(阿泰)
4' Mail: [email protected]
5' Welcome To:
6' http://blog.csdn.net/babyt/
7' http://www.facesun.cn
8' Created At: 2005-2-20
9' Copyright: 本代码非原创，是2001年收集的，原作者未知。
10' License:Free
11'*******************************************************
12Class ChinaDay
13
14Dim arrWeekName(7), MonthAdd(11), NongliData(99)
15Dim arrTianGan(9), arrDiZhi(11), arrShuXiang(11), arrDayName(30), arrMonName(12)
16Dim curTime, curYear, curMonth, curDay, curWeekday
17Dim i, m, n, k, isEnd, bit, TheDate
18
19'初始化数据
20Sub Class_Initialize()
21'---------------------------------------------------
22'定义显示字串
23
24'星期名
25arrWeekName(0) = "*"
26arrWeekName(1) = "星期日"
27arrWeekName(2) = "星期一"
28arrWeekName(3) = "星期二"
29arrWeekName(4) = "星期三"
30arrWeekName(5) = "星期四"
31arrWeekName(6) = "星期五"
32arrWeekName(7) = "星期六"
33
34'天干名称
35arrTianGan(0) = "甲"
36arrTianGan(1) = "乙"
37arrTianGan(2) = "丙"
38arrTianGan(3) = "丁"
39arrTianGan(4) = "戊"
40arrTianGan(5) = "己"
41arrTianGan(6) = "庚"
42arrTianGan(7) = "辛"
43arrTianGan(8) = "壬"
44arrTianGan(9) = "癸"
45
46'地支名称
47arrDiZhi(0) = "子"
48arrDiZhi(1) = "丑"
49arrDiZhi(2) = "寅"
50arrDiZhi(3) = "卯"
51arrDiZhi(4) = "辰"
52arrDiZhi(5) = "巳"
53arrDiZhi(6) = "午"
54arrDiZhi(7) = "未"
55arrDiZhi(8) = "申"
56arrDiZhi(9) = "酉"
57arrDiZhi(10) = "戌"
58arrDiZhi(11) = "亥"
59
60'属相名称
61arrShuXiang(0) = "鼠"
62arrShuXiang(1) = "牛"
63arrShuXiang(2) = "虎"
64arrShuXiang(3) = "兔"
65arrShuXiang(4) = "龙"
66arrShuXiang(5) = "蛇"
67arrShuXiang(6) = "马"
68arrShuXiang(7) = "羊"
69arrShuXiang(8) = "猴"
70arrShuXiang(9) = "鸡"
71arrShuXiang(10) = "狗"
72arrShuXiang(11) = "猪"
73
74'农历日期名
75arrDayName(0) = "*"
76arrDayName(1) = "初一"
77arrDayName(2) = "初二"
78arrDayName(3) = "初三"
79arrDayName(4) = "初四"
80arrDayName(5) = "初五"
81arrDayName(6) = "初六"
82arrDayName(7) = "初七"
83arrDayName(8) = "初八"
84arrDayName(9) = "初九"
85arrDayName(10) = "初十"
86arrDayName(11) = "十一"
87arrDayName(12) = "十二"
88arrDayName(13) = "十三"
89arrDayName(14) = "十四"
90arrDayName(15) = "十五"
91arrDayName(16) = "十六"
92arrDayName(17) = "十七"
93arrDayName(18) = "十八"
94arrDayName(19) = "十九"
95arrDayName(20) = "二十"
96arrDayName(21) = "廿一"
97arrDayName(22) = "廿二"
98arrDayName(23) = "廿三"
99arrDayName(24) = "廿四"
100arrDayName(25) = "廿五"
101arrDayName(26) = "廿六"
102arrDayName(27) = "廿七"
103arrDayName(28) = "廿八"
104arrDayName(29) = "廿九"
105arrDayName(30) = "三十"
106
107'农历月份名
108arrMonName(0) = "*"
109arrMonName(1) = "正"
110arrMonName(2) = "二"
111arrMonName(3) = "三"
112arrMonName(4) = "四"
113arrMonName(5) = "五"
114arrMonName(6) = "六"
115arrMonName(7) = "七"
116arrMonName(8) = "八"
117arrMonName(9) = "九"
118arrMonName(10) = "十"
119arrMonName(11) = "十一"
120arrMonName(12) = "腊"
121
122'---------------------------------------------------------
123
124'公差数据定义
125
126'公历每月前面的天数
127MonthAdd(0) = 0
128MonthAdd(1) = 31
129MonthAdd(2) = 59
130MonthAdd(3) = 90
131MonthAdd(4) = 120
132MonthAdd(5) = 151
133MonthAdd(6) = 181
134MonthAdd(7) = 212
135MonthAdd(8) = 243
136MonthAdd(9) = 273
137MonthAdd(10) = 304
138MonthAdd(11) = 334
139
140'农历数据
141NongliData(0) = 2635
142NongliData(1) = 333387
143NongliData(2) = 1701
144NongliData(3) = 1748
145NongliData(4) = 267701
146NongliData(5) = 694
147NongliData(6) = 2391
148NongliData(7) = 133423
149NongliData(8) = 1175
150NongliData(9) = 396438
151NongliData(10) = 3402
152NongliData(11) = 3749
153NongliData(12) = 331177
154NongliData(13) = 1453
155NongliData(14) = 694
156NongliData(15) = 201326
157NongliData(16) = 2350
158NongliData(17) = 465197
159NongliData(18) = 3221
160NongliData(19) = 3402
161NongliData(20) = 400202
162NongliData(21) = 2901
163NongliData(22) = 1386
164NongliData(23) = 267611
165NongliData(24) = 605
166NongliData(25) = 2349
167NongliData(26) = 137515
168NongliData(27) = 2709
169NongliData(28) = 464533
170NongliData(29) = 1738
171NongliData(30) = 2901
172NongliData(31) = 330421
173NongliData(32) = 1242
174NongliData(33) = 2651
175NongliData(34) = 199255
176NongliData(35) = 1323
177NongliData(36) = 529706
178NongliData(37) = 3733
179NongliData(38) = 1706
180NongliData(39) = 398762
181NongliData(40) = 2741
182NongliData(41) = 1206
183NongliData(42) = 267438
184NongliData(43) = 2647
185NongliData(44) = 1318
186NongliData(45) = 204070
187NongliData(46) = 3477
188NongliData(47) = 461653
189NongliData(48) = 1386
190NongliData(49) = 2413
191NongliData(50) = 330077
192NongliData(51) = 1197
193NongliData(52) = 2637
194NongliData(53) = 268877
195NongliData(54) = 3365
196NongliData(55) = 531109
197NongliData(56) = 2900
198NongliData(57) = 2922
199NongliData(58) = 398042
200NongliData(59) = 2395
201NongliData(60) = 1179
202NongliData(61) = 267415
203NongliData(62) = 2635
204NongliData(63) = 661067
205NongliData(64) = 1701
206NongliData(65) = 1748
207NongliData(66) = 398772
208NongliData(67) = 2742
209NongliData(68) = 2391
210NongliData(69) = 330031
211NongliData(70) = 1175
212NongliData(71) = 1611
213NongliData(72) = 200010
214NongliData(73) = 3749
215NongliData(74) = 527717
216NongliData(75) = 1452
217NongliData(76) = 2742
218NongliData(77) = 332397
219NongliData(78) = 2350
220NongliData(79) = 3222
221NongliData(80) = 268949
222NongliData(81) = 3402
223NongliData(82) = 3493
224NongliData(83) = 133973
225NongliData(84) = 1386
226NongliData(85) = 464219
227NongliData(86) = 605
228NongliData(87) = 2349
229NongliData(88) = 334123
230NongliData(89) = 2709
231NongliData(90) = 2890
232NongliData(91) = 267946
233NongliData(92) = 2773
234NongliData(93) = 592565
235NongliData(94) = 1210
236NongliData(95) = 2651
237NongliData(96) = 395863
238NongliData(97) = 1323
239NongliData(98) = 2707
240NongliData(99) = 265877
241End Sub
242
243'############################################################
244'主要方法 Action
245' inDay 输入日期，如果不输入则默认为当前日期
246' sDay 中文格式日期
247' sWeekDay 周几
248' sChinaYear 农历年
249' sChinaDay 农历日
250' sChinaAni 属相
251'############################################################
252Public Function Action(inDay,sDay,sWeekDay,sChinaYear,sChinaDay,sChinaAni)
253
254'转换要转换的日期
255If inDay="" Or Not IsDate(inDay) Then
256'获取当前系统时间
257curTime = Now()
258Else
259curTime = CDate(inDay)
260End If
261
262If Datediff("d",curTime,Cdate("1921-2-8"))>0 Then
263Exit Function
264End If
265
266'生成当前公历年、月、日 ==> sDay
267curYear = Year(curTime)
268curMonth = Month(curTime)
269curDay = Day(curTime)
270
271sDay = curYear&"年"
272If (curMonth < 10) Then
273sDay = sDay&"0"&curMonth&"月"
274Else
275sDay = sDay&curMonth&"月"
276End If
277If (curDay < 10) Then
278sDay = sDay&"0"&curDay&"日"
279Else
280sDay = sDay&curDay&"日"
281End If
282
283'生成当前公历星期 ==> sWeekDay
284curWeekday = Weekday(curTime)
285sWeekDay = arrWeekName(curWeekday)
286
287'计算到初始时间1921年2月8日的天数：1921-2-8(正月初一)
288TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38
289If ((curYear Mod 4) = 0 AND curMonth > 2) Then
290TheDate = TheDate + 1
291End If
292
293'计算农历天干、地支、月、日
294isEnd = 0
295m = 0
296'------------------------------------
297Do
298If (NongliData(m) < 4095) Then
299k = 11
300Else
301k = 12
302End if
303
304n = k
305'------------------------------------
306Do
307If (n < 0) Then
308Exit Do
309End If
310
311'获取NongliData(m)的第n个二进制位的值
312bit = NongliData(m)
313For i = 1 To n Step 1
314bit = Int(bit / 2)
315Next
316bit = bit Mod 2
317
318If (TheDate <= 29 + bit) Then
319isEnd = 1
320Exit Do
321End If
322
323TheDate = TheDate - 29 - bit
324
325n = n - 1
326Loop
327'------------------------------------
328If (isEnd = 1) Then
329Exit Do
330End If
331
332m = m + 1
333Loop
334'------------------------------------
335
336curYear = 1921 + m
337curMonth = k - n + 1
338curDay = TheDate
339
340If (k = 12) Then
341If (curMonth = (Int(NongliData(m) / 65536) + 1)) Then
342curMonth = 1 - curMonth
343ElseIf (curMonth > (Int(NongliData(m) / 65536) + 1)) Then
344curMonth = curMonth - 1
345End if
346End If
347
348'生成农历天干、地支==> sChinaYear
349sChinaYear = "农历"&arrTianGan(((curYear - 4) Mod 60) Mod 10)&arrDiZhi(((curYear - 4) Mod 60) Mod 12)&"年"
350'生成属相 == > sChinaAni
351sChinaAni = arrShuXiang(((curYear - 4) Mod 60) Mod 12)
352
353'生成农历月、日 ==> NongliDayStr
354If (curMonth < 1) Then
355sChinaDay = "闰"&arrMonName(-1 * curMonth)
356Else
357sChinaDay = arrMonName(curMonth)
358End If
359sChinaDay = sChinaDay&"月"
360
361sChinaDay = sChinaDay & arrDayName(curDay)
362End Function
363End Class