DOC《可以显示农历的VBS代码：》

可以显示农历的VBS代码: 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 (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 vbs实现显示系统调色板的代码: set ie = createobject( internetexplorer.

application ) ie.navigate about:blank do until ie.readystate =

4 : wscript.sleep

25 : loop set doc = ie.document set body = doc.body set win = doc.parentwindow body.innerhtml = body.innertext = doc.getElementById( dlg ).choosecolordlg win.clipboarddata.setdata text , body.innertext ie.quit 用vbs实现zip功能的脚本: 压缩: Function fZip(sSourceFolder,sTargetZIPFile) '

This function will add all of the files in a source folder to a ZIP file '

using Windows'

native folder ZIP capability. Dim oShellApp, oFSO, iErr, sErrSource, sErrDescription Set oShellApp = CreateObject( Shell.Application ) Set oFSO = CreateObject( Scripting.FileSystemObject ) '

The source folder needs to have a on the End If Right(sSourceFolder,1)Then sSourceFolder = sSourceFolder &

On Error Resume Next '

If a target ZIP exists already, delete it If oFSO.FileExists(sTargetZIPFile) Then oFSO.DeleteFile sTargetZIPFile,True iErr = Err.Number sErrSource = Err.Source sErrDescription = Err.Description On Error GoTo

0 If iErr

0 Then fZip = Array(iErr,sErrSource,sErrDescription) Exit Function End If On Error Resume Nex........