【图】写了几个类希望对大家有用

1.日历

2.简单的下拉菜单

3. QQ菜单效果

4.对联效果

5.图片轮换

6.listView类

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 = NothingarrFields = 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 ThenitemData(i) = ""   ElsefilePath = 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 = NothingEnd IfEnd IfEnd If  Next  Finished = True  Call ItemToColl ElseFinished = 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 ThenoBoolean = oBoolean And True ElsesErrors = sErrors & "表单[ " & itemName(i) & " ]的文件格式错误！n" & _ "支持的格式为：" & Replace(Mid(cFields, 2, Len(cFields) - 1), "|", " ") & "nn"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 ThensLine = "|"sPath = sPath & "" & sTemp ElseDim 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 = NothingEnd 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.CloseSet oStream = NothingEnd 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" ThenRem 建立上传类实例 Set oUpload = New UploadRem 指定允许上传文件的类型oUpload.CheckFields = "|GIF|BMP|JPG|"Rem 指定上传文件所存储的相对路径oUpload.Folder = "51JS.COM-ZMM/UploadFile"Rem 开始上传处理oUpload.StartIf oUpload.Finished Then   Rem 上传成功，显示上传信息   Dim sHtml : sHtml = ""   sHtml = sHtml & "<p style="text-align:center">"   sHtml = sHtml & ""   sHtml = sHtml & "<center style=""font-size: 15pt;color: red;"">上传表单数据</p>"   sHtml = sHtml & "标题：" & oUpload.Form("P_title") & ""   sHtml = sHtml & "类型：" & oUpload.Form("P_assort") & ""   sHtml = sHtml & "小图：服务器端路径：" & oUpload.Form("P_image_s") & "<img src=""" & oUpload.Form("P_image_s") & """>"   sHtml = sHtml & "中图：服务器端路径：" & oUpload.Form("P_image_m") & "<img src=""" & oUpload.Form("P_image_m") & """>"   sHtml = sHtml & "大图：服务器端路径：" & oUpload.Form("P_image_b") & "<img src=""" & oUpload.Form("P_image_b") & """>"   sHtml = sHtml & "介绍：" & oUpload.Form("P_content") & ""   sHtml = sHtml & ""   sHtml = sHtml & "</p>"   Response.Write sHtml   Response.EndElse   Rem 上传失败，显示错误信息   Call ShowMsg(oUpload.ErrMessage, Request.ServerVariables("SCRIPT_NAME"))End IfRem 对话框提示函数Function ShowMsg(byVal sText, byVal sTarget)Dim sScript : sScript = ""sScript = sScript & ""Response.Write sScriptResponse.EndEnd 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> </body> </html>

8.TabPage类