'汉字判断 function isChinese(para) on error resume next if isNUll(para) then isChinese=false exit function end if if trim(para)="" then isChinese=false exit function end if dim c for i=1 to len(para) c=asc(mid(para,i,1)) if c>=0 then isChinese=false exit function end if next isChinese=true if err.number<>0 then err.clear end function %>
如： if not isChinese(request("name")) then errmsg=errmsg+" "+"
用户名应为汉字" founderr=true else username=trim(request("name")) end if
---------------------------------------------- '替换指定文件内字符串的函数 <% function FSOlineedit(filename,Target,String) Dim objFSO,objCountFile,FiletempData Set objFSO = Server.CreateObject("Scripting.FileSystemObject") Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True) FiletempData = objCountFile.ReadAll objCountFile.Close FiletempData=Replace(FiletempData,Target,String) Set objCountFile=objFSO.CreateTextFile(Server.MapPath(filename),True) objCountFile.Write FiletempData objCountFile.Close Set objCountFile=Nothing Set objFSO = Nothing End Function response.write FSOlineedit("test.txt","世界","明天是一个好天去") %>
response.write "" if request.form("content")="" then response.write "
" else function getpychar(char) tmp=65536+asc(char) if(tmp>=45217 and tmp<=45252) then getpychar= "A" elseif(tmp>=45253 and tmp<=45760) then getpychar= "B" elseif(tmp>=45761 and tmp<=46317) then getpychar= "C" elseif(tmp>=46318 and tmp<=46825) then getpychar= "D" elseif(tmp>=46826 and tmp<=47009) then getpychar= "E" elseif(tmp>=47010 and tmp<=47296) then getpychar= "F" elseif(tmp>=47297 and tmp<=47613) then getpychar= "G" elseif(tmp>=47614 and tmp<=48118) then getpychar= "H" elseif(tmp>=48119 and tmp<=49061) then getpychar= "J" elseif(tmp>=49062 and tmp<=49323) then getpychar= "K" elseif(tmp>=49324 and tmp<=49895) then getpychar= "L" elseif(tmp>=49896 and tmp<=50370) then getpychar= "M" elseif(tmp>=50371 and tmp<=50613) then getpychar= "N" elseif(tmp>=50614 and tmp<=50621) then getpychar= "O" elseif(tmp>=50622 and tmp<=50905) then getpychar= "P" elseif(tmp>=50906 and tmp<=51386) then getpychar= "Q" elseif(tmp>=51387 and tmp<=51445) then getpychar= "R" elseif(tmp>=51446 and tmp<=52217) then getpychar= "S" elseif(tmp>=52218 and tmp<=52697) then getpychar= "T" elseif(tmp>=52698 and tmp<=52979) then getpychar= "W" elseif(tmp>=52980 and tmp<=53640) then getpychar= "X" elseif(tmp>=53689 and tmp<=54480) then getpychar= "Y" elseif(tmp>=54481 and tmp<=62289) then getpychar= "Z" else '如果不是中文，则不处理 getpychar=char end if end function function getpy(str) for i=1 to len(str) getpy=getpy&getpychar(mid(str,i,1)) next end function content=request.form("content") response.write "
for i=0 to ubound(cSingle_Ip) if Instr(cSingle_Ip(i),"REFUSE") <> 0 then '就是拒绝了 cTemp_IP = left(cSingle_Ip(i),instr(cSingle_Ip(i),":")-1)
if Instr(cTemp_IP,"*") <> 0 then '是宽范围 cStart_IP = left(cTemp_IP,instr(cTemp_IP,"*")-1) if left(cInput_Ip,len(cStart_IP))=cStart_IP then CheckIp = false exit function end if end if
if Instr(cTemp_IP,"-") = 0 then cStart_IP = cTemp_IP cEnd_Ip = cTemp_IP else cStart_IP = left(cTemp_IP,instr(cTemp_IP,"-")-1) cEnd_Ip = left(cStart_IP,InStrRev(cStart_IP,".")-1)+"."+mid(cTemp_IP,instr(cTemp_IP,"-")+1) end if
if Ip2Str(cInput_Ip)>=Ip2Str(cStart_IP) and Ip2Str(cInput_Ip)<=Ip2Str(cEnd_Ip) then CheckIp = false exit function end if
if Instr(cTemp_IP,"*") <> 0 then '是宽范围 cStart_IP = left(cTemp_IP,instr(cTemp_IP,"*")-1) if left(cInput_Ip,len(cStart_IP))=cStart_IP then CheckIp = true end if end if
if Instr(cTemp_IP,"-") = 0 then cStart_IP = cTemp_IP cEnd_Ip = cTemp_IP else cStart_IP = left(cTemp_IP,instr(cTemp_IP,"-")-1) cEnd_Ip = left(cStart_IP,InStrRev(cStart_IP,".")-1)+"."+mid(cTemp_IP,instr(cTemp_IP,"-")+1) end if
if Ip2Str(cInput_Ip)>=Ip2Str(cStart_IP) and Ip2Str(cInput_Ip)<=Ip2Str(cEnd_Ip) then CheckIp =true else CheckIp =false end if end if next
end function
'****************************** 'Function Ip2Str(cIp) 'Created by qqdao, qqdao@263.net 2001/11/28 '参考动网ip算法 '参数：cIp ip地址 '返回值: 转换后数值 '****************************** function Ip2Str(cIp) Dim str1,str2,str3,str4 Dim cIp_Temp if cIp="127.0.0.1" then cIp="192.168.0.1" str1=left(cIp,instr(cIp,".")-1) cIp_Temp=mid(cIp,instr(cIp,".")+1) str2=left(cIp_Temp,instr(cIp_Temp,".")-1) cIp_Temp=mid(cIp_Temp,instr(cIp_Temp,".")+1) str3=left(cIp_Temp,instr(cIp_Temp,".")-1) str4=mid(cIp_Temp,instr(cIp_Temp,".")+1)
if isNumeric(str1)=0 or isNumeric(str2)=0 or isNumeric(str3)=0 or isNumeric(str4)=0 then
else Ip2Str=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1 end if
end function
'代码调用演示 if CheckIp("192.168.1.1","192.168.1.*:REFUSE") then response.write "登陆成功" else response.write "您的ip不被允许" end if
function g(num) if num>0 and num<160 then g=chr(num) else if num<-20319 or num>-10247 then g="" else a=d.Items b=d.keys for i=d.count-1 to 0 step -1 if a(i)<=num then exit for next g=b(i) end if end if end function function c(str) c="" for i=1 to len(str) c=c&g(asc(mid(str,i,1))) next end function response.write c(request("hz")) %>
<% if FirstCHR <> "" and LastCHR <> "" then Call MakeChineseWord() end if %>
If len(str)<=n/2 Then LeftTrue=str Else Dim TStr Dim l,t,c Dim i l=len(str) t=l 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 If t>n Then exit for TStr=TStr&(mid(str,i,1)) next LeftTrue = TStr End If
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
<% Function StripNonNumeric(strInput) Dim iPos, sNew, iTemp strInput = Trim(strInput) If strInput <> "" Then iPos = 1 iTemp = Len(strInput) While iTemp >= iPos If IsNumeric(Mid(strInput,iPos,1)) = True Then sNew = sNew & Mid(strInput,iPos,1) End If iPos = iPos + 1 Wend Else sNew = "" End If StripNonNumeric = sNew End Function %>
----------------------------------- 动态输入框的三个函数
<% Function cTextBox(name, value, size) Response.Write""&vbcrlf Response.Write cTextBox("NAME", "1", "12") &vbcrlf End Function Function cCheckBox(name, value, checked) Response.Write"If checked = 1 Then Response.Write" CHECKED" Response.Write">" End Function Function cRadio(name, value, checked) Response.Write"If checked = 1 Then Response.Write" CHECKED" Response.Write">" End Function %>
<% 'just declaring a couple of static variables here, 'but you can create cbname and cbvalue any way you like. 'use a recordset, or Request collection too: cbname = "checkbox_name" cbvalue = "act"
Response.Write "My Checkbox: "&cCheckBox(cbname, cbvalue, 1)&" "
'or, write a radio button like this: Response.Write cRadio(cbname, cbvalue, 1)
function strLength(str) ON ERROR RESUME NEXT if WINNT_CHINESE then dim l,t,c dim i l=len(str) t=l for i=1 to l c=asc(mid(str,i,1)) if c<0 then c=c+65536 if c>255 then t=t+1 end if next strLength=t else strLength=len(str) end if if err.number<>0 then err.clear end function
---------------------------------------- 检查sql字符串中是否有单引号，有则进行转化 <% function CheckStr(str) dim tstr,l,i,ch l=len(str) for i=1 to l ch=mid(str,i,1) if ch="'" then tstr=tstr+"'" end if tstr=tstr+ch next CheckStr=tstr end function %>
function chkEmail(email) on error resume next dim i,l,pos1,pos2 chkEmail=true if isnull(email) then chkEmail=false:exit function pos1= instr(email,"@") pos2=instrRev(email,".") if not(pos1>0) or not (pos2>0) or pos1>pos2 then chkEmail=false end if if err.number<>0 then err.clear end function
<% '****人民币大小写转换格式**** dim str(9) str(0)="零" str(1)="壹" str(2)="贰" str(3)="叁" str(4)="肆" str(5)="伍" str(6)="陆" str(7)="柒" str(8)="捌" str(9)="玖" aa=Request.form("source") hh=formatnumber(aa,2,-1) aa=replace(hh,".","") aa=replace(aa,",","") for i=1 to len(aa) s=mid(aa,i,1) mynum=str(s) select case(len(aa)+1-i) case 1: k= mynum&"分" case 2: k= mynum&"角" case 3: k= mynum&"元" case 4: k= mynum&"拾" case 5: k= mynum&"佰" case 6: k= mynum&"仟" case 7: k= mynum&"万" case 8: k= mynum&"拾" case 9: k= mynum&"佰" case 10: k= mynum&"仟" end select m=m&k next %>
