再送大家一个礼物！！

A VBS CLASS calendar
calendar.vbs
<%
@#*************************************************************************************************
@#VBScript 日历 组件
@#
@#赋值：
@#    Mnth            日历月份
@#    Yr            日历年份
@#    FontSize        字体大小
@#    Columns            月份显示列数
@#    FontFace        字体样式    
@#    FontColour        字体颜色
@#    FillColour        星期背景颜色
@#    BorderColour        边框颜色
@#    BackgroundColour    日历背景颜色
@#    FullYearLink        全年月份连接
@#
@#取值：
@#    MonthCal        月份表格
@#    YearCal            年份表格
@#方法：
@#    LoadMonthArray        私有方法
@#*************************************************************************************************
%>
<Script LANGUAGE=JavaScript>
//定义整个年份查看连接函数
function showyearcal(link, year) {
if (link.indexOf(@#?@#) > 0)
    link = link + @#&year=@# + year
else
    link = link + @#?year=@# + year
calwin=window.open( link, @#calwin@#, @#toolbar=yes, scrollbars=yes, status=yes, width=680, height=480@# )
if (typeof(calwin.focus) != "undefined") {
    calwin.focus()
    }
}
//定义月份查看连接函数
function changemonth(moveby) {
document.calform.calmonth.value = document.calform.calmonth.value - 0 + moveby;
document.calform.submit();
}
function changeyear(moveby) {
document.calform.calyear.value = document.calform.calyear.value - 0 + moveby;
document.calform.submit();
}
</script>
<style>
td.day {font-family:arial;font-size:8pt;color:black}
</style>
<%
@#定义日历类

class calendar

    private M, Y, D, WeekNo, MonthArray, FSize, FFace, FColour, BorderCol, FillCol, BGCol, BigCol, SingleMonth, FYLink, Cols, cStyleSheet
    @#声明私有变量

    property let Mnth(Month)  
        if Month >= 1 and Month <= 12 then
            M = Month
        end if
    end property
    @#给月份赋值

    property let Yr(Year)    
        if Year > 1 and Year < 9999 then
            Y = Int(Year)
        end if
    end property
    @#给年份赋值
    
    property let FontSize(FS)
        if FS >= 1 and FS <= 7 then
            FSize = FS
        end if
    end property
    @#给字体大小赋值

    property let Columns(C)
        select case C
        case 1,2,3,4,6,12
            Cols = C
        case else
            Cols = 4
        end select
    end property
    @#给月份行数赋值

    property let FontFace(FF)    
        if FF <> "" then
            FFace = FF
        end if
    end property
    @#给字体样式赋值

    property let FontColour(FC)    
        if FC <> "" then
            FColour = FC
        end if
    end property
    @#给字体颜色赋值

    property let FillColour(FC)    
        if FC <> "" then
            FillCol = FC
        end if
    end property
    @#给星期背景色赋值

    property let BorderColour(BC)    
        if BC <> "" then
            BorderCol = BC
        end if        
    end property
    @#给边框颜色赋值

    property let BackgroundColour(BGC)
        if BGC <> "" then
            BgCol = BGC
        end if
    end property
    @#给日历背景色赋值
    
    property let FullYearLink(FYL) FYLink = FYL end property
    @#给全年连接赋值

    property let StyleSheet(SS) cStyleSheet = SS end property
    @#给样式赋值

@#初始化日历类
  private Sub Class_Initialize
    Mnth = Month(Now)
        Yr = Year(Now)                      @#给年份赋值
        FFace = "arial"                @#给字体样式赋值
        FSize = 2                @#给字体大小赋值
        FColour = "black"            @#给字体颜色赋值
        BorderCol = "lightgrey"            @#给边框颜色赋值
        FillCol = "#3399FF"            @#给星期背景颜色赋值
        BgCol = "darkgray"            @#给日历背景颜色赋值
        SingleMonth = true            @#确定为当前月
        FYLink = ""                @#整个年份连接
        Cols = 4                @#整个年份中显示月份的列数
        StyleSheet = false            @#是否使用样式
  End Sub

@#定义LoadMonthArray方法
  private Sub LoadMonthArray
        Dim Dte, FirstDayNo

        Redim MonthArray(6,7)

        for D = 1 to 31
            Dte = DateSerial(Y,M,D)
            if D = 1 then
                FirstDayNo = Weekday(Dte)
            end if
            if M = Month(Dte) and D = Day(Dte) then
                WeekNo = Abs( Int( ( ( FirstDayNo + D -1 ) /7 )*-1) )
                MonthArray( Weekno, Weekday(Dte) ) = D
            end if
        next
    end sub

@#取得月份
    property get MonthCal
        dim HTML, FontStr, Colour, ColSpan
        @#定义HTML、字体样式、颜色和表格跨度
        if Request.Form("calmonth") <> "" then
            M = Int( Request.Form("calmonth") )     @#取得传送来的月份
            Y = Int( Request.Form("calyear") )      @#取得传送来的年份
            if M > 12 then
                M = 1
                Y = Y + 1
            end if
            if M < 1 then
                M = 12
                Y = Y -1
            end if
        end if

        LoadMonthArray

        FontStr = "<font face=""" & FFace & """ size=" & FSize & " color=" & FColour & ">"
        
        HTML = "<table cellspacing=3 cellpadding=0 bgcolor=" & BgCol & " bordercolor=" & BorderCol & " border=1 width=""100%"">"
        @#使用HTML制作日历的显示表格
        HTML = HTML & "<tr>"        
        if SingleMonth then
            HTML = HTML & "<form name=calform method=post>"
            HTML = HTML & "<td align=center>" & FontStr & "<a href=javascript:changemonth(-1)><</a></td>"
            HTML = HTML & "<td align=center colspan=5>" & FontStr & MonthName(M)
            if FYLink <> "" then
                HTML = HTML & " <a href=javascript:showyearcal(@#" & Server.URLEncode(FYLink) & "@#,"& Y & ")>" & Y & "</a>"
            else
                HTML = HTML & " " & Y
            end if
            HTML = HTML & "</font></td>"
            HTML = HTML & "<td align=center>" & FontStr & "<a href=javascript:changemonth(1)>></a></td>"
        else
            HTML = HTML & "<td align=center colspan=7>" & FontStr & MonthName(M) & "</td>"
        end if

        HTML = HTML & "</tr>"

        for D = 1 to 7
            HTML = HTML & "<th width=""14%"" bgcolor=" & FillCol & ">" & FontStr & Right(WeekdayName(d),1) & "</font></th>"
            @#Right(WeekdayName(d),1)为中文星期格式，可以显示简单格式和完全格式
            @#英文系统简单格式为:Left(WeekdayName(d),1)
            @#完全显示格式为:WeekdayName(d)
        next

        for WeekNo = 1 to 6
            HTML = HTML & "<tr>"
            for D = 1 to 7
                HTML = HTML & "<td align=""center"" "
                
                if cStyleSheet then
                    HTML = HTML & "class=day "
                end if

                if MonthArray(WeekNo,D) = "" then
                    MonthArray(WeekNo,D) = " "
                else
                    if Date = DateSerial(Y,M,MonthArray(WeekNo,D)) then
                        HTML = HTML & "bgcolor=" & BorderCol
                    end if
                end if

                if not cStyleSheet then
                    HTML = HTML & ">" & FontStr & MonthArray(WeekNo,D) & "</font></td>"
                else
                    HTML = HTML & ">" & MonthArray(WeekNo,D) & "</td>"
                end if

                if IsNumeric( MonthArray(WeekNo,D) ) then
                    if Date = DateSerial(Y,M,MonthArray(WeekNo,D)) then
                        FontStr = Replace( FontStr, BgCol, FColour )
                    end if
                @#将当前日期的背景显示为边框颜色
                end if
            next
            HTML = HTML & "</tr>"
        next

        if SingleMonth then
            HTML = HTML & "<input type=hidden name=calmonth value=" & M & "></input>"
            HTML = HTML & "<input type=hidden name=calyear value=" & Y & "></input>"
            @#如果是当前月则通过隐藏的表单传送年份和月份
            HTML = HTML & "</form>"
        end if

        HTML = HTML & "</table>"

        MonthCal = HTML

    end property

@#取得年份
    property get YearCal
        Dim HTML, Col, Row, MonthSave, Rows

        MonthSave = M
        SingleMonth = false

        if Request.Form("calyear") <> "" then
            Yr = Request.Form("calyear")
        end if

        Rows = 12/Cols
        @#定义全年月份显示行数

        HTML = HTML & "<table border=0><form name=calform method=post>"
        HTML = HTML & "<tr><td align=center colspan=" & Cols & ">"
        HTML = HTML & "<font face=""" & FFace & """ size=6 color=" & FColour & ">"
        
        if not CStyleSheet then
            HTML = HTML & "<a href=javascript:changeyear(-1)><</a> " & Y & " <a href=javascript:changeyear(1)>></a>"
        else
            HTML = HTML & Y
        end if
        
        HTML = HTML & "</font></td></tr>"

        for Row = 1 to Rows
            HTML = HTML & "<tr>"
            for Col = 1 to Cols
                Mnth = Col + ((Row -1) * Cols)
                HTML = HTML & "<td>" & MonthCal & "</td>"
            next
            HTML = HTML & "</tr>"
        next

        HTML = HTML & "<input type=hidden name=calyear value=" & Y & "></input></form></table>"
        @#通过隐藏表单来提交年份
        Mnth = MonthSave

        YearCal = HTML
    end property

end class
%>
test.asp
<%
option explicit
response.expires = 0
response.buffer = true
%>
<HTML>
<head>
<%
if Request.QueryString("mode") = "year" then
%>
    <TITLE> Year Calendar </TITLE>
<%
else
%>
    <TITLE> Month Calendar </TITLE>
<%
end if
%>
</head>
<body>
<center>
    <table border=0 cellspacing=0 cellpadding=0>
        <tr>
            <td>
<%
dim cal
set cal = new calendar
if Request.QueryString("mode") = "year" then
        cal.yr = Request.QueryString("year")
        Response.Write( Cal.YearCal )
else
    cal.FullYearLink = "test.asp?mode=year"
    Response.Write( Cal.MonthCal )
end if
set cal = nothing
%>        </td>
        </tr>
    </table>
</center>
</body>
</html>
<!-- #INCLUDE FILE="calendar.vbs" -->
这个程序本来是用来投稿的，但是没有使用，我还是把他公布出来，没有什么特殊的，就是对学习VBS的CLASS有帮助。程序我做了详细的说明，大家可以很容易看懂的。
过断时间还会有好东西公布出来的，请大家期待。最为期待的估计就是VB的仿Office XP风格的按钮控件代码了。不过特别的大。呵呵。

原文转自：http://www.ltesting.net