<script type="text/javascript"> writeTools('16', '2005-10-26 <FONT COLOR=#800080>11:25:15</font>', 'cbl780', 'cbl780', true, 'http://80.waasai.com/', '', '', true, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2300367', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 2 ); </script>发了这篇贴子,俺也是超级用户了,借此勉励,希望大家喜欢,有能用上的顶一下,有建议的也帮忙给点意见,谢谢了! '清理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 if end sub '当前位置输出某个变量值 sub Chkstr(str) if is_debug then Response.Write str&"<br />" end sub '替换response.write ,偷懒的做法 sub Outputx(str) Response.Write str end 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 " οnclick=""return false;"" " end sub '在当前位置显示一个图片,给出帮助信息,点击后弹出提示框 sub help(str) str = "-- 帮助 -- /n/n帮助信息:"&str response.Write "<a href=""#"" οnclick=""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 if end 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 if end 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_name end 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 If end function '关闭和释放记录集对象 sub RsClose(rst) if isobject(rst) then rst.close set rst = nothing end if end sub '关闭和释放connetion对象 sub DbClose(conn) if isobject(conn) then conn.close set conn = nothing end if end sub '这也是种关闭和释放对象的方法,在页末使用 sub EndPage(rs,conn) set rs = nothing set conn = nothing end 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 If End Function function 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 if end function '一组根据输入值是否为空而返回同值的函数 '检查是否为空,如是则返回"未填写" function chk_not_input(str) if str="" or isnull(str) then chk_not_input="未填写" else chk_not_input=str end if end function '检查是否为空,返回str类型 function chk_null_str(str) if str="" or isnull(str) then chk_null_str="未填" else chk_null_str=str end if end function '检查是否为空,返回0 function chk_null_0(str) if isnull(str) or str="" or str="-" then chk_null_0="0" else chk_null_0=str end if end function '检查是否为空,为空则用X替换 function chk_null_x(str,x) if str="" or isnull(str) then chk_null_x=x else chk_null_x=str end if end function '检查是否为空,为空则用横线替换 function chk_null_line(str) if str="" or isnull(str) then chk_null_line="-" else chk_null_line=str end if end function %> | <script type="text/javascript"> writeTools('1', '2005-10-26 <FONT COLOR=#800080>15:24:59</font>', 'cnbruce', 'cnbruce', true, 'http://www.cnbruce.com/blog', '266837980', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2300845', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>乘机一帖,希望能有用 '''''''''''''''''''''''''''''''''''''''''''弹出信息对话框并做相应处理''''''''''''''''''''''''''''''''''''''''''''''''' 一直使用着,调用很明了,有两种: 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 if End 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 = GetClientIP End 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=contact end if end 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 if End Function '''''''''''''''''''''''''''''''''''''''''''布尔切换值函数''''''''''''''''''''''''''''''''''''''''''''''''' 主要用在一些双向选择的字段类型上,比如产品的 推荐和不推荐 等 具体如何应用就不详说了,各位慢慢看 function pvouch(tablename,fildname,autoidname,indexid) dim fildvalue Set rs = Server.CreateObject ("ADODB.Recordset") sql = "Select * from "&tablename&" where "&autoidname&"="&indexid rs.Open sql,conn,2,3 fildvalue=rs(""&fildname&"") if fildvalue=0 then fildvalue=1 else fildvalue=0 end if rs(""&fildname&"")=fildvalue rs.update rs.close Set rs = Nothing end function 缔吧-DW暨WEB技术站 Blueidea Web Team Moderator Of Blueidea Developer forum |
<script type="text/javascript"> writeTools('1', '2005-10-26 <FONT COLOR=#800080>15:24:59</font>', 'cnbruce', 'cnbruce', true, 'http://www.cnbruce.com/blog', '266837980', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2300845', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>乘机一帖,希望能有用 '''''''''''''''''''''''''''''''''''''''''''弹出信息对话框并做相应处理''''''''''''''''''''''''''''''''''''''''''''''''' 一直使用着,调用很明了,有两种: 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 if End 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 = GetClientIP End 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=contact end if end 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 if End Function '''''''''''''''''''''''''''''''''''''''''''布尔切换值函数''''''''''''''''''''''''''''''''''''''''''''''''' 主要用在一些双向选择的字段类型上,比如产品的 推荐和不推荐 等 具体如何应用就不详说了,各位慢慢看 function pvouch(tablename,fildname,autoidname,indexid) dim fildvalue Set rs = Server.CreateObject ("ADODB.Recordset") sql = "Select * from "&tablename&" where "&autoidname&"="&indexid rs.Open sql,conn,2,3 fildvalue=rs(""&fildname&"") if fildvalue=0 then fildvalue=1 else fildvalue=0 end if rs(""&fildname&"")=fildvalue rs.update rs.close Set rs = Nothing end function 缔吧-DW暨WEB技术站 Blueidea Web Team Moderator Of Blueidea Developer forum | |
<script type="text/javascript"> writeTools('1', '2005-10-27 <FONT COLOR=#800080>00:15:58</font>', 'ffxf', 'ffxf', true, 'http://www.transbaker.net/workingbird', '', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2301550', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>我也来贴两个。 在数据库连接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 If End Function 凤翱翔于千仞兮,非梧不栖。 士伏处于一方兮,非主不依。 乐躬耕于陇亩兮,吾爱吾庐。 聊寄傲于琴书兮,以待天时。 [img]http://img.bbs4.tom.com/upload_img/375/200503/pic_1111395563.jpg[/img] | |
<script type="text/javascript"> writeTools('1', '2005-10-27 <FONT COLOR=#800080>11:24:43</font>', 'wctbok', 'wctbok', true, 'http://www.num2.com/', '', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2302034', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>那我接两个检测正则的~~ 站点链接检测 function checklink(str) dim rs,truelink if (str="http://") then str="" end if if 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 if end if end function 电子邮件地址检测 function checkmail(str) dim rs,truemail if 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 if end if end function 仁慈的主啊,请您宽恕我这个有罪之人吧,我又开始潜水拉~~ num2 | To be NO.1 | |
<script type="text/javascript"> writeTools('17', '2005-10-27 <FONT COLOR=#800080>11:29:50</font>', '5do8', '5do8', true, 'http://www.5do8.com', '', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2302048', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>我也来来:***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, lmod If valx <> "" Then valxarr = Split(Trim(valx)," ") For ix2 = 0 to Ubound(valxarr) For ix = 1 to Len(valxarr(ix2)) curletter = Left(valxarr(ix2),1) '// Turkish Character Map If 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) Next If ix2 < Ubound(valxarr) Then P13_Lettergraph = P13_Lettergraph & "<img src=""13mg/lt/dot.gif"" alt=""dot"" />" Next End If End Function 使用: response.write(P13_Lettergraph("123456789")) response.write("123456789") [这消息被5do8编辑过(最后编辑时间2005-10-27 11:36:31)] | |
<script type="text/javascript"> writeTools('1', '2005-10-27 <FONT COLOR=#800080>12:24:57</font>', '5do8', '5do8', true, 'http://www.5do8.com', '', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2302154', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>图片路径你要自己裁缝的 这个的意思就是说把字符串的"每个字符"导出图片形式,在ubb图片的时候可用. -------------------返回字符串出现的次数-------------------- Function search(pSearch, pSearchStr) Dim tempSearch, tempSearchStr, startpos, endpos startpos = 1 Dim ctr ctr = 0 Do While (startpos > 0) endpos = InStr(startpos, LCase(pSearch), LCase(pSearchStr)) If endpos > 0 Then ctr = ctr + 1 startpos = endpos + Len(pSearchStr) Else Exit Do End If Loop search = ctr End Function | |
<script type="text/javascript"> writeTools('1', '2005-10-27 <FONT COLOR=#800080>12:26:12</font>', '5do8', '5do8', true, 'http://www.5do8.com', '', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2302158', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>------------------------url处理函数------------------------------<% 'Add a name/value pair to a URL Function QueryStringAdd(ByVal URL, ByVal Name, ByVal Value) 'Start with the existing URL QueryStringAdd = URL 'Determine whether or not there's a querystring If (InStr(URL, "?") > 0) Then 'Yes, so append the name/value pair using an ampersand QueryStringAdd = QueryStringAdd & "&" Else 'No, so start one off with a question mark QueryStringAdd = QueryStringAdd & "?" End If 'And add the URLEncoded name/value pair QueryStringAdd = 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 URL Function QueryStringRemove(ByVal URL, ByVal Name, ByVal AllInstances) Dim PositionQueryString, PageLocation, QueryString, Substring, PositionCurrent, PositionEnd, PositionAmpersand PositionQueryString = 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 querystring PageLocation = Left(URL, PositionQueryString - 1) QueryString = Mid(URL, PositionQueryString) 'Build the substring we will be searching for Substring = Server.URLEncode(Name) & "=" 'Find the last (rightmost) instance of the 'specified variable in the querystring PositionCurrent = InStrRev(QueryString, Substring) - Len(SubString) If (AllInstances) Then 'Only stop one we've reached the start of the querystring PositionEnd = 0 Else 'Stop once we've removed the last instance PositionEnd = PositionCurrent End If 'Loop until we've reached our set end position While ((PositionCurrent > 0) And (PositionCurrent >= PositionEnd)) 'The substring is present in the URL PositionCurrent = 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 it PositionAmpersand = 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 onwards QueryString = Left(QueryString, PositionCurrent - 1) & Mid(QueryString, PositionAmpersand + 1) PositionCurrent = PositionAmpersand End If End If Wend If QueryString = "?" Then QueryString = "" End If 'Return the processed URL QueryStringRemove = PageLocation & QueryString Else QueryStringRemove = URL End If End Function 'TEST CODE '--------- URL = "http://www.testserver.com/tests cript.asp" 'Test adding a variable and removing it URL = 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 order URL = 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 call URL = 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方式递交信息时好使的很! | |
<script type="text/javascript"> writeTools('1', '2005-10-27 <FONT COLOR=#800080>13:00:47</font>', 'yaba', 'yaba', true, '', '', '2220908', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2302204', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>我这个算函数吗?? 是用来替换关键字的。 '******************************************************************* '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 = Nothing end function [生命其实就是一个过程,可悲的是它不能够重新开始,可喜的是它也不需要重新开始.] | |
<script type="text/javascript"> writeTools('1', '2005-11-08 <FONT COLOR=#800080>14:39:44</font>', 'webdj', 'webdj', true, 'http://www.gzdesigner.com', '', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2318920', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>我也来贴自己的和收集的 '禁止采集页面 Sub LockPage() Dim http_reffer,server_name http_reffer=Request.ServerVariables("HTTP_REFERER") server_name=Request.ServerVariables("SERVER_NAME") if CheckAgent()=False Then if http_reffer="" or left(http_reffer,len("http://"&server_name)+1)<>"http://"&server_name&"/" Then Response.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.end end If End If End Sub '检查当前访问者是否是蜘蛛人 Function CheckAgent() Dim user_agent,allow_agent user_agent=Request.ServerVariables("HTTP_USER_AGENT") allow_agent=split("Baiduspider,Scooter,ia_archiver,Googlebot,FAST-WebCrawler,MSNBOT,Slurp",",") CheckAgent=False for agenti=lbound(allow_agent) to ubound(allow_agent) if instr(user_agent,allow_agent(agenti))>0 Then CheckAgent=True exit For End If Next end Function '身份证校验 Function CheckidCard(idcard) Dim LenCard LenCard=Len(idcard) '判断身份证长度 if not (LenCard = 15 Or LenCard = 18) Then CheckidCard= "身份证长度不是15位或18位" exit Function End If '变量声明区 dim WeightedFactor,VerifyCode,area,birthday,lastnum,Ai,i,Total,Modnum,sex,age,province,sexNum,provinceID WeightedFactor = 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) then CheckidCard= "生日非法" exit function end If if 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 & ",生日为:" & birthday End 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.Clear Server.ScriptTimeOut=999999999 End Sub '把中文變成unicode function chinese2unicode(Salon) dim i dim Salon_one dim Salon_unicode if 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) Next chinese2unicode=Salon_unicode End Function 提供万网、中频、商中、新网、互联、ENOM、DIRECTI全线产品。国外PHP5G空间 500RMB/年(无限MYSQL,无限域名) 国外ASP5G空间 1500RMB/年 QQ:116610 www.gzcom.net | |
<script type="text/javascript"> writeTools('1', '2005-11-08 <FONT COLOR=#800080>16:20:00</font>', 'aspgood', 'aspgood', true, 'http://www.zhuanghe.org', '', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2319155', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>我给个简单的 '把表中有限的几个分类转换成"汉字" <% 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 | |
<script type="text/javascript"> writeTools('1', '2005-11-08 <FONT COLOR=#800080>16:58:37</font>', '5do8', '5do8', true, 'http://www.5do8.com', '', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2319267', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script> 格式日期: 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, endpos startpos = 1 Dim ctr ctr = 0 Do While (startpos > 0) endpos = InStr(startpos, LCase(pSearch), LCase(pSearchStr)) If endpos > 0 Then ctr = ctr + 1 startpos = endpos + Len(pSearchStr) Else Exit Do End If Loop search = ctr End Function 不要吝啬,大方点,我已经帖子这么几个吐血的了,怎么有人只copy不共享?寒.闪了~ | |
<script type="text/javascript"> writeTools('1', '2005-11-08 <FONT COLOR=#800080>17:10:45</font>', 'yaba', 'yaba', true, '', '', '2220908', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2319297', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>蓝色里的一个大哥给我的,很好用,大家试试吧'// 去调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 = nothing end function [生命其实就是一个过程,可悲的是它不能够重新开始,可喜的是它也不需要重新开始.] | |
<script type="text/javascript"> writeTools('1', '2005-11-08 <FONT COLOR=#800080>22:43:56</font>', 'wlx115', 'wlx115', true, '', '', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2319772', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>以前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 Xdownpage Private 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 If End Property Public Property Get PageSize If XD_PageSize="" or (not(IsNumeric(XD_PageSize))) Then PageSize=10 Else PageSize=XD_PageSize End If End 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_RS End Property '================================================================ 'GetConn 得到数据库连接 '================================================================ Public Property Let GetConn(obj_Conn) Set XD_Conn=obj_Conn End Property '================================================================ 'GetSQL 得到查询语句 '================================================================ Public Property Let GetSQL(str_sql) XD_SQL=str_sql End 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_tmp End 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_tmp End 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_tmp End Function '==================================================================== 'ShowPageInfo 分页信息 '更据要求自行修改 '==================================================================== Private Function ShowPageInfo() Dim str_tmp str_tmp="页次:"&int_curpage&"/"&int_totalpage&"页 共"&int_totalrecord&"条记录 "&XD_PageSize&"条/每页" ShowPageInfo=str_tmp End 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_url End Function '==================================================================== ' 设置 Terminate 事件。 '==================================================================== Private Sub Class_Terminate XD_RS.close Set XD_RS=nothing End Sub '==================================================================== 'ShowError 错误提示 '==================================================================== Private Sub ShowError() If str_Error <> "" Then Response.Write("" & str_Error & "") Response.End End If End Sub End class set 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 '返回Recordset set 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 if next %> 技术太菜!一直在学习中!http://www.dongda-edu.cn | |
<script type="text/javascript"> writeTools('1', '2005-11-09 <FONT COLOR=#800080>09:43:52</font>', '5do8', '5do8', true, 'http://www.5do8.com', '', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2320076', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>日历类:<% 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 %> | |
<script type="text/javascript"> writeTools('1', '2005-11-09 <FONT COLOR=#800080>12:59:26</font>', 'Surran', 'Surran', true, '', '', '370337109', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2320544', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>昨天没敢贴日历类,今天有人先了,起起哄。 要杀先杀头上的那个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的打工仔子 | |
<script type="text/javascript"> writeTools('2', '2005-11-09 <FONT COLOR=#800080>13:26:44</font>', '5do8', '5do8', true, 'http://www.5do8.com', '', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2320616', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>show an array in at table:Sub ShowArrayInTable(ArrayToShow) Dim I ' Simple Looping Var Dim 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)) + 1 Response.Write "<p>The array has " & iArraySize _ & " elements. They are:</p>" & vbCrLf Response.Write "<table border=""1"">" & vbCrLf Response.Write "<thead>" & vbCrLf Response.Write "<tr>" & vbCrLf Response.Write "<th>Index</th>" & vbCrLf Response.Write "<th>Value</th>" & vbCrLf Response.Write "</tr>" & vbCrLf Response.Write "</thead>" & vbCrLf Response.Write "<tbody>" & vbCrLf ' Simple loop over a table outputting a row for each element For I = LBound(ArrayToShow) To UBound(ArrayToShow) Response.Write "<tr>" & vbCrLf ' Write out the index of the element we're currently on Response.Write "<td>" & I & "</td>" & vbCrLf ' Write out the value of the element we're currently on Response.Write "<td>" & ArrayToShow(I) & "</td>" & vbCrLf Response.Write "</tr>" & vbCrLf Next 'I Response.Write "</tbody>" & vbCrLf Response.Write "</table>" & vbCrLf End Sub | |
<script type="text/javascript"> writeTools('1', '2005-11-09 <FONT COLOR=#800080>13:30:23</font>', '5do8', '5do8', true, 'http://www.5do8.com', '', '', false, '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', '2320619', '2300367', '', 'Dreamweaver+MX+Developer+%D3%EB%CA%FD%BE%DD%BF%E2%B1%E0%B3%CC', '%B7%D6%CF%ED%CE%D2%B5%C4%B3%A3%D3%C3%BA%AF%CA%FD%BF%E2', false, false, 1, 0 ); </script>老外这样玩字符:<% @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" ) Then Hex2Dgt = Asc(inHexChar) - Asc("0") Else Hex2Dgt = Asc(uCase(inHexChar)) - Asc("A") + 10 End If End 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 RegExp Dim nVal : nVal = 0 Dim i ' test if null-string ' If ( inHex="") Then Hex2Dec = -2 Exit Function End If ' test any non-hex char ' oREX.Pattern = "[^0-9A-Fa-f]" If ( oREX.Test(inHex)) Then Hex2Dec = -1 Exit Function End If ' now do the conversion ' For i=1 to Len(inHex) nVal = nVal * 16 + Hex2Dgt(Mid(inHex,i,1)) Next Hex2Dec = nVal set oREX = Nothing End Function ' test ' Dim aryHex(6) Dim ix aryHex(0) = "00000000000000000000000000" aryHex(1) = "7fffffff" ' max for Hex() aryHex(2) = "ffffffffffff" ' 12-f aryHex(3) = "deadbeef0123456789bad" aryHex(4) = "" aryHex(6) = "hex" For ix=0 to UBound(aryHex) Response.Write aryHex(ix) & " : " & Hex2Dec(aryHex(ix)) & "<br/>" & vbCRLF Next %> | |
[转]分享我的常用函数库
最新推荐文章于 2021-06-02 21:43:42 发布