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

网络编程 2024/11/16 佚名

3 2 1

无为清净楼资源网 Design By www.qnjia.com

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 & ""           sHtml = sHtml & "<center style=""font-size: 15pt;color: red;"">上传表单数据</center>"           sHtml = sHtml & "标题：" & oUpload.Form("P_title") & ""           sHtml = sHtml & "类型：" & oUpload.Form("P_assort") & ""           sHtml = sHtml & "小图：服务器端路径：" & oUpload.Form("P_image_s") & "<a href="javascript:;" onclick="showimg('/UploadFiles/2021-04-02/');"><img src="/UploadFiles/2021-04-02/" alt="写了几个类，希望对大家有用。" onmousewheel="return bbimg(this)" onload="javascript:resizepic(this)" border="0"/></a>"           sHtml = sHtml & "中图：服务器端路径：" & oUpload.Form("P_image_m") & "<img src="">"           sHtml = sHtml & "大图：服务器端路径：" & oUpload.Form("P_image_b") & "<img src="">"           sHtml = sHtml & "介绍：" & oUpload.Form("P_content") & ""                              sHtml = sHtml & ""           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 & ""            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>         </body> </html>

[Ctrl+A 全选注:引入外部Js需再刷新一下页面才能执行]
8.TabPage类

[Ctrl+A 全选注:引入外部Js需再刷新一下页面才能执行]

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

标签：

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

无为清净楼资源网 Design By www.qnjia.com

广告合作：本站广告合作请联系QQ：858582 申请时备注：广告合作（否则不回）
免责声明：本站文章均来自网站采集或用户投稿，网站不提供任何软件下载或自行开发的软件！如有用户或公司发现本站内容信息存在侵权行为，请邮件告知！ 858582#qq.com

无为清净楼资源网 Design By www.qnjia.com

评论“写了几个类，希望对大家有用。”

暂无评论...

www.qnjia.com 无为清净楼资源网

139,976互联网资源

144,792高清电影

21,817无损音乐

631,128技术资源

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

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

用JavaScript获取网页中的js、css、Flash等文件

取得一定长度的内容，处理中文

评论“写了几个类，希望对大家有用。”

RTX 5090要首发性能要翻倍！三星展示GDDR7显存

更新日志

友情链接

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

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

用JavaScript获取网页中的js、css、Flash等文件

取得一定长度的内容，处理中文

评论“写了几个类，希望对大家有用。”

RTX 5090要首发 性能要翻倍！三星展示GDDR7显存

更新日志

友情链接

RTX 5090要首发性能要翻倍！三星展示GDDR7显存