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

http://www.foxtable.com/bbs/dispbbs.asp?BoardID=5&ID=1980&skin=0

代码要改一改

\'...
Dim Bar As WinForm.NavBar
Bar = e.Form.Controls("NavBar1")
Bar.SelectedIndex = 1
Dim d As Date = Date.Today()
Dim str,str1 As String
Dim y,m,d1 As Integer
y = d.year
m = d.Month
d1 = d.day
e.Form.Controls("Label1").Text = Format(d, "D")
e.Form.Controls("Label3").Text = Format(d,"dddd")
\'天干地支农历年
Dim y1 As String = d.Year
Dim Tg As String = "庚|辛|壬|癸|甲|乙|丙|丁|戊|己"
Dim Tgs() As String
Tgs = Tg.split("|")
Dim Dz As String = "申|酉|戌|亥|子|丑|寅|卯|辰|巳|午|未"
Dim Dzs() As String
Dzs = DZ.split("|")
Dim Sx As String = "猴|鸡|狗|猪|鼠|牛|虎|兔|龙|蛇|马|羊|"
Dim Sxs() As String
Sxs = Sx.split("|")
\'农历月日
Dim nl As New Lunar(Date.Today())
Dim Month As String = "|正|二|三|四|五|六|七|八|九|十|冬|腊"
Dim Months() As String
Months = Month.split("|")
if nl.LeapMonth = Nothing OrElse nl.Month < nl.LeapMonth Then
    str = Months(nl.Month)
End If
if nl.LeapMonth = nl.Month Then
    str = "闰" & Months(nl.LeapMonth)
End If
if nl.Month > nl.LeapMonth Then
    str = Months(nl.Month)
End If
Dim Multi As String = "|初一|初二|初三|初四|初五|初六|初七|初八|初九|初十|十一|十二|十三|十四|"
Multi = Multi & "十五|十六|十七|十八|十九|廿十|廿一|廿二|廿三|廿四|廿五|廿六|廿七|廿八|廿九|卅十"
Dim Values() As String
Values = Multi.split("|")
e.Form.Controls("Label4").Text = str & "月 " & Values(nl.Day)
\'二十四节气
Dim Jq As String = "|小寒|大寒|立春|雨水|惊蛰|春分|清明|谷雨|立夏|小满|芒种|夏至|小暑|大暑|立秋|处暑|白露|秋分|寒露|霜降|立冬|小雪|大雪|冬至"
Dim Jqs() As String
Jqs = Jq.split("|")
Select Case m
    Case 1
        if d1<15 Then
            str1 = int(y*0.2422+iif(y<2000,5.93,6.0055)+iif(y=1982,1,0)-iif(y=2019,1,0)-int((y-1)/4)+int((y-1)/100)-int((y-1)/400)*iif(y>0,1,0))
        Else
            str1 = int(y*0.2422+iif(y<2000,20.66,20.72)+iif(y=2082,1,0)-int((y-1)/4)+int((y-1)/100)-int((y-1)/400)*iif(y>0,1,0))
        End If
    Case 2
        if d1<15 Then
            str1 = int(1211/5000*y+(1593+20*int(y/1900)+20*int(y/1980)+20*int(y/2100)+20*int(y/2220))/365)-int((y-1)/4)+int((y-1)/100)-int((y-1)/400)+int((y-1)/3200)
        Else
            str1 = int(0.2422*y+iif(y>2000,19.32,19.28)+iif(y=2026,-1,0)+iif(y=1923,-1,0))-int((y-1)/4)+int((y-1)/100)-int((y-1)/400)*iif(y>0,1,0)
        End If
    Case 3
        if d1<15 Then
            str1 = int(0.2422*y+iif(y>1978,6.232,6.186))-int(y/4)+int(y/100)-int(y/400)*iif(y>0,1,0)
        Else
            str1 = int(y*0.2422+21.2477)-int(y/4)+int(y/100)-int(y/400)+IIF(y=2084,1,0)
        End If
    Case 4
        if d1<15 Then
            str1 = int(y*0.2422+5.41)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,20.708,20.7))-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 5
        if d1<15 Then
            str1 = int(y*0.2422+iif(y<2000,6.138,6.12))+iif(y=1911,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,21.68,21.64))+iif(y=2008,1,0)-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 6
        if d1<15 Then
            str1 = int(y*0.2422+iif(y<2000,6.32,6.278))+iif(y=1902,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,22.02,21.97))+iif(y=1928,1,0)-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 7
        if d1<15 Then
            str1 = int(y*0.2422+iif(y<2000,7.748,7.708))+iif(y=1925,1,0)+iif(y=2016,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,23.47,23.43))+iif(y=1922,1,0)-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 8
        if d1<15 Then
            str1 = int(y*0.2422+iif(y< 2000,8.17,8.1))+iif(y<2002,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,23.77,23.73))-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 9
        if d1<15 Then
            str1 = int(y*0.2422+iif(y<2000,8.26,8.246))+iif(y=1927,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+23.6459)-int(y/4)+int(y/100)-int(y/400)+iif(y=1942,1,0)
        End If
    Case 10
        if d1<15 Then
            str1 = int(y*0.2422+8.918)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+24.038)+iif(y=2089,1,0)-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 11
        if d1<15 Then
            str1 = int(y*0.2422+8.038)+iif(y=2089,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,22.9,22.96))+iif(y=1978,1,0)-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 12
        if d1<15 Then
            str1 = int(y*0.2422+iif(y<2000,7.72,7.78))+iif(y=1954,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,22.48,22.54))+iif(y=1918,-1,0)+iif(y=2021,-1,0)-int(y/4)+int(y/100)-int(y/400)
        End If
End Select
if d1 = str1 Then
    e.Form.Controls("Label5").Visible = False
    e.Form.Controls("Label6").Visible = True
    e.Form.Controls("Label6").Text = Jqs(m*2-iif(d1<15,1,0))
Else
    e.Form.Controls("Label6").Visible = False
    e.Form.Controls("Label5").Visible = True
    e.Form.Controls("Label5").Text = Tgs(y1.SubString(3)) & Dzs(y1 Mod 12) & "(" & Sxs(y1 Mod 12) & ")年"
End If

有就用啊。

1. Public Function Action(inDay,sDay,sWeekDay,sChinaYear,sChinaDay,sChinaAni)

直接把 Class ChinaDay 的代码拷贝进去。

调用参考 http://www.xin3721.com/Articlenet/1381.html