易网时代-编程资源站
Welcome
微信登录
首页
/
脚本样式
/
JavaScript
/
写了几个类,希望对大家有用。
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 PublicForm, 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 ItemPositionEnd Function Private Function ItemPosition Dim iStart, iLength : iStart = 1 Do Until InStrB(iStart, formData, bSeparate) = 0iStart = InStrB(iStart, formData, bSeparate) + LenB(bSeparate) + 14iLength = InStrB(iStart, formData, bSeparate) - iStart - 2If Abs(iStart + 2 - LenB(formData)) > 2 Then ReDim Preserve itemStart(itemCount) ReDim Preserve itemLength(itemCount) itemStart(itemCount) = iStart itemLength(itemCount) = iLength itemCount = itemCount + 1End 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 ThenbInfor = 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 IfdataStart(iCount) = itemStart(i) + iStart - 2dataLength(iCount) = iLength ElseextenArr(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 = "" ThenFileExtenName = "" ElseSet regEx = New RegExpregEx.Pattern = "^.*(.[^.]*)$"regEx.Global = FalseregEx.IgnoreCase = TrueFileExtenName = 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 < sLensTemp = 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 ThenFor i = 0 To itemCount - 1If (dataStart(i) <> "") And (dataLength(i) <> "") ThenIf dataLength(i) = 0 Then itemData(i) = "" Else filePath = Server.MapPath(itemData(i)) If CreateFolder("|", ParentFolder(filePath)) ThenSet oStreamGet = Server.CreateObject("ADODB.Stream")oStreamGet.Type = 1oStreamGet.Mode = 3oStreamGet.OpenoStreamGet.Write formDataoStreamGet.Position = dataStart(i)Set oStreamPut = Server.CreateObject("ADODB.Stream")oStreamPut.Type = 1oStreamPut.Mode = 3oStreamPut.OpenoStreamPut.Write oStreamGet.Read(dataLength(i))oStreamPut.SaveToFile(filePath)oStreamGet.CloseSet oStreamGet = NothingoStreamPut.CloseSet oStreamPut = Nothing End IfEnd If End IfNextFinished = TrueCall ItemToColl Else Finished = False End If End Function Private Function CheckFile Dim oBoolean : oBoolean = True If cFields = "" ThenoBoolean = oBoolean And True ElseFor i = 0 To itemCount - 1If extenArr(i) <> "" Then If InStr(1, Ucase(cFields), "|" & Ucase(Mid(extenArr(i), 2)) & "|") > 0 ThenoBoolean = oBoolean And True ElsesErrors = sErrors & "表单[ " & itemName(i) & " ]的文件格式错误! " & _"支持的格式为:" & Replace(Mid(cFields, 2, Len(cFields) - 1), "|", " ") & " "oBoolean = oBoolean And FalseEnd IfEnd 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) ThenDim regExSet regEx = New RegExpregEx.Pattern = "^(.*)\([^\]*)$"regEx.Global = FalseregEx.IgnoreCase = True sLine = sLine & regEx.Replace(sPath, "$2") & "|"sPath = regEx.Replace(sPath, "$1") If CreateFolder(sLine, sPath) Then CreateFolder = True Set regEx = Nothing ElseIf sLine = "|" Then CreateFolder = TrueElse Dim sTemp : sTemp = Mid(sLine, 2, Len(sLine) - 2) If InStrRev(sTemp, "|") = 0 ThensLine = "|"sPath = sPath & "" & sTempElseDim 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)) ThenForm.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 & "
" sHtml = sHtml & "" sHtml = sHtml & "
上传表单数据
" sHtml = sHtml & "标题:" & oUpload.Form("P_title") & "" sHtml = sHtml & "类型:" & oUpload.Form("P_assort") & "" sHtml = sHtml & "小图:服务器端路径:" & oUpload.Form("P_image_s") & "
" sHtml = sHtml & "中图:服务器端路径:" & oUpload.Form("P_image_m") & "
" sHtml = sHtml & "大图:服务器端路径:" & oUpload.Form("P_image_b") & "
" sHtml = sHtml & "介绍:" & oUpload.Form("P_content") & ""sHtml = sHtml & "" sHtml = sHtml & "
" 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 %>
多文件、表单混合上传类
" method="post" enctype="multipart/form-data" onsubmit="return formCheck(this);">
上传功能测试
标题:
类型:
电子
医疗
小图:
中图:
大图:
介绍:
</textarea>
[Ctrl+A 全选 注:如需引入外部Js需刷新才能执行]
8.TabPage类
标题:
来源:
分类:
计算机网络
计算机软件
测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试测试
[Ctrl+A 全选 注:如需引入外部Js需刷新才能执行]
版权所有©石家庄振强科技有限公司2024
冀ICP备08103738号-5
网站地图