写了几个类，希望对大家有用。

　　1.日历

　　 [Ctrl+A 全选注:如需引入外部Js需刷新才能执行]

　　2.简单的下拉菜单

　　 [Ctrl+A 全选注:如需引入外部Js需刷新才能执行]

　　3. QQ菜单效果

　　 [Ctrl+A 全选注:如需引入外部Js需刷新才能执行]

　　4.对联效果

　　 [Ctrl+A 全选注:如需引入外部Js需刷新才能执行]

　　5.图片轮换

　　 [Ctrl+A 全选注:如需引入外部Js需刷新才能执行]

　　6.listView类

　　 [Ctrl+A 全选注:如需引入外部Js需刷新才能执行]

　　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 建立上传类实例        
       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;"">上传表单数据</center>
" 
          sHtml = sHtml & "标题：
" & oUpload.Form("P_title") & "

" 
          sHtml = sHtml & "类型：
" & oUpload.Form("P_assort") & "

" 
          sHtml = sHtml & "小图：
服务器端路径：<a href="" _ewebeditor_ta_href=""" & oUpload.Form("P_image_s") & """ target=""_blank"">" & oUpload.Form("P_image_s") & "</a>
<img src="" _ewebeditor_ta_src=""" & oUpload.Form("P_image_s") & """>

" 
          sHtml = sHtml & "中图：
服务器端路径：<a href="" _ewebeditor_ta_href=""" & oUpload.Form("P_image_m") & """ target=""_blank"">" & oUpload.Form("P_image_m") & "</a>
<img src="" _ewebeditor_ta_src=""" & oUpload.Form("P_image_m") & """>

" 
          sHtml = sHtml & "大图：
服务器端路径：<a href="" _ewebeditor_ta_href=""" & oUpload.Form("P_image_b") & """ target=""_blank"">" & oUpload.Form("P_image_b") & "</a>
<img src="" _ewebeditor_ta_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 对话框提示函数 
       Function ShowMsg(byVal sText, byVal sTarget) 
           Dim sScript : sScript = "" 
           sScript = sScript & "<img src="/_New/_cj/myeditor/sysimage/space.gif" class="ewebeditor__script" _ewebeditor_fake_tag="script" _ewebeditor_fake_value="%3Cscript%20language%3D%22%22javascript%22%22%3E%22%20%26%20vbCrlf%20%26%20_%20%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%22window.alert('%22%20%26%20sText%20%26%20%22')%3B%22%20%26%20vbCrlf%20%26%20_%20%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%22window.location.replace('%22%20%26%20sTarget%20%26%20%22')%3B%22%20%26%20vbCrlf%20%26%20_%20%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%22%3C%2Fscript%3E">" 
           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> 
<img src="/_New/_cj/myeditor/sysimage/space.gif" class="ewebeditor__script" _ewebeditor_fake_tag="script" _ewebeditor_fake_value="%3Cscript%20language%3D%22javascript%22%3E%20%0D%0A%20%20%20%20function%20formCheck(_form)%20%7B%20%0D%0A%20%20%20%20%20%20%20%20%20for%20(var%20i%20%3D%200%3B%20i%20%3C%20_form.elements.length%3B%20i%20%2B%2B)%20%7B%20%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20if%20(_form.elements%5Bi%5D.value%20%3D%3D%20'')%20%7B%20%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20window.alert('%E8%AF%B7%E5%B0%86%E8%A1%A8%E5%8D%95%E5%A1%AB%E5%86%99%E5%AE%8C%E6%95%B4%EF%BC%8C%E6%8F%90%E4%BA%A4%E5%A4%B1%E8%B4%A5%EF%BC%81')%3B%20%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20return%20false%3B%20%0D%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%7D%20%0D%0A%20%20%20%20%20%20%20%20%20%7D%20%0D%0A%20%20%20%20%20%20%20%20%20return%20true%3B%20%0D%0A%20%20%20%20%7D%20%0D%0A%3C%2Fscript%3E"> 
</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;">标题：</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="医疗">医疗</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="提交"> <input type="reset" value="重置">

</td> 
      </tr>     
   </table> 
   </form> 
</body> 
</html>

　　 [Ctrl+A 全选注:如需引入外部Js需刷新才能执行]

　　8.TabPage类

<comment id="Content1"> 
    标题： <input> 
       
    来源： <input> 
       
</comment> 
<comment id="Content2">       
    分类： <select><option>计算机网络</option><option>计算机软件</option></select>       
</comment>       
<comment id="Content3">       
    测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试       
</comment>

　　 [Ctrl+A 全选注:如需引入外部Js需刷新才能执行]

教程首页更多教程