|
发了这篇贴子，俺也是超级用户了，借此勉励，希望大家喜欢，有能用上的顶一下，有建议的也帮忙给点意见，谢谢了！ '清理SQL字符串，防止注入 <%function Sqlstr(data) sqlstr="'" & replace(data,"'","''") & "'"end function '在当前位置设置断点，如果出错则给出错误提示并停止运行，否则提示没错，继续运行 sub Chkerr(place) if is_debug = false then exit sub if err then Response.Write "错误发生在:"&place&"<br />错误描述:"&err.description response.End() else Response.Write "<br />在[<font color=""red"">"&place&"</font>]没有发生错误！" end ifend sub '当前位置输出某个变量值 sub Chkstr(str) if is_debug then Response.Write str&"<br />"end sub '替换response.write ，偷懒的做法 sub Outputx(str) Response.Write strend sub '在当前位置停止运行，同时检查错误 sub Debug(dstr) if dstr="" then dstr="Debug stops here:--" chkerr dstr outputx "<br />DEBUG STOPS HERE" response.End()end sub '输出表格属性，也是一偷懒的做法 sub Table_Alt() response.Write(" width=""98%"" border=""1"" align=""center"" cellpadding=""0"" cellspacing=""1"" bordercolorright=""#000000"" bordercolordark=""#ffffff"" ")end sub
'隐藏该标签，如<table ..... <% Hide_This % > > sub Hide_This() outputx " style=""display:none;"" "end sub '禁止某个控件的点击，如<a >,<input ../>等等 sub Disable_Menu() response.Write " onclick=""return false;"" "end sub '在当前位置显示一个图片，给出帮助信息，点击后弹出提示框 sub help(str) str = "-- 帮助 -- \n\n帮助信息:"&str response.Write "<a href=""#"" onclick=""alert('"&str&"');return false;""><img src=""p/help.gif"" alt="""&replace(replace(str,"\n\n","\n"),"\n","<br />")&""" /></a>"end sub
'检查输入值，如果为空，则用-替代，可用于防止保存到数据库的为空值，或某值为空时的显示不规则 function Get_Value(x) if isnull(x) or x="" then get_value = "-" else get_value = x end ifend function '用CSS定义<H6>，显示系统提示信息，如需要，可提供更详细的使用说明 sub Sys_Tip(msg) if len(msg)>0 then response.write "<h6>"&msg&"</h6>"end sub '检查当前recordset是否为空 '用if isrb(rs) then 替代 if rs.bof and rs.eof then'也是一偷懒的方法function isRb(rs) if rs.bof and rs.eof then isrb = true else isrb = false end ifend function '清理以,分割的字符串，清理其中的两个分隔符号，去掉前后的符号 function Clean_Ary(ary_name) if left(ary_name,1) = "," then ary_name=mid(ary_name,2,len(ary_name)) if right(ary_name,1) = "," then ary_name=mid(ary_name,1,len(ary_name)-1) do while instr(ary_name,",,")<>0 ary_name = replace(ary_name,",,",",") loop clean_ary = ary_nameend function '去掉输入参数里的HTML标签，这是其中一个函数 Function RemoveHTML_A(strText) Dim nPos1 Dim nPos2 nPos1 = InStr(strText, "<") Do While nPos1>0 nPos2 = InStr(nPos1+1, strText, ">") If nPos2>0 Then strText = Left(strText, nPos1 - 1) & Mid(strText, nPos2 + 1) Else Exit Do End If nPos1 = InStr(strText, "<") Loop RemoveHTML_A = strText End Function '在新闻标题列表等应用中，只取一定长度的字符，若超过这个长度，则加上... function GetTitle(title,content,length) If length = 0 Then length = 8 if title = "" or isnull(title) then title = left(RemoveHTML_A(content),30) If Len(title) > length Then GetTitle = Left(title, length) & ".." Else GetTitle = title End Ifend function '关闭和释放记录集对象sub RsClose(rst) if isobject(rst) then rst.close set rst = nothing end ifend sub'关闭和释放connetion对象sub DbClose(conn) if isobject(conn) then conn.close set conn = nothing end ifend sub'这也是种关闭和释放对象的方法，在页末使用sub EndPage(rs,conn) set rs = nothing set conn = nothingend sub '这是一组时间函数，是我在做取昨天的日期的时候整理的 '判断是否是闰年Function IsLeapYear(yr) If ((yr Mod 4 = 0 ) And (yr Mod 100 <> 0)) Or (yr Mod 400 = 0) Then IsLeapYear = True Else IsLeapYear = False End IfEnd Functionfunction get_month_last_day(sm) redim months(12) months(1)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31" months(2)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28" if IsLeapYear(year(date())) then months(2) = months(2) &",29" months(3)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31" months(4)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30" months(5)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31" months(6)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30" months(7)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31" months(8)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31" months(9)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30" months(10)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31" months(11)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30" months(12)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31" get_month_last_day = mid(months(sm),len(months(sm))-1,2)end function'得到昨天的日期function get_lastday(this_day) 'outputx "今天是"&this_day&",今年的第["&datediff("d","2005-1-1",this_day)&"]天<br />" syear = year(this_day) smonth = month(this_day) sday = day(this_day) if sday = 1 then if smonth = 1 then '去年 get_lastday = cstr(cint(syear)-1)&"-12-31" else get_lastday = syear&"-"& cstr(cint(smonth)-1)&"-"&get_month_last_day(cstr(cint(smonth)-1)) end if else get_lastday = syear&"-"&smonth&"-"&cstr(sday-1) end ifend function
'一组根据输入值是否为空而返回同值的函数 '检查是否为空，如是则返回"未填写"function chk_not_input(str) if str="" or isnull(str) then chk_not_input="未填写" else chk_not_input=str end ifend function'检查是否为空，返回str类型function chk_null_str(str) if str="" or isnull(str) then chk_null_str="未填" else chk_null_str=str end ifend function'检查是否为空，返回0function chk_null_0(str) if isnull(str) or str="" or str="-" then chk_null_0="0" else chk_null_0=str end ifend function'检查是否为空，为空则用X替换function chk_null_x(str,x) if str="" or isnull(str) then chk_null_x=x else chk_null_x=str end ifend function'检查是否为空，为空则用横线替换function chk_null_line(str) if str="" or isnull(str) then chk_null_line="-" else chk_null_line=str end ifend function%> |
乘机一帖，希望能有用 '''''''''''''''''''''''''''''''''''''''''''弹出信息对话框并做相应处理''''''''''''''''''''''''''''''''''''''''''''''''' 一直使用着，调用很明了，有两种： 1，call alert("弹出返回信息","-1") 2，call alert("跳转某地址","http: //.....") Function alert(message,gourl) message = replace(message,"'","\'") If gourl="" or gourl="-1" then Response.Write ("<script language=javascript>alert('" & message & "');history.go(-1)</script>") Else Response.Write ("<script language=javascript>alert('" & message & "');location='" & gourl &"'</script>") End If Response.End()End Function
'''''''''''''''''''''''''''''''''''''''''''禁止站外提交数据''''''''''''''''''''''''''''''''''''''''''''''''' 主要用在一些权限页面（即凭借用户名密码正确登录后能访问的页）上，直接 call outofsite() 调用检查。 注意：这里就使用了上面的 alert(message,gourl) 函数。 Function outofsite() Dim server_v1,server_v2 server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) if mid(server_v1,8,len(server_v2))<>server_v2 then call alert("\n注意，为确保本站点的安全性：\n● 禁止直接输入网址到达机密页面！\n● 禁止从站点外部非法向本站提交数据！\n● 请使用正确的访问途径合法登录，谢谢合作。","-1") end ifEnd Function
'''''''''''''''''''''''''''''''''''''''''''取得IP地址''''''''''''''''''''''''''''''''''''''''''''''''' 要获得IP值直接使用 call userip() 即可 Function Userip() Dim GetClientIP '如果客户端用了代理服务器，则应该用ServerVariables("HTTP_X_FORWARDED_FOR")方法 GetClientIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR") If GetClientIP = "" or isnull(GetClientIP) or isempty(GetClientIP) Then '如果客户端没用代理，应该用Request.ServerVariables("REMOTE_ADDR")方法 GetClientIP = Request.ServerVariables("REMOTE_ADDR") End If Userip = GetClientIPEnd function
'''''''''''''''''''''''''''''''''''''''''''简易处理较长文本''''''''''''''''''''''''''''''''''''''''''''''''' 我一般是用在首页的新闻标题调用，主要是中文，所以就用个简易的。 比如提取标题只显示12个字。 call conleft(rs("n_title"),12) function conleft(contact,i)if len(contact)>i then contact=left(contact,i) conleft=contact&"..."else conleft=contactend ifend function '''''''''''''''''''''''''''''''''''''''''''登陆验证接口函数''''''''''''''''''''''''''''''''''''''''''''''''' 接口有一定的通用性：） 先 call outofsite() 防止外部注册机提交 requestname和requestpwd 分别表示接受用户名和密码的表单对象的名称 tablename、namefield和pwdfield 分别表示数据库中存放用户信息的表、记录用户名的字段和用户密码的字段。（这里密码是MD5加密，否则请修改函数中的MD5()包含） reurl 表示正确登录后跳转的地址 注意：这里同样使用了上面的 alert(message,gourl) 函数 有人还有就是增加了验证码，这里说明下：主要是先验证码正确，再检测用户名和密码的，所以本函数与有验证码的登录无大关系。 关于这个还有要增强的，就是每次用户名和密码不正确的记录，连上该帐号测试的IP，一起通过JMAIL发送到管理员信箱，这样管理员就能随时掌握登录的情况。 Function chk_regist(requestname,requestpwd,tablename,namefield,pwdfield,reurl)call outofsite()dim cn_name,cn_pwd cn_name=trim(request.form(""&requestname&"")) cn_pwd=trim(request.form(""&requestpwd&"")) if cn_name="" or cn_pwd="" then call alert("请将帐号或密码填写完整，谢谢合作。","-1") response.end() end if Set rs = Server.CreateObject ("ADODB.Recordset") sql = "Select * from "&tablename&" where "&namefield&"='"&cn_name&"'" rs.open sql,conn,1,1 if rs.eof then call alert("警告，非法猜测用户名！","-1") else if rs(""&pwdfield&"")=md5(cn_pwd) then session("cn_name")=rs(""&namefield&"") '这个地方的session名称可以自己修改 response.Redirect(reurl) else call alert("请正确输入用户名和与之吻合的密码。","-1") end if end ifEnd Function
'''''''''''''''''''''''''''''''''''''''''''布尔切换值函数''''''''''''''''''''''''''''''''''''''''''''''''' 主要用在一些双向选择的字段类型上，比如产品的 推荐和不推荐 等 具体如何应用就不详说了，各位慢慢看 function pvouch(tablename,fildname,autoidname,indexid)dim fildvalueSet rs = Server.CreateObject ("ADODB.Recordset")sql = "Select * from "&tablename&" where "&autoidname&"="&indexidrs.Open sql,conn,2,3fildvalue=rs(""&fildname&"")if fildvalue=0 then fildvalue=1else fildvalue=0end ifrs(""&fildname&"")=fildvaluers.updaters.close Set rs = Nothingend function
缔吧-DW暨WEB技术站 Blueidea Web Team Moderator Of Blueidea Developer forum |
|
乘机一帖，希望能有用 '''''''''''''''''''''''''''''''''''''''''''弹出信息对话框并做相应处理''''''''''''''''''''''''''''''''''''''''''''''''' 一直使用着，调用很明了，有两种： 1，call alert("弹出返回信息","-1") 2，call alert("跳转某地址","http: //.....") Function alert(message,gourl) message = replace(message,"'","\'") If gourl="" or gourl="-1" then Response.Write ("<script language=javascript>alert('" & message & "');history.go(-1)</script>") Else Response.Write ("<script language=javascript>alert('" & message & "');location='" & gourl &"'</script>") End If Response.End()End Function
'''''''''''''''''''''''''''''''''''''''''''禁止站外提交数据''''''''''''''''''''''''''''''''''''''''''''''''' 主要用在一些权限页面（即凭借用户名密码正确登录后能访问的页）上，直接 call outofsite() 调用检查。 注意：这里就使用了上面的 alert(message,gourl) 函数。 Function outofsite() Dim server_v1,server_v2 server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) if mid(server_v1,8,len(server_v2))<>server_v2 then call alert("\n注意，为确保本站点的安全性：\n● 禁止直接输入网址到达机密页面！\n● 禁止从站点外部非法向本站提交数据！\n● 请使用正确的访问途径合法登录，谢谢合作。","-1") end ifEnd Function
'''''''''''''''''''''''''''''''''''''''''''取得IP地址''''''''''''''''''''''''''''''''''''''''''''''''' 要获得IP值直接使用 call userip() 即可 Function Userip() Dim GetClientIP '如果客户端用了代理服务器，则应该用ServerVariables("HTTP_X_FORWARDED_FOR")方法 GetClientIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR") If GetClientIP = "" or isnull(GetClientIP) or isempty(GetClientIP) Then '如果客户端没用代理，应该用Request.ServerVariables("REMOTE_ADDR")方法 GetClientIP = Request.ServerVariables("REMOTE_ADDR") End If Userip = GetClientIPEnd function
'''''''''''''''''''''''''''''''''''''''''''简易处理较长文本''''''''''''''''''''''''''''''''''''''''''''''''' 我一般是用在首页的新闻标题调用，主要是中文，所以就用个简易的。 比如提取标题只显示12个字。 call conleft(rs("n_title"),12) function conleft(contact,i)if len(contact)>i then contact=left(contact,i) conleft=contact&"..."else conleft=contactend ifend function '''''''''''''''''''''''''''''''''''''''''''登陆验证接口函数''''''''''''''''''''''''''''''''''''''''''''''''' 接口有一定的通用性：） 先 call outofsite() 防止外部注册机提交 requestname和requestpwd 分别表示接受用户名和密码的表单对象的名称 tablename、namefield和pwdfield 分别表示数据库中存放用户信息的表、记录用户名的字段和用户密码的字段。（这里密码是MD5加密，否则请修改函数中的MD5()包含） reurl 表示正确登录后跳转的地址 注意：这里同样使用了上面的 alert(message,gourl) 函数 有人还有就是增加了验证码，这里说明下：主要是先验证码正确，再检测用户名和密码的，所以本函数与有验证码的登录无大关系。 关于这个还有要增强的，就是每次用户名和密码不正确的记录，连上该帐号测试的IP，一起通过JMAIL发送到管理员信箱，这样管理员就能随时掌握登录的情况。 Function chk_regist(requestname,requestpwd,tablename,namefield,pwdfield,reurl)call outofsite()dim cn_name,cn_pwd cn_name=trim(request.form(""&requestname&"")) cn_pwd=trim(request.form(""&requestpwd&"")) if cn_name="" or cn_pwd="" then call alert("请将帐号或密码填写完整，谢谢合作。","-1") response.end() end if Set rs = Server.CreateObject ("ADODB.Recordset") sql = "Select * from "&tablename&" where "&namefield&"='"&cn_name&"'" rs.open sql,conn,1,1 if rs.eof then call alert("警告，非法猜测用户名！","-1") else if rs(""&pwdfield&"")=md5(cn_pwd) then session("cn_name")=rs(""&namefield&"") '这个地方的session名称可以自己修改 response.Redirect(reurl) else call alert("请正确输入用户名和与之吻合的密码。","-1") end if end ifEnd Function
'''''''''''''''''''''''''''''''''''''''''''布尔切换值函数''''''''''''''''''''''''''''''''''''''''''''''''' 主要用在一些双向选择的字段类型上，比如产品的 推荐和不推荐 等 具体如何应用就不详说了，各位慢慢看 function pvouch(tablename,fildname,autoidname,indexid)dim fildvalueSet rs = Server.CreateObject ("ADODB.Recordset")sql = "Select * from "&tablename&" where "&autoidname&"="&indexidrs.Open sql,conn,2,3fildvalue=rs(""&fildname&"")if fildvalue=0 then fildvalue=1else fildvalue=0end ifrs(""&fildname&"")=fildvaluers.updaters.close Set rs = Nothingend function
缔吧-DW暨WEB技术站 Blueidea Web Team Moderator Of Blueidea Developer forum |
|
|
我也来贴两个。 在数据库连接Conn开启的情况下使用。 检查数据是否重复，比如注册用户的时候。 '检查数据是否重复 Function chkRecord(newValue,chkTable,chkField) Dim chkRecordRs,chkRecordSql,chkValue If Trim(newValue) = "" Then chkValue = false Else chkRecordSql = "Select ID From "&chkTable&" Where "&chkField&" = '"&newValue&"'" Set chkRecordRs = Conn.Execute( chkRecordSql ) If chkRecordRs.Eof Or chkRecordRs.Bof Then chkValue = true Else chkValue = false End If Set chkRecordRs = Nothing End If chkRecord = chkValue End Function 获取在cname表中与id对应的fname的值 Function getName(id,cname,fname) If IsNumeric(id) Then Dim getNameRs,getNameSql getNameSql = "Select "&fname&" From "&cname&" Where Id="&Cint(id) Set getNameRs = Conn.Execute (getNameSql) If Not(getNameRs.Eof Or getNameRs.Bof) Then getName = getNameRs(fname) Else getName = "" End If Set getNameRs = Nothing Else getName = "" End IfEnd Function
凤翱翔于千仞兮，非梧不栖。 士伏处于一方兮，非主不依。 乐躬耕于陇亩兮，吾爱吾庐。 聊寄傲于琴书兮，以待天时。 [img]http://img.bbs4.tom.com/upload_img/375/200503/pic_1111395563.jpg[/img] |
|
|
那我接两个检测正则的~~ 站点链接检测 function checklink(str)dim rs,truelinkif (str="http://") then str=""end ifif not (str="") then set rs=new regexp rs.ignorecase=true rs.global=true rs.pattern="(http:\/\/((\w)+[.]){1,}([A-Za-z]|[0-9]{1,3})(((\/[\~]*|\\[\~]*)(\w)+)|[.](\w)+)*(((([?](\w)+){1}[=]*))*((\w)+){1}([\&](\w)+[\=](\w)+)*)*)" truelink=rs.test(str) if truelink=false then response.redirect("error.asp?err=site") response.end set rs=nothing end ifend ifend function
电子邮件地址检测 function checkmail(str)dim rs,truemailif not (str="") then set rs=new regexp rs.ignorecase=true rs.global=true rs.pattern="(\w)+[@]{1}((\w)+[.]){1,3}(\w)+" truemail=rs.test(str) if truemail=false then response.redirect("error.asp?err=email") response.end set rs=nothing end ifend ifend function
仁慈的主啊，请您宽恕我这个有罪之人吧，我又开始潜水拉~~ num2 | To be NO.1 |
|
我也来来:***Lettergraph v1.1 by Ferruh Mavituna'//NFO//' Write Letters as images'//ARGUMENTS//' valx : Text (alphanumeric)'//SAMPLE//' Response.Write P13_Lettergraph("soul")' >>> Need alphabet folder <<<'******************************'Function P13_Lettergraph(valx,folder)' If folder = "" Then folder ="alphabet"'******************************Function P13_Lettergraph(valx)Dim ix, ix2, valxarr, curletter, lmodIf valx <> "" Thenvalxarr = Split(Trim(valx)," ")For ix2 = 0 to Ubound(valxarr)For ix = 1 to Len(valxarr(ix2))curletter = Left(valxarr(ix2),1)'// Turkish Character MapIf Ucase(curletter) = "Ş" Then curletter = "s2"If Ucase(curletter) = "Ğ" Then curletter = "g2"If Ucase(curletter) = "i" Then curletter = "i2"If Ucase(curletter) = "Ü" Then curletter = "u2"If Ucase(curletter) = "Ö" Then curletter = "o2"If ix2 mod 2 Then lmod = "2" Else lmod = ""P13_Lettergraph = P13_Lettergraph & "<img src=""13mg/lt" & lmod &"/" & curletter &".gif"" alt=""" & curletter & """ />"valxarr(ix2) = Right(valxarr(ix2),Len(valxarr(ix2))-1)NextIf ix2 < Ubound(valxarr) Then P13_Lettergraph = P13_Lettergraph & "<img src=""13mg/lt/dot.gif"" alt=""dot"" />"NextEnd IfEnd Function
使用: response.write(P13_Lettergraph("123456789"))response.write("123456789")
[这消息被5do8编辑过(最后编辑时间2005-10-27 11:36:31)] |
|
|
图片路径你要自己裁缝的 这个的意思就是说把字符串的"每个字符"导出图片形式,在ubb图片的时候可用. -------------------返回字符串出现的次数-------------------- Function search(pSearch, pSearchStr)Dim tempSearch, tempSearchStr, startpos, endposstartpos = 1Dim ctrctr = 0Do While (startpos > 0)endpos = InStr(startpos, LCase(pSearch), LCase(pSearchStr))If endpos > 0 Thenctr = ctr + 1startpos = endpos + Len(pSearchStr)ElseExit DoEnd IfLoopsearch = ctr End Function |
|
------------------------url处理函数------------------------------<%'Add a name/value pair to a URLFunction QueryStringAdd(ByVal URL, ByVal Name, ByVal Value)'Start with the existing URLQueryStringAdd = URL'Determine whether or not there's a querystringIf (InStr(URL, "?") > 0) Then'Yes, so append the name/value pair using an ampersandQueryStringAdd = QueryStringAdd & "&"Else'No, so start one off with a question markQueryStringAdd = QueryStringAdd & "?"End If'And add the URLEncoded name/value pairQueryStringAdd = QueryStringAdd & Server.URLEncode(Name) & "=" & Server.URLEncode(Value)End Function'Remove a name/value pair from a URL'Usage: AllInstances = False --> Removes the rightmost instance from the URL' AllInstances = True --> Removes all instances from the URLFunction QueryStringRemove(ByVal URL, ByVal Name, ByVal AllInstances)Dim PositionQueryString, PageLocation, QueryString, Substring, PositionCurrent, PositionEnd, PositionAmpersandPositionQueryString = Instr(URL, "?")'Only process the specified URL if it actually contains a querystring!If (PositionQueryString > 0) Then'Split the URL into the page location and querystringPageLocation = Left(URL, PositionQueryString - 1)QueryString = Mid(URL, PositionQueryString)'Build the substring we will be searching forSubstring = Server.URLEncode(Name) & "="'Find the last (rightmost) instance of the'specified variable in the querystringPositionCurrent = InStrRev(QueryString, Substring) - Len(SubString)If (AllInstances) Then'Only stop one we've reached the start of the querystringPositionEnd = 0Else'Stop once we've removed the last instancePositionEnd = PositionCurrentEnd If'Loop until we've reached our set end positionWhile ((PositionCurrent > 0) And (PositionCurrent >= PositionEnd))'The substring is present in the URLPositionCurrent = InStrRev(QueryString, Substring)If (PositionCurrent > 0) Then'If a match was found, remove it!'Find the start of the next querystring variable'by finding the ampersand that would preceed itPositionAmpersand = InStr(PositionCurrent, QueryString, "&")If (PositionAmpersand = 0) Then'If there isn't another ampersand in the URL then it'must be the last variable in the querystring so'only grab the characters from the start of the string'up until the character before the current position'(so that any preceeding & or ? is chopped)QueryString = Left(QueryString, PositionCurrent - 2)PositionCurrent = Len(QueryString)Else'Otherwise grab characters from start of the string'until the current position, and from after the'position of the ampersand onwardsQueryString = Left(QueryString, PositionCurrent - 1) & Mid(QueryString, PositionAmpersand + 1)PositionCurrent = PositionAmpersandEnd IfEnd IfWendIf QueryString = "?" ThenQueryString = ""End If'Return the processed URLQueryStringRemove = PageLocation & QueryStringElseQueryStringRemove = URLEnd IfEnd Function'TEST CODE'---------URL = "http://www.testserver.com/tests cript.asp"'Test adding a variable and removing itURL = QueryStringAdd(URL,"test","1")Response.Write URL & "<br />"URL = QueryStringRemove(URL,"test",False)Response.Write URL & "<br />"'Now add a couple of the same name with a different one in the'middle and remove them individually but in a different orderURL = QueryStringAdd(URL,"test","2")URL = QueryStringAdd(URL,"dummy","dummyvalue")URL = QueryStringAdd(URL,"test","3")Response.Write URL & "<br />"URL = QueryStringRemove(URL,"test",False)Response.Write URL & "<br />"URL = QueryStringRemove(URL,"test",False)Response.Write URL & "<br />"URL = QueryStringRemove(URL,"dummy",False)Response.Write URL & "<br />"'Now do something similar but remove all'instances of "test" in a single callURL = QueryStringAdd(URL,"test","2")URL = QueryStringAdd(URL,"test","2")URL = QueryStringAdd(URL,"dummy","dummyvalue")URL = QueryStringAdd(URL,"test","2")URL = QueryStringAdd(URL,"test","2")Response.Write URL & "<br />"URL = QueryStringRemove(URL,"test",True)Response.Write URL & "<br />"%> 在处理get方式递交信息时好使的很! |
|
|
我这个算函数吗？？ 是用来替换关键字的。 '*******************************************************************'replacekeyword(keytext)'需要和库联接时才能使用'入口参数：keytext '出口参数：replacekeyword'******************************************************************function repkeyword(keytext) dim rers dim db_kewords, db_rewords, arr_kewords, arr_rewords set rers = conn.execute("select * from words_key where show=1 order by list_id") while not rers.eof db_kewords = db_kewords&"|"&rers(1) db_rewords = db_rewords&"|"&lcase(rers(2)) arr_kewords = split(db_kewords,"|") arr_rewords = split(db_rewords,"|") rers.movenext wend set rers = nothing Dim re Set re = new RegExp re.IgnoreCase = True re.Global = True for i = 1 to ubound(arr_kewords) re.Pattern="([^""|=|\\|\/|@]|^)("&arr_kewords(i)&")" keytext = re.Replace(keytext," $1<a href=$2>$2</a>") next repkeyword = keytext set re = Nothingend function
[生命其实就是一个过程，可悲的是它不能够重新开始，可喜的是它也不需要重新开始.] |
|
|
我也来贴自己的和收集的 '禁止采集页面 Sub LockPage()Dim http_reffer,server_namehttp_reffer=Request.ServerVariables("HTTP_REFERER")server_name=Request.ServerVariables("SERVER_NAME")if CheckAgent()=False Thenif http_reffer="" or left(http_reffer,len("http://"&server_name)+1)<>"http://"&server_name&"/" ThenResponse.Write("<html><body>")Response.Write("<form action='' name=checkrefer id=checkrefer method=post>")Response.Write("</form>")Response.Write("<script>")'Response.Write("alert('禁止非法访问');")Response.Write("document.all.checkrefer.action=document.URL;")Response.Write("document.all.checkrefer.submit();")Response.Write("</script>")Response.Write("</body></html>")response.endend IfEnd IfEnd Sub
'检查当前访问者是否是蜘蛛人Function CheckAgent()Dim user_agent,allow_agentuser_agent=Request.ServerVariables("HTTP_USER_AGENT")allow_agent=split("Baiduspider,Scooter,ia_archiver,Googlebot,FAST-WebCrawler,MSNBOT,Slurp",",")CheckAgent=Falsefor agenti=lbound(allow_agent) to ubound(allow_agent)if instr(user_agent,allow_agent(agenti))>0 ThenCheckAgent=Trueexit ForEnd IfNextend Function
'身份证校验Function CheckidCard(idcard)Dim LenCardLenCard=Len(idcard) '判断身份证长度if not (LenCard = 15 Or LenCard = 18) Then CheckidCard= "身份证长度不是15位或18位"exit FunctionEnd If '变量声明区dim WeightedFactor,VerifyCode,area,birthday,lastnum,Ai,i,Total,Modnum,sex,age,province,sexNum,provinceIDWeightedFactor = array(7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2) '为前17位各个数字对应的加权因子VerifyCode = array(1,0,"x",9,8,7,6,5,4,3,2) '通过模得到的校验码area="11北京,12天津,13河北,14山西,15内蒙古,21辽宁,22吉林,23黑龙江,31上海,32江苏,33浙江,34安徽,35福建,36江西,37山东,41河南,42湖北,43湖南,44广东,45广西,46海南,50重庆,51四川,52贵州,53云南,54西藏,61陕西,62甘肃,63青海,64宁夏,65新疆,71台湾,81香港,82澳门,91国外"'判断地区provinceID=left(idcard,2) if instr(area,provinceID)=0 then CheckidCard= "身份证头2位错误" exit function end If'补齐15位卡号if LenCard= 15 then idcard=left(idcard,6) & "19" & mid(idcard,7,9) '判断生日birthday= mid(idcard,7,4)+"-"+mid(idcard,11,2)+"-"+mid(idcard,13,2)if not isdate(birthday) thenCheckidCard= "生日非法"exit functionend Ifif datediff("yyyy",cdate(birthday),date())<18 then CheckidCard= "你还未满18岁,不可能有身份证的" exit function end If'判断检验码 if len(idcard)=18 then lastnum=int(right(idcard,1)) 'lastnum为18位身份证最后一位 Ai=left(idcard,17) 'Ai为除最后一位字符的字串 For i = 0 To 16 Total = Total + cint(Mid(Ai,i+1,1)) * WeightedFactor(i) 'Total前17位数字与对应的加权因子积的和 Next Modnum=total mod 11 '此数为模,total除以11后的余数 if VerifyCode(Modnum)<>lastnum then CheckidCard= "最后一位校验码不对" exit function end if end If'计算性别sexNum=mid(idcard,17,1)sex="男性"if (sexNum mod 2) =0 then sex="女性" '计算年龄age=datediff("yyyy",cdate(birthday),date())'计算省份 province=mid(area,instr(area,provinceID)+2,3)province=replace(province,",","")CheckidCard= "恭喜,身份证通过校验<br/>" & "您为:" & sex & ",来自于:" & province & ",生日为:" & birthdayEnd Function
'设置页面马上过期Sub PageNoCache()Response.Expires = 0 Response.expiresabsolute = Now() - 1 Response.addHeader "pragma", "no-cache" Response.addHeader "cache-control", "private" Response.CacheControl = "no-cache" Response.Buffer = True Response.ClearServer.ScriptTimeOut=999999999End Sub '把中文變成unicodefunction chinese2unicode(Salon)dim idim Salon_onedim Salon_unicodeif Salon="" then Salon="无"for i=1 to len(Salon)Salon_one=Mid(Salon,i,1)Salon_unicode=Salon_unicode&chr(38)Salon_unicode=Salon_unicode&chr(35)Salon_unicode=Salon_unicode&chr(120)Salon_unicode=Salon_unicode& Hex(ascw(Salon_one))Salon_unicode=Salon_unicode&chr(59)Nextchinese2unicode=Salon_unicodeEnd Function
提供万网、中频、商中、新网、互联、ENOM、DIRECTI全线产品。国外PHP5G空间 500RMB／年(无限MYSQL,无限域名） 国外ASP5G空间 1500RMB／年 QQ:116610 www.gzcom.net |
|
|
我给个简单的 '把表中有限的几个分类转换成"汉字" <% dim quizClass,quizOption 'quizClass=rs("quizLib.quizClass") quizClass=rs("quizClass") select case quizClass case "radio1" response.Write("判断题") case "radio2" response.Write("单选题") case "checkbox" response.Write("多选题") case "text" response.Write("填空题") end select %>
www.ke8.org 阿宝 2006年到来之前就会火起来 我预测的:D |
|
|
格式日期: Function OracleDate( dt ) dt = CDate( dt ) ' just to be sure OracleDate = Right( "0" & Day(dt), 2 ) & "-" _ & UCase( MonthName(Month(dt), True) ) & "-" _ & Year(dt)End Function 查找字符串的次数: Function search(pSearch, pSearchStr)Dim tempSearch, tempSearchStr, startpos, endposstartpos = 1Dim ctrctr = 0Do While (startpos > 0)endpos = InStr(startpos, LCase(pSearch), LCase(pSearchStr))If endpos > 0 Thenctr = ctr + 1startpos = endpos + Len(pSearchStr)ElseExit DoEnd IfLoopsearch = ctr End Function 不要吝啬,大方点,我已经帖子这么几个吐血的了,怎么有人只copy不共享?寒.闪了~ |
|
蓝色里的一个大哥给我的，很好用，大家试试吧'// 去调HTML标签 输出function delhtml(strhtml) dim objregexp, stroutput set objregexp = new regexp objregexp.ignorecase = true objregexp.global = true objregexp.pattern = "(<[a-za-z].*?>)|(<[\/][a-za-z].*?>)" stroutput = objregexp.replace(strhtml, "") stroutput = replace(stroutput, "<", "<") stroutput = replace(stroutput, ">", ">") delhtml = stroutput set objregexp = nothingend function
[生命其实就是一个过程，可悲的是它不能够重新开始，可喜的是它也不需要重新开始.] |
|
以前Blueidea里看到一个分页的类我也贴出来大家分享以下.再次感谢这为大哥的劳动成果!
'程序参数说明'PapgeSize 定义分页每一页的记录数'GetRS 返回经过分页的Recordset此属性只读'GetConn 得到数据库连接'GetSQL 得到查询语句'程序方法说明'ShowPage 显示分页导航条,唯一的公用方法'===================================================================Const Btn_First="<font face=""webdings"">9</font>" '定义第一页按钮显示样式Const Btn_Prev="<font face=""webdings"">3</font>" '定义前一页按钮显示样式Const Btn_Next="<font face=""webdings"">4</font>" '定义下一页按钮显示样式Const Btn_Last="<font face=""webdings"">:</font>" '定义最后一页按钮显示样式Const XD_Align="Center" '定义分页信息对齐方式Const XD_Width="100%" '定义分页信息框大小Class XdownpagePrivate XD_PageCount,XD_Conn,XD_Rs,XD_SQL,XD_PageSize,Str_errors,int_curpage,str_URL,int_totalPage,int_totalRecord,XD_sURL'================================================================='PageSize 属性'设置每一页的分页大小'=================================================================Public Property Let PageSize(int_PageSize) If IsNumeric(Int_Pagesize) Then XD_PageSize=CLng(int_PageSize) Else str_error=str_error & "PageSize的参数不正确" ShowError() End IfEnd PropertyPublic Property Get PageSize If XD_PageSize="" or (not(IsNumeric(XD_PageSize))) Then PageSize=10 Else PageSize=XD_PageSize End IfEnd Property'================================================================='GetRS 属性'返回分页后的记录集'=================================================================Public Property Get GetRs() Set XD_Rs=Server.createobject("adodb.recordset") XD_Rs.PageSize=PageSize XD_Rs.Open XD_SQL,XD_Conn,1,1 If not(XD_Rs.eof and XD_RS.BOF) Then If int_curpage>XD_RS.PageCount Then int_curpage=XD_RS.PageCount End If XD_Rs.AbsolutePage=int_curpage End If Set GetRs=XD_RSEnd Property'================================================================'GetConn 得到数据库连接'================================================================ Public Property Let GetConn(obj_Conn) Set XD_Conn=obj_ConnEnd Property'================================================================'GetSQL 得到查询语句'================================================================Public Property Let GetSQL(str_sql) XD_SQL=str_sqlEnd Property'=================================================================='Class_Initialize 类的初始化'初始化当前页的值'================================================================== Private Sub Class_Initialize '======================== '设定一些参数的黙认值 '======================== XD_PageSize=10 '设定分页的默认值为10 '======================== '获取当前面的值 '======================== If request("page")="" Then int_curpage=1 ElseIf not(IsNumeric(request("page"))) Then int_curpage=1 ElseIf CInt(Trim(request("page")))<1 Then int_curpage=1 Else Int_curpage=CInt(Trim(request("page"))) End If End Sub'===================================================================='ShowPage 创建分页导航条'有首页、前一页、下一页、末页、还有数字导航'====================================================================Public Sub ShowPage() Dim str_tmp XD_sURL = GetUrl() int_totalRecord=XD_RS.RecordCount If int_totalRecord<=0 Then str_error=str_error & "总记录数为零，请输入数据" Call ShowError() End If If int_totalRecord="" then int_TotalPage=1 Else If int_totalRecord mod PageSize =0 Then int_TotalPage = CLng(int_TotalRecord / XD_PageSize * -1)*-1 Else int_TotalPage = CLng(int_TotalRecord / XD_PageSize * -1)*-1+1 End If End If If Int_curpage>int_Totalpage Then int_curpage=int_TotalPage End If '================================================================== '显示分页信息，各个模块根据自己要求更改显求位置 '================================================================== response.write "" str_tmp=ShowFirstPrv response.write str_tmp str_tmp=showNumBtn response.write str_tmp str_tmp=ShowNextLast response.write str_tmp str_tmp=ShowPageInfo response.write str_tmp response.write ""End Sub'===================================================================='ShowFirstPrv 显示首页、前一页'====================================================================Private Function ShowFirstPrv() Dim Str_tmp,int_prvpage If int_curpage=1 Then str_tmp=Btn_First&" "&Btn_Prev Else int_prvpage=int_curpage-1 str_tmp="<a href="""&XD_sURL & "1" & """>" & Btn_First&"</a> <a href=""" & XD_sURL & CStr(int_prvpage) & """>" & Btn_Prev&"</a>" End If ShowFirstPrv=str_tmpEnd Function'===================================================================='ShowNextLast 下一页、末页'====================================================================Private Function ShowNextLast() Dim str_tmp,int_Nextpage If Int_curpage>=int_totalpage Then str_tmp=Btn_Next & " " & Btn_Last Else Int_NextPage=int_curpage+1 str_tmp="<a href=""" & XD_sURL & CStr(int_nextpage) & """>" & Btn_Next&"</a> <a href="""& XD_sURL & CStr(int_totalpage) & """>" & Btn_Last&"</a>" End If ShowNextLast=str_tmpEnd Function'===================================================================='ShowNumBtn 数字导航'====================================================================Private Function showNumBtn() Dim i,str_tmp For i=1 to int_totalpage str_tmp=str_tmp & "[<a href=""" & XD_sURL & CStr(i) & """>"&i&"</a>] " Next showNumBtn=str_tmpEnd Function'===================================================================='ShowPageInfo 分页信息'更据要求自行修改'====================================================================Private Function ShowPageInfo() Dim str_tmp str_tmp="页次:"&int_curpage&"/"&int_totalpage&"页 共"&int_totalrecord&"条记录 "&XD_PageSize&"条/每页" ShowPageInfo=str_tmpEnd Function'=================================================================='GetURL 得到当前的URL'更据URL参数不同，获取不同的结果'==================================================================Private Function GetURL() Dim strurl,str_url,i,j,search_str,result_url search_str="page=" strurl=Request.ServerVariables("URL") Strurl=split(strurl,"/") i=UBound(strurl,1) str_url=strurl(i)'得到当前页文件名 str_params=Trim(Request.ServerVariables("QUERY_STRING")) If str_params="" Then result_url=str_url & "?page=" Else If InstrRev(str_params,search_str)=0 Then result_url=str_url & "?" & str_params &"&page=" Else j=InstrRev(str_params,search_str)-2 If j=-1 Then result_url=str_url & "?page=" Else str_params=Left(str_params,j) result_url=str_url & "?" & str_params &"&page=" End If End If End If GetURL=result_urlEnd Function'====================================================================' 设置 Terminate 事件。'====================================================================Private Sub Class_Terminate XD_RS.close Set XD_RS=nothingEnd Sub'===================================================================='ShowError 错误提示'====================================================================Private Sub ShowError() If str_Error <> "" Then Response.Write("" & str_Error & "") Response.End End IfEnd SubEnd classset conn = server.CreateObject("adodb.connection")conn.open "driver={microsoft access driver (*.mdb)};dbq=" & server.Mappath("pages.mdb")'#############类调用样例#################'创建对象Set mypage=new xdownpage'得到数据库连接mypage.getconn=conn'sql语句mypage.getsql="select * from [test] order by id asc"'设置每一页的记录条数据为5条mypage.pagesize=5'返回Recordsetset rs=mypage.getrs()'显示分页信息，这个方法可以，在set rs=mypage.getrs()以后,可在任意位置调用，可以调用多次mypage.showpage()'显示数据Response.Write("<br/>")for i=1 to mypage.pagesize'这里就可以自定义显示方式了 if not rs.eof then response.write rs(0) & "<br/>" rs.movenext else exit for end ifnext%>
技术太菜！一直在学习中！http://www.dongda-edu.cn |
|
日历类:<% Class caDataGrid 'private variables private pAutoColumns, pConnStr, pSqlStr, intColCnt Private pOutPut, pConn, pRec, x, y, pArray 'this runs when you create a reference to the caDataGrid class Private Sub Class_Initialize() Set pConn = server.createobject("adodb.connection") Set pRec = server.createobject("adodb.recordset") intColCnt = 0 pAutoColumns = True End Sub 'Properties - all writable Public Property Let ConnectionString(strConn) pConnStr = strConn End Property Public Property Let AutoColumns(bAutoCols) If bAutoCols = True or bAutoCols = False then pAutoColumns = bAutoCols End IF End Property Public Property Let SqlString(strSql) pSqlStr = strSql End Property 'Methods for our class Public Sub AddColumn(strColName) If intColCnt = 0 then pOutPut = "<table width='100%' border=1 cellpadding=0 cellspacing=0>" & vbcrlf pOutPut = pOutPut & "<tr>" & vbcrlf End If pOutPut = pOutPut & "<td><strong>" & strColName & "</strong></td>" & vbcrlf intColCnt = intColCnt + 1 End Sub Public Sub Bind pConn.Open pConnStr Set pRec = pConn.Execute(pSqlStr) If pAutoColumns = True then 'assign column names from returned recordset pOutPut = "<table width='100%' border=1 cellpadding=0 cellspacing=0>" & vbcrlf pOutPut = pOutPut & "<tr>" & vbcrlf Redim pColNames(pRec.Fields.Count) For x = 0 to pRec.Fields.Count - 1 pOutPut = pOutPut & "<td>" & pRec.Fields(x).Name & "</td>" & vbcrlf Next End If pOutPut = pOutPut & "</tr>" & vbcrlf pArray = pRec.GetRows For x = 0 to UBound(pArray, 2) pOutPut = pOutPut & "<tr>" & vbcrlf For y = 0 to UBound(pArray, 1) pOutPut = pOutPut & "<td>" & pArray(y, x) & "</td>" & vbcrlf Next pOutPut = pOutPut & "</tr>" & vbcrlf Next pOutPut = pOutPut & "</table>" & vbcrlf Response.Write pOutPut End Sub 'this runs when we destroy our reference to caDataGrid Private Sub Class_Terminate() pOutPut = "" pRec.Close Set pRec = nothing pconn.close Set pConn = nothing End Sub End Class %>
|
|
|
昨天没敢贴日历类，今天有人先了，起起哄。 要杀先杀头上的那个5do8 function getdata ($month=NULL,$year=NULL,$appointment=array()) {$month = ( $month ==NULL )? date("n"):$month;$year = ( $year ==NULL )? date("Y"):$year;$weekday_cn = array("日","一","二","三","四","五","六");////先判断月份以及是不是2月和闰月////可以用一个数组来代替//设定数组下标为月份数，值为天数，根据月份数返回对应的值（天数）//if ($month !=2) { switch ($month) { case 1: $day = 31; break; case 3: $day = 31; break; case 4: $day = 30; break; case 5: $day = 31; break; case 6: $day = 30; break; case 7: $day = 31; break; case 8: $day = 31; break; case 9: $day = 30; break; case 10: $day = 31; break; case 11: $day = 30; break; case 12: $day = 31; break; } }else{ if (date("L",mktime(0,0,0,$month,0,$year))) { $day = 29; }else{ $day = 28; } } //得到开始的第一天是星期几$start_day = (int)date("w",mktime(0,0,0,$month,date("j",mktime(0,0,0,$month,1,$year)),$year));//日期从1开始计数$n=1;//得到今天是几号$today=(int)date("j");//打印表头echo "<table width=\"200\" border=\"0\" cellspacing=\"1\" cellpadding=\"2\" class=\"calendar_table\"><tr class=\"calendar_tr_header\">";echo "<th colspan=\"7\" scope=\"col\" class=\"calendar_th_header\">".$year."年".$month."月"."</th></tr>\n";echo "<tr align=\"center\" class=\"calendar_tr_week\">";for ($i=0;$i<count($weekday_cn);$i++) { echo "<th scope=\"col\" class=\"calendar_th_week\">".$weekday_cn[$i]."</th>\n"; } echo "</tr>"; //打印第一行echo "<tr align=\"center\" class=\"calendar_tr_day\"> \n";for ($i=0;$i<$start_day;$i++) echo "<td class=\"calendar_td_day\"> </td>\n";for ($j=0;$j<(7-$start_day);$j++) {# $url_n = "<a href=\"".$appointment[$n]."\" class=\"calendar_app_day\">".$n."</a>"; $str_n = ( $appointment[$n] ==NULL )?$n:( "<a href=\"".$appointment[$n]."\" class=\"calendar_app_url\">".$n."</a>" ); $table_td= ($today ==$n)?("<td class=\"calendar_td_today\"><span class=\"calendar_app_today\">".$str_n."</span></td>"):("<td class=\"calendar_td_day\">".$str_n."</td>"); echo $table_td; $n++; }echo "</tr>\n";//已显示多少天$m=($n-1);//根据剩余天数除以7得到的商，用ceil()取整后，确定最后需要显示多少行for($i=0;$i<(ceil($day-$m)/7);$i++){ echo "<tr align=\"center\" class=\"calendar_tr_day\"> ";//每行7天7个单元格 for ($j=0;$j<7;$j++) { if ($n<=$day) { $str_n = ( $appointment[$n] ==NULL )?$n:( "<a href=\"".$appointment[$n]."\" class=\"calendar_app_url\">".$n."</a>" ); //显示是否是当日 $table_td= ($today ==$n)?("<td class=\"calendar_td_today\"><span class=\"calendar_app_today\">".$n."</span></td>"):("<td class=\"calendar_td_day\">".$n."</td>"); echo $table_td; $n++; }else{//余下的空格显示 echo "<td class=\"calendar_td_day\"> </td>\n"; } } echo "</tr>"; } echo "</table>";}
方法有点笨，不过还算能用。也可以从外部定义CSS。 使用方法： /* //使用方法 //getdata(); //或给出月份和年度信息 //getdata(1,2006); // //CSS控制关键词 // //calendar_table 整个表格 //calendar_tr_header 表格头部年月信息行 //calendar_th_header 表格头部年月信息单元格 //calendar_tr_week 星期行 //calendar_th_week 星期单元格 //calendar_tr_day 日期行 //calendar_td_day 日期单元格 //calendar_app_url 日程安排链接 //calendar_td_today 显示当日的单元格 //calendar_app_day 有日程安排的单元格 */
快30的打工仔子 |
|
show an array in at table:Sub ShowArrayInTable(ArrayToShow)Dim I ' Simple Looping VarDim iArraySize ' Var to store array size' If you want to know how big an array is, you can use this' to find out. This even works in VB where they don't have' to be zero-based. The LBound and UBound return the' indecies of the lowest and highest array elements so to' get the size we take the difference and add one since you' can store a value at both end points.iArraySize = (UBound(ArrayToShow) - LBound(ArrayToShow)) + 1Response.Write "<p>The array has " & iArraySize _& " elements. They are:</p>" & vbCrLfResponse.Write "<table border=""1"">" & vbCrLfResponse.Write "<thead>" & vbCrLfResponse.Write "<tr>" & vbCrLfResponse.Write "<th>Index</th>" & vbCrLfResponse.Write "<th>Value</th>" & vbCrLfResponse.Write "</tr>" & vbCrLfResponse.Write "</thead>" & vbCrLfResponse.Write "<tbody>" & vbCrLf' Simple loop over a table outputting a row for each elementFor I = LBound(ArrayToShow) To UBound(ArrayToShow)Response.Write "<tr>" & vbCrLf' Write out the index of the element we're currently onResponse.Write "<td>" & I & "</td>" & vbCrLf' Write out the value of the element we're currently onResponse.Write "<td>" & ArrayToShow(I) & "</td>" & vbCrLfResponse.Write "</tr>" & vbCrLfNext 'IResponse.Write "</tbody>" & vbCrLfResponse.Write "</table>" & vbCrLfEnd Sub |
|
老外这样玩字符:<% @language="VBscript" %><% option explicit %><%'--------------' Hex2Dgt()'------------------------------------------' input: one hex-char 0..9, a..f, A..F' return: a number 0..15' note: no error-checking'------------------------------------------Function Hex2Dgt(ByVal inHexChar)If ( inHexChar <= "9" ) ThenHex2Dgt = Asc(inHexChar) - Asc("0")ElseHex2Dgt = Asc(uCase(inHexChar)) - Asc("A") + 10End IfEnd Function'--------------' Hex2Dec()'------------------------------------------' input: a Hex string' return:' -2 null string' -1 error (non-hex char)' >= 0 the converted value'------------------------------------------Function Hex2Dec(ByVal inHex)Dim oREX : Set oREX = New RegExpDim nVal : nVal = 0Dim i' test if null-string'If ( inHex="") ThenHex2Dec = -2Exit FunctionEnd If' test any non-hex char'oREX.Pattern = "[^0-9A-Fa-f]"If ( oREX.Test(inHex)) ThenHex2Dec = -1Exit FunctionEnd If' now do the conversion'For i=1 to Len(inHex)nVal = nVal * 16 + Hex2Dgt(Mid(inHex,i,1))NextHex2Dec = nValset oREX = NothingEnd Function' test'Dim aryHex(6) Dim ixaryHex(0) = "00000000000000000000000000"aryHex(1) = "7fffffff" ' max for Hex()aryHex(2) = "ffffffffffff" ' 12-faryHex(3) = "deadbeef0123456789bad"aryHex(4) = ""aryHex(6) = "hex"For ix=0 to UBound(aryHex)Response.Write aryHex(ix) & " : " & Hex2Dec(aryHex(ix)) & "<br/>" & vbCRLFNext%>
|
|
浙公网安备 33010602011771号