寫了幾個類，希望對大家有用。

更新時間：2006年12月20日 00:00:00 作者：

1.日歷

[Ctrl+A 全選注:引入外部Js需再刷新一下頁面才能執(zhí)行]

2.簡單的下拉菜單

[Ctrl+A 全選注:引入外部Js需再刷新一下頁面才能執(zhí)行]

3. QQ菜單效果

[Ctrl+A 全選注:引入外部Js需再刷新一下頁面才能執(zhí)行]

4.對聯(lián)效果

[Ctrl+A 全選注:引入外部Js需再刷新一下頁面才能執(zhí)行]

5.圖片輪換

[Ctrl+A 全選注:引入外部Js需再刷新一下頁面才能執(zhí)行]

6.listView類

[Ctrl+A 全選注:引入外部Js需再刷新一下頁面才能執(zhí)行]

7.表單多文件上傳類 [ASP]

<%     Class Upload         Public  Form, Finished         Private bVBCrlf, bSeparate, formData, cFields, folderPath, itemCount, sErrors, sAuthor, sVersion         Private itemStart(), itemLength(), dataStart(), dataLength(), itemName(), itemData(), extenArr()         Private Sub Class_Initialize                   formData = Request.BinaryRead(Request.TotalBytes)             Set Form = Server.CreateObject("Scripting.Dictionary")             sAuthor = "51JS.COM-ZMM"             sVersion = "Upload Class 1.0"         End Sub                   Public Property Get ErrMessage             ErrMessage = sErrors         End Property           Public Property Get Author             Author = sAuthor         End Property         Public Property Get Version             Version = sVersion         End Property         Public Property Let CheckFields(byVal sCheck)             cFields = sCheck         End Property         Public Property Let Folder(byVal sFolder)             folderPath = sFolder         End Property         Public Function Start             Finished = False             bVBCrlf = StrToByte(vbCrlf & vbCrlf)             bSeparate = StrToByte("-----------------------------")             itemCount = 0             sErrors = ""             Call ItemPosition          End Function         Private Function ItemPosition             Dim iStart, iLength : iStart = 1                     Do Until InStrB(iStart, formData, bSeparate) = 0                iStart = InStrB(iStart, formData, bSeparate) + LenB(bSeparate) + 14                iLength = InStrB(iStart, formData, bSeparate) - iStart - 2                If Abs(iStart + 2 - LenB(formData)) > 2 Then                   ReDim Preserve itemStart(itemCount)                   ReDim Preserve itemLength(itemCount)                   itemStart(itemCount) = iStart                   itemLength(itemCount) = iLength                   itemCount = itemCount + 1                End If             Loop             Call FillItemValue         End Function         Private Function FillItemValue             Dim dataPart, bInfor             Dim iStart : iStart = 1             Dim iCount : iCount = 0             Dim iCheck : iCheck = StrToByte("filename")             For i = 0 To itemCount - 1                 ReDim Preserve itemName(iCount)                 ReDim Preserve itemData(iCount)                 ReDim Preserve extenArr(iCount)                 ReDim Preserve dataStart(iCount)                 ReDim Preserve dataLength(iCount)                 dataPart = MidB(formData, itemStart(i), itemLength(i))                 iStart = InStrB(1, dataPart, ChrB(34)) + 1                 iLength = InStrB(iStart, dataPart, ChrB(34)) - iStart                 itemName(iCount) = FormItemName(MidB(dataPart, iStart, iLength))                 iStart = InStrB(1, dataPart, bVBCrlf) + 4                 iLength = LenB(dataPart) - iStart + 1                 If InStrB(1, dataPart, iCheck) > 0 Then                    bInfor = MidB(dataPart, 1, iStart - 5)                    extenArr(iCount) = FileExtenName(bInfor)                    If Mid(folderPath, Len(folderPath) - 1) = "/" Then                       itemData(iCount) = folderPath & GetRndName(6) & extenArr(iCount)                    Else                       itemData(iCount) = folderPath & "/" & GetRndName(6) & extenArr(iCount)                      End If                    dataStart(iCount) = itemStart(i) + iStart - 2                    dataLength(iCount) = iLength                 Else                    extenArr(iCount) = ""                    itemData(iCount) = ByteToStr(MidB(dataPart, iStart, iLength))                    dataStart(iCount) = ""                    dataLength(iCount) = ""                 End If                 iCount = iCount + 1             Next             Call SaveUpload         End Function         Private Function FormItemName(byVal bName)             FormItemName = ByteToStr(bName)         End Function         Private Function FileExtenName(byVal bInfor)             Dim pStart, pLength, pContent, regEx             pStart = InStr(1, ByteToStr(bInfor), "filename=" & Chr(34)) + 10             pLength = InStr(pStart, ByteToStr(bInfor), Chr(34)) - pStart             pContent = Mid(ByteToStr(bInfor), pStart, pLength)             If pContent = "" Then                FileExtenName = ""             Else                Set regEx = New RegExp                regEx.Pattern = "^.*(\.[^\.]*)$"                regEx.Global = False                regEx.IgnoreCase = True                FileExtenName = regEx.Replace(pContent, "$1")                Set regEx = Nothing                             End If                 End Function         Private Function GetRndName(byVal sLen)             Dim regEx, sTemp, arrFields, n : n = 0             Set regEx = New RegExp             regEx.Pattern = "[^\d]*"             regEx.Global = True             regEx.IgnoreCase = True             sTemp = regEx.Replace(Now, "") & "-"             Set regEx = Nothing                      arrFields = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", _                                "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", _                                "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", _                               "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", _                               "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", _                               "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", _                               "Y", "Z")             Randomize             Do While n < sLen                sTemp = sTemp & CStr(arrFields(61 * Rnd))                n = n + 1             Loop             GetRndName = sTemp         End Function         Private Function SaveUpload             Dim isValidate             Dim filePath, oStreamGet, oStreamPut             isValidate = CheckFile             If isValidate Then                For i = 0 To itemCount - 1                    If (dataStart(i) <> "") And (dataLength(i) <> "") Then                        If dataLength(i) = 0 Then                           itemData(i) = ""                         Else                           filePath = Server.MapPath(itemData(i))                           If CreateFolder("|", ParentFolder(filePath)) Then                                                        Set oStreamGet = Server.CreateObject("ADODB.Stream")                              oStreamGet.Type = 1                              oStreamGet.Mode = 3                              oStreamGet.Open                              oStreamGet.Write formData                              oStreamGet.Position = dataStart(i)                              Set oStreamPut = Server.CreateObject("ADODB.Stream")                              oStreamPut.Type = 1                              oStreamPut.Mode = 3                              oStreamPut.Open                              oStreamPut.Write oStreamGet.Read(dataLength(i))                              oStreamPut.SaveToFile(filePath)                              oStreamGet.Close                              Set oStreamGet = Nothing                              oStreamPut.Close                              Set oStreamPut = Nothing                           End If                          End If                                       End If                Next                Finished = True                Call ItemToColl             Else                               Finished = False             End If         End Function         Private Function CheckFile             Dim oBoolean : oBoolean = True             If cFields = "" Then                oBoolean = oBoolean And True             Else                For i = 0 To itemCount - 1                    If extenArr(i) <> "" Then                       If InStr(1, Ucase(cFields), "|" & Ucase(Mid(extenArr(i), 2)) & "|") > 0 Then                          oBoolean = oBoolean And True                       Else                          sErrors = sErrors & "表單[ " & itemName(i) & " ]的文件格式錯誤！\n" & _                                              "支持的格式為：" & Replace(Mid(cFields, 2, Len(cFields) - 1), "|", " ") & "\n\n"                          oBoolean = oBoolean And False                            End If                    End If                 Next             End If             CheckFile = oBoolean         End Function         Private Function CreateFolder(byVal sLine, byVal sPath)             Dim oFso             Set oFso = Server.CreateObject("Scripting.FileSystemObject")             If Not oFso.FolderExists(sPath) Then                Dim regEx                Set regEx = New RegExp                regEx.Pattern = "^(.*)\\([^\\]*)$"                regEx.Global = False                regEx.IgnoreCase = True                   sLine = sLine & regEx.Replace(sPath, "$2") & "|"                sPath = regEx.Replace(sPath, "$1")                     If CreateFolder(sLine, sPath) Then CreateFolder = True                 Set regEx = Nothing             Else                If sLine = "|" Then                   CreateFolder = True                Else                   Dim sTemp : sTemp = Mid(sLine, 2, Len(sLine) - 2)                   If InStrRev(sTemp, "|") = 0 Then                      sLine = "|"                      sPath = sPath & "\" & sTemp                                Else                      Dim Folder : Folder = Mid(sTemp, InStrRev(sTemp, "|") + 1)                      sLine = "|" & Mid(sTemp, 1, InStrRev(sTemp, "|") - 1) & "|"                      sPath = sPath & "\" & Folder                   End If                   oFso.CreateFolder sPath                   If CreateFolder(sLine, sPath) Then CreateFolder = True                             End if             End If             Set oFso = Nothing           End Function         Function ParentFolder(byVal sPath)             Dim regEx             Set regEx = New RegExp             regEx.Pattern = "^(.*)\\[^\\]*$"             regEx.Global = True             regEx.IgnoreCase = True             ParentFolder = regEx.Replace(sPath, "$1")             Set regEx = Nothing                      End Function         Private Function StrToByte(byVal sText)              For i = 1 To Len(sText)                               StrToByte = StrToByte & ChrB(Asc(Mid(sText, i, 1)))                Next         End Function         Private Function ByteToStr(byVal sByte)             Dim oStream             Set oStream = Server.CreateObject("ADODB.Stream")             oStream.Type = 2             oStream.Mode = 3             oStream.Open             oStream.WriteText sByte             oStream.Position = 0             oStream.CharSet = "gb2312"             oStream.Position = 2             ByteToStr = oStream.ReadText             oStream.Close              Set oStream = Nothing                  End Function         Private Function ItemToColl             For i = 0 To itemCount - 1                 If Not Form.Exists(itemName(i)) Then                    Form.Add itemName(i), itemData(i)                 End If             Next         End Function         Private Sub Class_Terminate             Form.RemoveAll             Set Form = Nothing         End Sub     End Class     If Request.ServerVariables("REQUEST_METHOD") = "POST" Then        Rem 建立上傳類實(shí)例               Set oUpload = New Upload        Rem 指定允許上傳文件的類型        oUpload.CheckFields = "|GIF|BMP|JPG|"        Rem 指定上傳文件所存儲的相對路徑        oUpload.Folder = "51JS.COM-ZMM/UploadFile"        Rem 開始上傳處理        oUpload.Start        If oUpload.Finished Then           Rem 上傳成功，顯示上傳信息           Dim sHtml : sHtml = ""           sHtml = sHtml & "<center>"           sHtml = sHtml & "<div style=""width: 600px;height: 500px;font-size: 10pt;border: 1px solid highlight;overflow: auto;"" align=""left"">"           sHtml = sHtml & "<center style=""font-size: 15pt;color: red;"">上傳表單數(shù)據(jù)</center>"           sHtml = sHtml & "標(biāo)題：" & oUpload.Form("P_title") & ""           sHtml = sHtml & "類型：" & oUpload.Form("P_assort") & ""           sHtml = sHtml & "小圖：服務(wù)器端路徑：<a href=""" & oUpload.Form("P_image_s") & """ target=""_blank"">" & oUpload.Form("P_image_s") & "</a><img src=""" & oUpload.Form("P_image_s") & """>"           sHtml = sHtml & "中圖：服務(wù)器端路徑：<a href=""" & oUpload.Form("P_image_m") & """ target=""_blank"">" & oUpload.Form("P_image_m") & "</a><img src=""" & oUpload.Form("P_image_m") & """>"           sHtml = sHtml & "大圖：服務(wù)器端路徑：<a href=""" & oUpload.Form("P_image_b") & """ target=""_blank"">" & oUpload.Form("P_image_b") & "</a><img src=""" & oUpload.Form("P_image_b") & """>"           sHtml = sHtml & "介紹：" & oUpload.Form("P_content") & ""                              sHtml = sHtml & "</div>"           sHtml = sHtml & "</center>"           Response.Write sHtml           Response.End        Else           Rem 上傳失敗，顯示錯誤信息           Call ShowMsg(oUpload.ErrMessage, Request.ServerVariables("SCRIPT_NAME"))        End If        Rem 對話框提示函數(shù)        Function ShowMsg(byVal sText, byVal sTarget)            Dim sScript : sScript = ""            sScript = sScript & ""            Response.Write sScript            Response.End        End Function               End If %> <html> <head> <title>多文件、表單混合上傳類</title> <meta http-equiv="Content-Type" content="text/html; charset=gb2312"> <style type="text/css">     body {            margin: 0px;            border: 0px;            font-size: 10pt;     }     table {            border-collapse: collapse;            font-size: 10pt;     }     td {            font-size: 10pt;     } </style>  </head> <body>        <form action="<%=Request.ServerVariables("SCRIPT_NAME")%>" method="post" enctype="multipart/form-data" onsubmit="return formCheck(this);">    <table width="400" align="center" cellpadding="2" cellspacing="0" border="1" rules="box">       <tr height="26">          <td colspan="2" align="center" style="font: 12pt;color: red;">上傳功能測試</td>       </tr>       <tr valign="top">          <td height="30" style="padding-top:3px;">標(biāo)題：</td>          <td><input type="text" name="P_title" size="20" autocomplete="off"></td>       </tr>                      <tr valign="top">          <td height="30" style="padding-top:3px;">類型：</td>          <td>              <select name="P_assort">                  <option value="電子">電子</option>                  <option value="醫(yī)療">醫(yī)療</option>              </select>          </td>       </tr>           <tr valign="top">          <td height="30" style="padding-top:3px;">小圖：</td>          <td><input type="file" name="P_image_s" onkeydown="return false;" oncontextmenu="return false;" onpaste="return false;" ondragenter="return false;"></td>       </tr>                         <tr valign="top">          <td height="30" style="padding-top:3px;">中圖：</td>          <td><input type="file" name="P_image_m" onkeydown="return false;" oncontextmenu="return false;" onpaste="return false;" ondragenter="return false;"></td>       </tr>        <tr valign="top">          <td height="30" style="padding-top:3px;">大圖：</td>          <td><input type="file" name="P_image_b" onkeydown="return false;" oncontextmenu="return false;" onpaste="return false;" ondragenter="return false;"></td>       </tr>              <tr>          <td height="30" colspan="2" style="padding-top:3px;">介紹：</td>       </tr>        <tr>          <td height="30" colspan="2" valign="top">             <textarea name="P_content" cols="50" rows="5"></textarea>          </td>       </tr>       <tr>          <td colspan="2" valign="top" align="center">             <input type="submit" value="提交">&nbsp;<input type="reset" value="重置">                                          </td>       </tr>        </table>    </form> </body> </html>

[Ctrl+A 全選注:引入外部Js需再刷新一下頁面才能執(zhí)行]

8.TabPage類

[Ctrl+A 全選注:引入外部Js需再刷新一下頁面才能執(zhí)行]