1，登录验证函数 程序代码 <% Function chk_regist(requestname,requestpwd,tablename,namefield,pwdfield,reurl) dim cn_name,cn_pwd cn_name=trim(request.form(""&requestname&"")) cn_pwd=trim(request.form(""&requestpwd&"")) if cn_name="" or cn_pwd="" then response.Write("<script language=javascript>alert(""请将帐号密码填写完整，谢谢合作。"");history.go(-1)</script>") 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 response.Write("<script language=javascript>alert(""没有该会员ID，请确认有没有被申请。"");history.go(-1)</script>") else if rs(""&pwdfield&"")=cn_pwd then session("cn_name")=rs(""&namefield&"") response.Redirect(reurl) else response.Write("<script language=javascript>alert(""提醒，您的帐号和密码是不吻合。注意数字和大小写。"");history.go(-1)</script>") end if end if rs.close Set rs = Nothing End Function %> 参数说明： chk_regist(requestname,requestpwd,tablename,namefield,pwdfield,reurl) requestname 为接受HTML页中输入名称的INPUT控件名 requestpwd 为接受HTML页中输入密码的INPUT控件名 tablename 为数据库中保存注册信息的表名 namefield 为该信息表中存放用户名称的字段名 pwdfield 为该信息表中存放用户密码的字段名 reurl 为登录正确后跳转的页 引用示例如下： 程序代码 <% call chk_regist("b_name","b_pwd","cn_admin","cn_name","cn_pwd","admin.asp") %> 调试地址：http://www.cnbruce.com/test/function/regist.asp 2，经常有可能对某个事物进行当前状态的判断，一般即做一字段（数值类型，默认滴?） 通过对该字段值的修改达到状态切换的效果。那么，我又做了个函数，让自己轻松轻松。 程序代码 <% 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 %> 参数说明： pvouch(tablename,fildname,autoidname,indexid) tablename 该事物所在数据库中的表名 fildname 该事物用以表明状态的字段名（字段类型是数值型） autoidname 在该表中的自动编号名 indexid 用以修改状态的对应自动编号的值 引用示例如下： 程序代码 <% dowhat=request.QueryString("dowhat") p_id=cint(request.QueryString("p_id")) if dowhat="tj" and p_id<>"" then call pvouch("cn_products","p_vouch","p_id",p_id) end if %> <%if rs("p_vouch")=0 then%>
>推荐 <%else%>
>取消推荐 <%end if%> 3.HTML转换函数 动作转换成HTML 程序代码 Function HTMLEncode(reString) ’转换HTML代码(显示数据时使用) Dim Str:Str=reString If Not IsNull(Str) Then Str = Replace(Str, "&", "&") Str = Replace(Str, ">", ">") Str = Replace(Str, "<", "<") Str = Replace(Str, CHR(32), " ") Str = Replace(Str, CHR(9), " ") Str = Replace(Str, CHR(34), """) Str = Replace(Str, CHR(39), "’") Str = Replace(Str, CHR(13), "") Str = Replace(Str, CHR(10), "
") HTMLEncode = Str End If End Function HTML解码函数 程序代码 Function HTMLDecode(reString) ’HTML解码函数(保存或提交数据时使用,可以不使用) Dim Str:Str=reString If Not IsNull(Str) Then Str = Replace(Str, "&", "&") Str = Replace(Str, ">", ">") Str = Replace(Str, "<", "<") Str = Replace(Str, " ", CHR(32)) Str = Replace(Str, " ", CHR(9)) Str = Replace(Str, " ", CHR(9)) Str = Replace(Str, """, CHR(34)) Str = Replace(Str, "’", CHR(39)) Str = Replace(Str, "", CHR(13)) Str = Replace(Str, "
", CHR(10)) HTMLDecode = Str End If End Function 4.日期转换函数 程序代码 Function DateToStr(DateTime,ShowType) ’日期转换函数 Dim DateMonth,DateDay,DateHour,DateMinute DateMonth=Month(DateTime) DateDay=Day(DateTime) DateHour=Hour(DateTime) DateMinute=Minute(DateTime) If Len(DateMonth)<2 Then DateMonth="0"&DateMonth If Len(DateDay)<2 Then DateDay="0"&DateDay If Len(DateMinute)<2 Then DateMinute="0"&DateMinute Select Case ShowType Case "Y-m-d" DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay Case "Y-m-d H:I A" Dim DateAMPM If DateHour>12 Then DateHour=DateHour-12 DateAMPM="PM" Else DateHour=DateHour DateAMPM="AM" End If If Len(DateHour)<2 Then DateHour="0"&DateHour DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM Case "Y-m-d H:I:S" Dim DateSecond DateSecond=Second(DateTime) If Len(DateHour)<2 Then DateHour="0"&DateHour If Len(DateSecond)<2 Then DateSecond="0"&DateSecond DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond Case "YmdHIS" DateSecond=Second(DateTime) If Len(DateHour)<2 Then DateHour="0"&DateHour If Len(DateSecond)<2 Then DateSecond="0"&DateSecond DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond Case "ym" DateToStr=Right(Year(DateTime),2)&DateMonth Case "d" DateToStr=DateDay Case Else If Len(DateHour)<2 Then DateHour="0"&DateHour DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute End Select End Function 5.删除附件函数: 程序代码 sub Delfile(filepath) on error resume next set DelObj=Server.CreateObject("Scripting.FileSystemObject") filepath="../"&filepath Delpath=server.mappath(filepath) ’ response.write delpath&"
" set DelFi=DelObj.getfile(Delpath) DelFi.Delete set Delobj=nothing end sub 6.提交表单时出现的提示框: 程序代码 <script language=javascript> function ConfirmDel() { if(confirm("确定要删除选中的产品吗？一旦删除将不能恢复！")) return true; else return false; } </script>
7.经常有可能对某个事物进行当前状态的判断，一般即做一字段（数值类型，默认值为0） 通过对该字段值的修改达到状态切换的效果。那么，我又做了个函数，让自己轻松轻松。 程序代码 <% 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 %> 参数说明： pvouch(tablename,fildname,autoidname,indexid) tablename 该事物所在数据库中的表名 fildname 该事物用以表明状态的字段名（字段类型是数值型） autoidname 在该表中的自动编号名 indexid 用以修改状态的对应自动编号的值 引用示例如下： 程序代码 <% dowhat=request.QueryString("dowhat") p_id=cint(request.QueryString("p_id")) if dowhat="tj" and p_id<>"" then call pvouch("cn_products","p_vouch","p_id",p_id) end if %> <%if rs("p_vouch")=0 then%>
>推荐 <%else%>
>取消推荐 <%end if%> 调试地址：http://www.cnbruce.com/test/function/showpro.asp 8.为很多中小企业写站点，一般产品展示是个大项目，那么做成的页面也就不同。 要不就是横排来几个，要不就是竖排来几个，甚至全站要翻来覆去的搞个好几次，麻烦也很累。 索性写个函数能缓解一下，于是就成了下面 程序代码 <% function showpros(tablename,topnum,fildname,loopnum,typenum) Set rs = Server.CreateObject ("ADODB.Recordset") sql = "Select top "&topnum&" * from "&tablename rs.Open sql,conn,1,1 if rs.eof and rs.bof then response.Write("暂时无该记录") else response.Write("
") for i=1 to rs.recordcount if (i mod loopnum=1) then response.write"
" end if select case typenum case "1" response.Write("
| ") response.Write(rs(""&fildname&"")) response.Write(" | ") response.Write("方式1之"&i&"记录")’此处的“方式1”可以替换显示为其余字段的值 response.Write(" |
")’如果字段比较多，继续添加新个表格行来显示 response.Write("
|
") case "2" response.Write("
| ") response.Write(rs(""&fildname&"")) response.Write(" |
") response.Write("
|
| ") response.Write("方式2之"&i&"记录") response.Write(" |
") response.Write("
") end select if (i mod loopnum=0) then response.write"
" end if rs.movenext next response.Write("
") end if rs.close Set rs = Nothing end function %> 参数说明：showpros(tablename,topnum,fildname,loopnum,typenum) whichpro为选择何类型的产品种类 topnum表示提取多少条记录 fildname表示调试显示的字段，具体应用的时候可以省去该参数，在函数内部直接使用 loopnum表示显示的循环每行的记录条数 typenum表示循环显示的方法：目前分了两类，横向并列、纵向并列显示同一数据记录行的不同记录 引用示例如下： 程序代码 <% if request.form("submit")<>"" then topnum=request.form("topnum") loopnum=request.form("loopnum") typenum=request.form("typenum") else topnum=8 loopnum=2 typenum=1 end if %> <%call showpros("cn_products",topnum,"p_name",loopnum,typenum)%>
调试地址：http://www.cnbruce.com/test/function/index.asp 可以选择文件下载查看： Download file 9.IP转换成数字，限制IP时用 程序代码 ’//IP转换成数字，限制IP时用 ’@使用示例 ’// userIPnum = IP2Num(Request.ServerVariables("REMOTE_ADDR")) ’// if userIPnum > IP2Num("192.168.0.0") and userIPnum < IP2Num("192.168.0.255") then ’// response.write ("
您的IP被禁止
") ’// response.end’ // end if function IP2Num(sip) dim str1,str2,str3,str4 dim num IP2Num=0 if isnumeric(left(sip,2)) then str1=left(sip,instr(sip,".")-1) sip=mid(sip,instr(sip,".")+1) str2=left(sip,instr(sip,".")-1) sip=mid(sip,instr(sip,".")+1) str3=left(sip,instr(sip,".")-1) str4=mid(sip,instr(sip,".")+1) num=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1 IP2Num = num end if end function 10.ASP安全检测与过滤函数SafeCheck 程序代码 <% ’作用:安全字符串检测函数 ’名字:SafeCheck ’参数:CheckString,CheckType,CheckLength ’说明: ’Checkstring待检测字符串:任意字符. ’CheckType检测类型0正常短字符1数字2日期3金钱4编码HTML5解码HTML6登录字符串7防攻击检测 ’CheckLength检测类型长度:类型为int,当为金钱时为小数点的位置 ’返回值:如果通过检测,返回正确字符串, ’如果未通过则返回错误代码SYSTEM_ERROR|ERROR_CODE ’Script Writen by :SnowDu(杜雪.NET) ’Web:http://www.snsites.com/ ’Web:http://www.knowsky.com/ ’------------------------------------------- function SafeCheck(CheckString,CheckType,CheckLength) On Error Resume Next ErrorRoot="SYSTEM_ERROR|" if checkString="" then SafeCheck=ErrorRoot&"00001" exit function end if CheckString=Replace(CheckString,"’","’") select case CheckType case 0 CheckString=trim(CheckString) SafeCheck=Left(CheckString,CheckLength) case 1 if not isnumberic(CheckString) then SafeCheck=ErrorRoot&"00002" exit function else SafeCheck=Left(CheckString,CheckLength) end if case 2 tempVar=IsDate(CheckString) if Not TempVar then SafeCheck=ErrorRoot&"00003" exit function else select case CheckLength case 0 SafeCheck=FormatDateTime(CheckString,vbShortDate) case 1 SafeCheck=FormatDateTime(CheckString,vbLongDate) case 2 SafeCheck=CheckString end select end if case 3 tempVar=FormatCurrency(CheckString,0) if Err then SafeCheck=ErrorRoot&"00004" exit function else SafeCheck=FormatCurrency(CheckString,CheckLength) end if case 4 sTemp = CheckString If IsNull(sTemp) = True Then SafeCheck=ErrorRoot&"00005" Exit Function End If sTemp = Replace(sTemp, "&", "&") sTemp = Replace(sTemp, "<", "<") sTemp = Replace(sTemp, ">", ">") sTemp = Replace(sTemp, Chr(34), """) sTemp = Replace(sTemp, Chr(10), "
") SafeCheck = Left(sTemp,CheckLength) case 5 sTemp = CheckString If IsNull(sTemp) = True Then SafeCheck=ErrorRoot&"00006" Exit Function End If sTemp = Replace(sTemp, "&", "&") sTemp = Replace(sTemp, "<", "<") sTemp = Replace(sTemp, ">", ">") sTemp = Replace(sTemp, """, Chr(34)) sTemp = Replace(sTemp, "
",Chr(10)) SafeCheck = Left(sTemp,CheckLength) case 6 s_BadStr = "’ &<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32) n = Len(s_BadStr) IsSafeStr = True For i = 1 To n If Instr(CheckString, Mid(s_BadStr, i, 1)) > 0 Then IsSafeStr = False End If Next if IsSafeStr then SafeCheck=left(CheckString,CheckLength) else SafeCheck=ErrorRoot&"00007" Exit Function end if case 7 s_Filter="net user|xp_cmdshell|/add|select|count|asc|char|mid|’|""|" S_Filter=S_Filter&"insert|delete|drop|truncate|from|%|declare|-" S_Filters=split(S_Filter,"|") isFound=false for i=0 to ubound(S_Filters)-1 if Instr(lcase(CheckString),lcase(S_Filters(i)))<>0 then isFound=true exit for end if next if isFound then SafeCheck=ErrorRoot&"00008" Exit Function else SafeCheck=left(CheckString,CheckLength) end if end select end function %> 11.控制输出字符串的长度，可以区别中英文 函数在下面，是方法是： strvalue("复请Email通知如果不填写则取注册Email",26) 这里26是指26个英文字母，也就是13个汉字 程序代码 function strlen(str) dim p_len p_len=0 strlen=0 if trim(str)<>"" then p_len=len(trim(str)) for xx=1 to p_len if asc(mid(str,xx,1))<0 then strlen=int(strlen) + 2 else strlen=int(strlen) + 1 end if next end if end function function strvalue(str,lennum) dim p_num dim i if strlen(str)<=lennum then strvalue=str else p_num=0 x=0 do while not p_num > lennum-2 x=x+1 if asc(mid(str,x,1))<0 then p_num=int(p_num) + 2 else p_num=int(p_num) + 1 end if strvalue=left(trim(str),x)&"…" loop end if end function 12.一个把数字转英文的实用程序 原数字格式：2000 格式化后：TWO THOUSAND ONLY 引用：<%=make("2000")%> 自定义函数： 程序代码 <% function zr4(y)’准备数据 dim z(10) z(1)="ONE" z(2)="TWO" z(3)="THREE" z(4)="FOUR" z(5)="FIVE" z(6)="SIX" z(7)="SEVEN" z(8)="EIGHT" z(9)="NINE" zr4=z(MID(y,1,1)) end function function zr3(y)’准备数据 dim z(10) z(1)="ONE" z(2)="TWO" z(3)="THREE" z(4)="FOUR" z(5)="FIVE" z(6)="SIX" z(7)="SEVEN" z(8)="EIGHT" z(9)="NINE" zr3=z(MID(y,3,1)) end function function zr2(y)’准备数据 dim z(20) z(10)="TEN" z(11)="ELEVEN" z(12)="TWELVE" z(13)="THIRTEEN" z(14)="FOURTEEN" z(15)="FIFTEEN" z(16)="SIXTEEN" z(17)="SEVENTEEN" z(18)="EIGHTEEN" z(19)="NINETEEN" zr2=z(MID(y,2,2)) end function function zr1(y)’准备数据 dim z(10) z(1)="TEN" z(2)="TWENTY" z(3)="THIRTY" z(4)="FORTY" z(5)="FIFTY" z(6)="SIXTY" z(7)="SEVENTY" z(8)="EIGHTY" z(9)="NINETY" zr1=z(MID(y,2,1)) end function function dw(y)’准备数据 dim z(5) z(0)="" z(1)="THOUSAND" z(2)="MILLION" z(3)="BILLION" dw=z(y) end function function w2(y)’用来制作2位数字转英文 if MID(y,2,1)="0" then’判断是否小于十 value=zr3(y) elseif MID(y,2,1)="1" then’判断是否在十到二十之间 value=zr2(y) elseif MID(y,3,1)="0" then’判断是否为大于二十小于一百的能被十整除的数（为了去掉尾空格） value=zr1(y) else value=zr1(y)+" "+zr3(y)’加上十位到个位的空格 end if w2=value end function function w3(y)’用来制作3位数字转英文 if MID(y,1,1)="0" then’判断是否小于一百 value=w2(y) elseif MID(y,2,2)="00" then ’判断是否能被一百整除 value=zr4(y)+" "+"HUNDRED" else value=zr4(y)+" "+"HUNDRED"+" "+"AND"+" "+w2(y)’不能整除的要后面加“AND” end if w3=value end function function make(x) z=instr(1,x,".",1)’取小数点位置 if z<>0 then’判断有没有小数 lstr=mid(x,1,z-1)’取小数点左边的字串 rstr=mid(x,z+1,2)’取小数点右边的字串 else lstr=x’没有小数的情况 end if lstrev=StrReverse(lstr)’对左边的字串取反字串 dim a(5)’定义5个字串变量用来存放解析出的三位一组的字串 select case len(lstrev) mod 3’字串长度不能被整除，需补齐 case "1" lstrev=lstrev+"00" case "2" lstrev=lstrev+"0" end select lm=""’用来存放转换后的整数部分 for i=0 to len(lstrev)/3-1’计算有多少个三位 a(i)=StrReverse(mid(lstrev,3*i+1,3))’截取第1个三位 if a(i)<>"000" then ’用来避免这种情况“1000000=ONE MILLION THOUSAND ONLY” if i<>0 then lm=w3(a(i))+" "+dw(i)+" "+lm’用来加上“THOUSAND OR MILLION OR BILLION” else lm=w3(a(i))’防止i=0时“lm=w3(a(i))+" "+dw(i)+" "+lm”多加两个尾空格 end if else lm=w3(a(i))+lm end if NEXT xs=""’用来存放转换后的小数部分 if z<>0 then xs="AND CENTS"+" "+w2("$"+rstr)+" "’小数部分存在时转换小数部分 end if make=lm+" "+xs+"ONLY"’最后结果，加上ONLY end function %> 13.把长的数字用逗号隔开显示 文字格式：12345678 格式化数字：12,345,678 自定义函数： 程序代码 <% Function Comma(str) If Not(IsNumeric(str)) Or str = 0 Then Result = 0 ElseIf Len(Fix(str)) < 4 Then Result = str Else Pos = Instr(1,str,".") If Pos > 0 Then Dec = Mid(str,Pos) End if Res = StrReverse(Fix(str)) LoopCount = 1 While LoopCount <= Len(Res) TempResult = TempResult + Mid(Res,LoopCount,3) LoopCount = LoopCount + 3 If LoopCount <= Len(Res) Then TempResult = TempResult + "," End If Wend Result = StrReverse(TempResult) + Dec End If Comma = Result End Function %> 引用： 程序代码 <% aLongNumber = "12345678" response.wirte Comma(aLongNumber) %> 14.随机生成文件名的函数 程序代码 <% Function Generator(Length) dim i, tempS, v dim c(39) tempS = "" c(1) = "a": c(2) = "b": c(3) = "c": c(4) = "d": c(5) = "e": c(6) = "f": c(7) = "g" c(8) = "h": c(9) = "i": c(10) = "j": c(11) = "k": c(12) = "l": c(13) = "m": c(14) = "n" c(15) = "o": c(16) = "p": c(17) = "q": c(18) = "r": c(19) = "s": c(20) = "t": c(21) = "u" c(22) = "v": c(23) = "w": c(24) = "x": c(25) = "y": c(26) = "z": c(27) = "1": c(28) = "2" c(29) = "3": c(30) = "4": c(31) = "5": c(32) = "6": c(33) = "7": c(34) = "8": c(35) = "9" c(36) = "-": c(37) = "_": c(38) = "@": c(39) = "!" If isNumeric(Length) = False Then Response.Write "A numeric datatype was not submitted to this function." Exit Function End If For i = 1 to Length Randomize v = Int((39 * Rnd) + 1) tempS = tempS & c(v) Next Generator = tempS End Function For i = 1 to 20 Randomize x = Int((20 * Rnd) + 1) + 10 Response.Write Generator(x) & "
" & vbnewline Next %> 15.每行显示n个字母，自动换行 程序代码 Function rowscode(str,n) If len(str)<=n/2 Then rowscode=str Else Dim TStr Dim l,t,c Dim i l=len(str) TStr="" t=0 for i=1 to l c=asc(mid(str,i,1)) If c<0 then c=c+65536 If c>255 then t=t+2 Else t=t+1 End If TStr=TStr&(mid(str,i,1)) If t>n Then TStr=TStr&"
" t=0 End if next rowscode= TStr End If End Function 16.截取字符串多余用省略号显示（支持中文） 程序代码 Function CutStr(byVal Str,byVal StrLen) Dim l,t,c,i l=Len(str) t=0 For i=1 To l c=AscW(Mid(str,i,1)) If c<0 Or c>255 Then t=t+2 Else t=t+1 IF t>=StrLen Then CutStr=left(Str,i)&"..." Exit For Else CutStr=Str End If Next End Function 17.注册帐号时密码随机生成的ASP代码 ASP生成随机密码的两个函数： 函数一 程序代码 <% function makePassword(byVal maxLen) Dim strNewPass Dim whatsNext, upper, lower, intCounter Randomize For intCounter = 1 To maxLen whatsNext = Int((1 - 0 + 1) * Rnd + 0) If whatsNext = 0 Then ’character upper = 90 lower = 65 Else upper = 57 lower = 48 End If strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + lower)) Next makePassword = strNewPass end function %> makePassword(str) ’str 密码的位数 函数二 程序代码 <% Function gen_key(digits) dim char_array(35) char_array(0) = "0" char_array(1) = "1" char_array(2) = "2" char_array(3) = "3" char_array(4) = "4" char_array(5) = "5" char_array(6) = "6" char_array(7) = "7" char_array(8) = "8" char_array(9) = "9" char_array(10) = "A" char_array(11) = "B" char_array(12) = "C" char_array(13) = "D" char_array(14) = "E" char_array(15) = "F" char_array(16) = "G" char_array(17) = "H" char_array(18) = "I" char_array(19) = "J" char_array(20) = "K" char_array(21) = "L" char_array(22) = "M" char_array(23) = "N" char_array(24) = "O" char_array(25) = "P" char_array(26) = "Q" char_array(27) = "R" char_array(28) = "S" char_array(29) = "T" char_array(30) = "U" char_array(31) = "V" char_array(32) = "W" char_array(33) = "X" char_array(34) = "Y" char_array(35) = "Z" randomize do while len(output) < digits num = char_array(Int(35 * Rnd + 0)) output = output + num loop gen_key = output End Function %> gen_key(str) ’str为密码位数 这个函数还可以扩展。。如果你还要加上“大小写敏感区分大小写”特性的话，修改数组大小为char_array(50)，然后在后面列出所有可能的小写字符。例如： char_array(36) = "a" char_array(37) = "b" ...............类推 18.获得ASP的中文日期字符串 我们通常需要在WEB页面上写上当前的日期，可能使用客户端script ，或者使用ASP。使用ASP的一个特点是，它产生的效果看起来是静态的页面，但实际上它是动态生成的。如果你希望用ASP显示一个中文的日期，则需要转化一下。下面是用来转化的函数及其调用实例。 <<<< 函数实现 >>>> 程序代码 <% ’====================================================== ’ 函数 Date2Chinese ’ 功能：获得中文日期的字符串（如一九九八年五月十二日） ’ 参数: iDate 要转化的日期 ’ 返回: 中文日期的字符串 ’====================================================== Function Date2Chinese(iDate) Dim num(10) Dim iYear Dim iMonth Dim iDay num(0) = "〇" num(1) = "一" num(2) = "二" num(3) = "三" num(4) = "四" num(5) = "五" num(6) = "六" num(7) = "七" num(8) = "八" num(9) = "九" iYear = Year(iDate) iMonth = Month(iDate) iDay = Day(iDate) Date2Chinese = num(iYear / 1000) + _ num((iYear / 100) Mod 10) + num((iYear _ / 10) Mod 10) + num(iYear Mod _ 10) + "年" If iMonth >= 10 Then If iMonth = 10 Then Date2Chinese = Date2Chinese + _ "十" + "月" Else Date2Chinese = Date2Chinese + _ "十" + num(iMonth Mod 10) + "月" End If Else Date2Chinese = Date2Chinese + _ num(iMonth Mod 10) + "月" End If If iDay >= 10 Then If iDay = 10 Then Date2Chinese = Date2Chinese + _ "十" + "日" ElseIf iDay = 20 Or iDay = 30 Then Date2Chinese = Date2Chinese + _ num(iDay / 10) + "十" + "日" ElseIf iDay > 20 Then Date2Chinese = Date2Chinese + _ num(iDay / 10) + "十" + _ num(iDay Mod 10) + "日" Else Date2Chinese = Date2Chinese + _ "十" + num(iDay Mod 10) + "日" End If Else Date2Chinese = Date2Chinese + _ num(iDay Mod 10) + "日" End If End Function %> 程序代码 <<<< 调 用 举 例 >>>> <% response.write date2Chinese(date()) %> 19.判断输入域名是否正确的函数： 程序代码 dim c,words,word,i,wnum function IsValiddomin(word) IsValiddomin = true words = Split(word, ".") wnum=UBound(words) if words(0)="www" then IsValiddomin = IsValidword(words(1)) IsValiddomin = IsValidword2(words(2)) if words(wnum)="cn" then if wnum<>3 then IsValiddomin = false exit function end if else if wnum<>2 then IsValiddomin = false exit function end if end if else IsValiddomin = IsValidword(words(0)) IsValiddomin = IsValidword2(words(1)) if words(wnum)="cn" then if wnum<>2 then IsValiddomin = false exit function end if else if wnum<>1 then IsValiddomin = false exit function end if end if end if end function function IsValidword2(word) IsValidword2 = true IsValidword2 = IsValidword(word) if word<>"net" and word<>"com" and word<>"cc" and word<>"org" and word<>"info" and word<>"gov" then ’ 自己添加 IsValidword2 = false exit function end if end function function IsValidword(word) IsValidword = true if Len(word) <= 0 then IsValidword = false exit function end if for i = 1 to Len(word) c = Lcase(Mid(word, i, 1)) if InStr("abcdefghijklmnopqrstuvwxyz-", c) <= 0 and not IsNumeric(c) then IsValidword = false exit function end if next end function if IsValiddomin("wrclub.net.cn") then response.write "right" else response.write "wrong" end if 20.判断是否含有中文字符函数，函数主要用于设置密码，如ftp密码设置： 程序代码 function nothaveChinese(para) dim str nothaveChinese=true str=cstr(para) for i = 1 to Len(para) c=asc(mid(str,i,1)) if c<0 then nothaveChinese=false exit function end if next end function 21.限制字符是否中文代码： 程序代码 function isChinese(para) on error resume next dim str dim i if isNUll(para) then isChinese=false exit function end if str=cstr(para) if trim(str)="" then isChinese=false exit function end if for i=1 to len(str) c=asc(mid(str,i,1)) if c>=0 then isChinese=false exit function end if next isChinese=true if err.number<>0 then err.clear end function 22.判断Email是否正确函数： 程序代码 function IsValidEmail(email) dim names, name, i, c ’Check for valid syntax in an email address. IsValidEmail = true names = Split(email, "@") if UBound(names) <> 1 then IsValidEmail = false exit function end if for each name in names if Len(name) <= 0 then IsValidEmail = false exit function end if for i = 1 to Len(name) c = Lcase(Mid(name, i, 1)) if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then IsValidEmail = false exit function end if next if Left(name, 1) = "." or Right(name, 1) = "." then IsValidEmail = false exit function end if next if InStr(names(1), ".") <= 0 then IsValidEmail = false exit function end if i = Len(names(1)) - InStrRev(names(1), ".") if i <> 2 and i <> 3 then IsValidEmail = false exit function end if if InStr(email, "..") > 0 then IsValidEmail = false end if end function 23.判断电话号码是否正确函数： 程序代码 function IsValidTel(para) on error resume next dim str dim l,i if isNUll(para) then IsValidTel=false exit function end if str=cstr(para) if len(trim(str))<7 then IsValidTel=false exit function end if l=len(str) for i=1 to l if not (mid(str,i,1)>="0" and mid(str,i,1)<="9" or mid(str,i,1)="-") then IsValidTel=false exit function end if next IsValidTel=true if err.number<>0 then err.clear end function 24.判断文件名是否合法 程序代码 <% ’判断文件名是否合法 Function isFilename(aFilename) Dim sErrorStr,iNameLength,i isFilename=TRUE sErrorStr=Array("/","/",":","*","?","""","<",">","|") iNameLength=Len(aFilename) If iNameLength<1 Or iNameLength=null Then isFilename=FALSE Else For i=0 To 8 If instr(aFilename,sErrorStr(i)) Then isFilename=FALSE End If Next End If End Function 25.去掉字符串头尾的连续的回车和空格 程序代码 function trimVBcrlf(str) trimVBcrlf=rtrimVBcrlf(ltrimVBcrlf(str)) end function ’去掉字符串开头的连续的回车和空格 function ltrimVBcrlf(str) dim pos,isBlankChar pos=1 isBlankChar=true while isBlankChar if mid(str,pos,1)=" " then pos=pos+1 elseif mid(str,pos,2)=VBcrlf then pos=pos+2 else isBlankChar=false end if wend ltrimVBcrlf=right(str,len(str)-pos+1) end function ’去掉字符串末尾的连续的回车和空格 function rtrimVBcrlf(str) dim pos,isBlankChar pos=len(str) isBlankChar=true while isBlankChar and pos>=2 if mid(str,pos,1)=" " then pos=pos-1 elseif mid(str,pos-1,2)=VBcrlf then pos=pos-2 else isBlankChar=false end if wend rtrimVBcrlf=rtrim(left(str,pos)) end function 26.测试用:显示服务器信息 程序代码 Sub showServer Dim name Response.write "
" for each name in request.servervariables Response.write "
" Response.write "
" Response.write "
"&request.servervariables(name)&"
|
" Response.write "
" next Response.write "
" End Sub 27.测试用:显示Rs结果集以及字段名称 程序代码 Sub showRs(rs) Dim strTable,whatever Response.write "
" for each whatever in rs.fields response.write "
" next strTable = "
| "&rs.GetString(,," | "," |
| "," ") &" |
" Response.Write(strTable) End Sub 28.测试用:显示调试错误信息 程序代码 Sub showError Dim sErrMsg sErrMsg=Err.Source&" "&Err.Description Response.write "
"&sErrMsg&"
" Err.clear End Sub 29.显示文字计数器 程序代码 Sub showCounter Dim fs,outfile,filename,count filename=server.mappath("count.txt") Set fs = CreateObject("Scripting.FileSystemObject") If fs.fileExists(filename) Then Set outfile=fs.openTextFile(filename,1) count=outfile.readline count=count+1 Response.write "
浏览人次："&count&"
" outfile.close Set outfile=fs.CreateTextFile(filename) outfile.writeline(count) Else Set outfile=fs.openTextFile(filename,8,TRUE) count=0 outfile.writeline(count) END IF outfile.close set fs=nothing End Sub
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
