'金钱转换.12;-.12==>0.12;-0.12 Function MoneyChange(str) if instr(str,".")=1 then str="0"&str elseif instr(str,".")=2 then str="-0"&mid(str,2) end if MoneyChange=str End Function
'禁止外部提交 Function safein(Url) 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 response.write "<script>alert('哥们，这样做是不好地，知道不！知道的话就回去吧！噢！乖ai');</script>" Response.Redirect Url End IF End Function
'*********************************************** '函数名：HtmlCodeIn;HtmlCodeOut '作 用： '文本框写入数据库时--------->HtmlCodeIn, '从数据库调出到文本框时----->HtmlCodeOut, '直接在网页上显示则--------->直接调用 '*********************************************** Function HtmlCodeIn(fString) IF trim(fString)<>"" Then fString = Replace(fString, CHR(13), "") fString = Replace(fString, CHR(32), " ") fString = Replace(fString, CHR(10)&CHR(10), "<BR><BR>") fString = Replace(fString, CHR(10), "<BR>") End IF HtmlCodeIn = fString End Function
Function HtmlCodeOut(fString) IF trim(fString)<>"" Then fString = Replace(fString, "",CHR(13)) fString = Replace(fString, " ", CHR(32)) fString = Replace(fString, "<BR><BR>",CHR(10) & CHR(10)) fString = Replace(fString, "<BR>",CHR(10)) End IF HtmlCodeOut = fString End Function
'**************************************************** '过程名：ErrorMsg;SuccessMsg '作 用：显示错误,正确提示信息 '参 数：str;str1,str2字符型 '**************************************************** Sub ErrorMsg(str) response.write "<script language='javascript'>alert('"&str&"');window.history.go(-1);</script>" response.End End Sub Sub SuccessMsg(str1,str2) response.write "<script language='javascript'>alert('"&str1&"');window.location.href='"&str2&"';</script>" response.End End Sub
'判断接收到的值是不是为数值型，不是的话重新赋值为0. Function isnum(str) str1=trim(request(str)) IF str1="" or ISNULL(str1) or len(str1)=0 or not IsNumeric(str1) Then isnum=0 else isnum=str1 End IF End Function
'////////////////////////////////////////////随机数/////////////////////////////////////////////// Function NumRand(n) '生成n位随机数字 For i=1 to n Randomize temp = cint(9*Rnd) temp = temp + 48 NumRand = NumRand & chr(temp) Next End Function
Function LCharRand(n) '生成n位随机小写字母 For i=1 to n Randomize temp = cint(25*Rnd) temp = temp +97 LCharRand = LCharRand & chr(temp) Next End Function
Function UCharRand(n) '生成n位随机大写字母 For i=1 to n Randomize temp = cint(25*Rnd) temp = temp +65 UCharRand = UCharRand & chr(temp) Next End Function
Function allRand(n) '生成n位随机数字字母子组合 For i=1 to n Randomize temp = cint(25*Rnd) If temp mod 2 = 0 then temp = temp + 97 ElseIf temp < 9 then temp = temp + 48 Else temp = temp + 65 End If allRand = allRand & chr(temp) Next End Function
'1234567890转化为A-J的字母 Function ChangeCode(id) For i=1 to len(trim(id)) ChangeCode = ChangeCode + chr(mid(id,i,1)+65) Next
'SQL防入库函数 Function SafeRequest(ParaValue) ParaValue=trim(request(ParaValue)) IF ParaValue = "" Then SafeRequest = "" exit Function End IF '要过滤的字符以","隔开 LockValue="',select,update,delete,insert,count(,drop table,truncate,asc(,mid(,char(,xp_cmdshell,exec master,net localgroup administrators, and ,net user, or " LockValue=Split(LockValue,",") '判断是否有注入 for i=0 to Ubound(LockValue) IF instr(LCase(ParaValue),LockValue(i))>0 Then errmsg=1 exit for End IF next '注入处理 IF errmsg=1 Then errmsg= "<script language='javascript'>alert('可疑的SQL注入请求!');" errmsg=errmsg & "window.history.go(-1);" errmsg=errmsg & "</script>" response.Write errmsg else SafeRequest=ParaValue End IF End Function
'////////////////////////////////////////////////FSO操作///////////////////////////////////// '判断文件是否存在 Function fileexits(filename) set FSO=Server.CreateObject("Scripting.FileSystemObject") IF FSO.FileExists(filename) Then fileexits=true Else fileexits=false End IF End Function
'创建文件夹 Function CreateFolder(strFolder) strTestFolder = Server.Mappath(strFolder) Set objFSO = CreateObject("Scripting.FileSystemObject") objFSO.CreateFolder(strTestFolder) End function
'生成文件 Function FSOJSOK(str,filename,msg) Set FSO= Server.CreateObject("Scripting.FileSystemObject") set fd=FSO.createtextfile(server.MapPath(filename),true) fd.writeline str errormsg msg End Function
Function ShowfileSize(fileorfolder) Dim FSO, f, s Set FSO = CreateObject("Scripting.FileSystemObject") Set f = FSO.GetFile(Server.MapPath(fileorfolder)) s =f.size ShowfileSize = s End Function
' 转换字节数为简写形式 function cSize(tSize) if tSize>=1073741824 then cSize=int((tSize/1073741824)*1000)/1000 & " GB" elseif tSize>=1048576 then cSize=int((tSize/1048576)*1000)/1000 & " MB" elseif tSize>=1024 then cSize=int((tSize/1024)*1000)/1000 & " KB" else cSize=tSize & "B" end if end function
'检查组件是否被支持及组件版本的子程序 sub ObjTest(strObj) on error resume next IsObj=false VerObj="" set TestObj=server.CreateObject (strObj) If -2147221005 <> Err then '感谢网友iAmFisher的宝贵建议 IsObj = True VerObj = TestObj.version if VerObj="" or isnull(VerObj) then VerObj=TestObj.about end if set TestObj=nothing End sub
'*********************************************** '函数名：DelHTML '作 用：去除所有HTML标记,主要用在,调用前N个字符 '*********************************************** Function DelHTML(str) '去掉所有HTML标记 Dim Re,l,t,c,i
Set Re=new RegExp Re.IgnoreCase =True Re.Global=True Re.Pattern="<(.[^>]*)>" str=Re.Replace(str,"") set Re=Nothing
l=Len(str) t=0 For i=1 to l c=Abs(Asc(Mid(str,i,1))) IF c>255 Then t=t+2 Else t=t+1 End IF DelHTML=str Next
DelHTML=Replace(DelHTML,chr(10),"") DelHTML=Replace(DelHTML,chr(13),"") DelHTML=Replace(DelHTML,chr(32),"") DelHTML=Replace(DelHTML," ","") End Function
'ip转换 Function Fn_IP(ip) ip=cstr(ip) ip1=left(ip,cint(instr(ip,".")-1)) ip=mid(ip,cint(instr(ip,".")+1)) ip2=left(ip,cint(instr(ip,".")-1)) ip=mid(ip,cint(instr(ip,".")+1)) ip3=left(ip,cint(instr(ip,".")-1)) ip4=mid(ip,cint(instr(ip,".")+1)) Fn_IP=cint(ip1)*256*256*256+cint(ip2)*256*256+cint(ip3)*256+cint(ip4) End Function Function Fn_IP1(ip) ip=cstr(ip) ip1=left(ip,cint(instr(ip,".")-1)) ip=mid(ip,cint(instr(ip,".")+1)) ip2=left(ip,cint(instr(ip,".")-1)) ip=mid(ip,cint(instr(ip,".")+1)) ip3=left(ip,cint(instr(ip,".")-1)) Fn_IP1=cint(ip1)*256*256*256+cint(ip2)*256*256+cint(ip3)*256+0 End Function
'*********************************************** '函数名：ChangeIP,GetWhere '作 用： 'ChangeIP--->把IP转换成一个IP所对应的唯一的数字 'GetWhere--->得到给定的IP的地址. '*********************************************** Function ChangeIP(ip) ip=cstr(ip) ip1=left(ip,cint(instr(ip,".")-1)) ip=mid(ip,cint(instr(ip,".")+1)) ip2=left(ip,cint(instr(ip,".")-1)) ip=mid(ip,cint(instr(ip,".")+1)) ip3=left(ip,cint(instr(ip,".")-1)) ip4=mid(ip,cint(instr(ip,".")+1)) ChangeIP=cint(ip1)*256*256*256+cint(ip2)*256*256+cint(ip3)*256+cint(ip4) End Function
Function GetWhere(IP) set rsip=Server.CreateObject("ADODB.RecordSet") Sql = "select * from IP_Old UNION select * from IP_ADD where ip1 <= "&IP&" and ip2 >= "&IP&"order by id desc" rsip.open Sql,conn,1,1
IF NOT rsip.Eof Then GetWhere = rsip("country") Else GetWhere = "未知" End IF rsip.close Set rsip=Nothing End Function
'************************************************** '函数名：strLength '作 用：求字符串长度。汉字算两个字符，英文算一个字符。 '参 数：str ----要求长度的字符串 '返回值：字符串长度 '************************************************** Function strlength(str) On Error Resume Next dim winnt_chinese winnt_chinese = (len("中国")=2) 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
'************************************************* '函数名：gotTopic '作 用：截字符串，汉字一个算两个字符，英文算一个字符 '参 数：str ----原字符串 ' strlen ----截取长度 '返回值：截取后的字符串 '************************************************* Function gotTopic(str,strlen) IF str="" Then gotTopic="" exit Function End IF dim l,t,c,i,m m=0 str=Replace(Replace(Replace(Replace(str," "," "),""",chr(34)),">",">"),"<","<") l=len(str) t=0 For i=1 to l c=Abs(Asc(Mid(str,i,1))) IF c>255 Then t=t+2 Else t=t+1 m=m+1 End IF IF t>strlen Then IF m Mod 2=0 Then gotTopic=left(str,i) & "…" IF m Mod 2<>0 Then gotTopic=left(str,i+1) & "…"
Exit For Else gotTopic=str End IF next gotTopic=Replace(Replace(Replace(Replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<") End Function
'*********************************************** '过程名：showpages1 '作 用：显示“上一页 下一页”等信息 '参 数：sfilename ----链接地址 ' totalnumber ----总数量 ' maxperpage ----每页数量 ' ShowTotal ----是否显示总数量 ' ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用，否则会出现JS错误。 ' strUnit ----计数单位 '*********************************************** Sub showpages1(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit,align) dim n, i,strTemp,strUrl IF totalnumber mod maxperpage=0 Then n= totalnumber \ maxperpage Else n= totalnumber \ maxperpage+1 End IF
strTemp= "<table align="&align&" ><Form name='showpages' method='Post' action='" & sfilename & "'><tr><td>" IF ShowTotal=true Then strTemp=strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & " " End IF strUrl=JoinChar(sfilename) IF CurrentPage<2 Then strTemp=strTemp & "首页 上一页 " Else strTemp=strTemp & "<a href='" & strUrl & "page=1'>首页</a> " strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>上一页</a> " End IF
IF n-currentpage<1 Then strTemp=strTemp & "下一页 尾页" Else strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>下一页</a> " strTemp=strTemp & "<a href='" & strUrl & "page=" & n & "'>尾页</a>" End IF strTemp=strTemp & " 页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 " strTemp=strTemp & " <b>" & maxperpage & "</b>" & strUnit & "/页" IF ShowAllPages=True Then strTemp=strTemp & " 转到：<select name='page' size='1' onchange='javascript:Submit()'>" For i = 1 to n strTemp=strTemp & "<option value='" & i & "'" IF cint(CurrentPage)=cint(i) Then strTemp=strTemp & " selected " strTemp=strTemp & ">第" & i & "页</option>" next strTemp=strTemp & "</select>" End IF strTemp=strTemp & "</td></tr></Form></table>" response.write strTemp End Sub
'*********************************************** '函数名：JoinChar '作 用：向地址中加入 ? 或 & '参 数：strUrl ----网址 '返回值：加了 ? 或 & 的网址 'pos=InStr(1,"abcdefg","cd") '则pos会返回3表示查找到并且位置为第三个字符开始。 '这就是“查找”的实现，而“查找下一个”功能的 '实现就是把当前位置作为起始位置继续查找。 '*********************************************** Function JoinChar(strUrl) IF strUrl="" Then JoinChar="" exit Function End IF IF InStr(strUrl,"?")<len(strUrl) Then IF InStr(strUrl,"?")>1 Then IF InStr(strUrl,"&")<len(strUrl) Then JoinChar=strUrl & "&" Else JoinChar=strUrl End IF Else JoinChar=strUrl & "?" End IF Else JoinChar=strUrl End IF End Function
'*********************************************** '函数名：SetPage;PrintPage '作 用：分页函数 '一般直接写上就行:setpage(rs,pagecount,20) PrintPage(PageCount,rs,URL) '*********************************************** Sub SetPage(rs,PageCount,PageSize) IF not rs.eof Then IF not isempty(Request("page")) Then IF IsNumeric(Request("page")) = True Then PageCount=cint(Request("page")) Else PageCount=1 End IF Else PageCount=1 End IF IF session("PageSize")="" or not IsNumeric(session("PageSize")) or pagesize<>session("pagesize") Then session("PageSize") = PageSize End IF rs.pagesize=session("PageSize") IF PageCount>rs.PageCount or PageCount<=0 Then PageCount=1 End IF IF not rs.eof Then rs.AbsolutePage=PageCount End IF End Sub
Sub PrintPage(pagecount, rs, URL) IF rs.pagecount > 0 Then str=pagecount&"/"&rs.pagecount&" " i=1 Do While i<rs.pagecount+1 IF i<> pagecount Then str=str&"<A href="&URL&"&page="&i&">"&i&"</A> " else str=str&"<font color=red>"&i&"</font> " End IF i=i+1 Loop End IF response.Write " "&str End Sub
'*********************************************** '函数名：guolvstr '作 用：过滤掉BBS里的不健康的词句 'Words----->要过滤的字符 'OutStr----->替换成什么字符 '*********************************************** Function guolvstr(Words,OutStr) guolvstr=Words Const InvaildWords="日您|屁眼|国民党" '需要过滤得字符以“|”隔开 InvaildWord=Split(InvaildWords,"|") For each abc in InvaildWord guolvstr=Replace(guolvstr,abc,OutStr) next End Function
