asp常用内部函数收藏

******************************************************************* '取得IP地址 '******************************************************************* 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 '******************************************************************* ' 弹出对话框 '******************************************************************* Sub alert(message) message = replace(message,"'","\'") Response.Write ("<script>alert('" & message & "')</script>") End Sub '******************************************************************* ' 返回上一页，一般用在判断信息提交是否完全之后 '******************************************************************* Sub GoBack() Response.write ("<script>history.go(-1)</script>") End Sub '******************************************************************* ' 重定向另外的连接 '******************************************************************* Sub Go(url) Response.write ("<script>location.href('" & url & "')</script>") End Sub '******************************************************************* ' 指定秒数重定向另外的连接 '******************************************************************* sub GoPage(url,s) s=s*1000 Response.Write "<SCRIPT LANGUAGE=javascript>" Response.Write "window.setTimeout("&chr(34)&"window.navigate('"&url&"')"&chr(34)&","&s&")" Response.Write "</script>" end sub '******************************************************************* ' 判断数字是否整形 '******************************************************************* function isInteger(para) on error resume next dim str dim l,i if isNUll(para) then isInteger=false exit function end if str=cstr(para) if trim(str)="" then isInteger=false exit function end if l=len(str) for i=1 to l if mid(str,i,1)>"9" or mid(str,i,1)<"0" then isInteger=false exit function end if next isInteger=true if err.number<>0 then err.clear end function '******************************************************************* ' 获得文件扩展名 '******************************************************************* function GetExtend(filename) dim tmp if filename<>"" then tmp=mid(filename,instrrev(filename,".")+1,len(filename)-instrrev(filename,".")) tmp=LCase(tmp) if instr(1,tmp,"asp")>0 or instr(1,tmp,"php")>0 or instr(1,tmp,"php3")>0 or instr(1,tmp,"aspx")>0 then getextend="txt" else getextend=tmp end if else getextend="" end if end function ' *---------------------------------------------------------------------------- ' * 函数：CheckIn ' * 描述：检测参数是否有SQL危险字符 ' * 参数：str要检测的数据 ' * 返回：FALSE：安全 TRUE：不安全 ' * 作者： ' * 日期： ' *---------------------------------------------------------------------------- function CheckIn(str) if instr(1,str,chr(39))>0 or instr(1,str,chr(34))>0 or instr(1,str,chr(59))>0 then CheckIn=true else CheckIn=false end if end function ' *---------------------------------------------------------------------------- ' * 函数：HTMLEncode ' * 描述：过滤HTML代码 ' * 参数：-- ' * 返回：-- ' * 作者： ' * 日期： ' *---------------------------------------------------------------------------- function HTMLEncode(fString) if not isnull(fString) then fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") fString = Replace(fString, CHR(32), " ") fString = Replace(fString, CHR(9), " ") fString = Replace(fString, CHR(34), """) fString = Replace(fString, CHR(39), "'") fString = Replace(fString, CHR(13), "") fString = Replace(fString, CHR(10) & CHR(10), " ") fString = Replace(fString, CHR(10), " ") HTMLEncode = fString end if end function ' *---------------------------------------------------------------------------- ' * 函数：HTMLcode ' * 描述：过滤表单字符 ' * 参数：-- ' * 返回：-- ' * 作者： ' * 日期： ' *---------------------------------------------------------------------------- function HTMLcode(fString) if not isnull(fString) then fString = Replace(fString, CHR(13), "") fString = Replace(fString, CHR(10) & CHR(10), "") fString = Replace(fString, CHR(34), "") fString = Replace(fString, CHR(10), " ") HTMLcode = fString end if end function 显示左边的n个字符函数（自动识别汉字） rem 显示左边的n个字符(自动识别汉字) Function LeftTrue(str,n) If len(str)<=n/2 Then LeftTrue=str Else 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 End Function 如何过滤html标记 尝试了很多正则表达式，最后找到了一个效果最好的，基本上能把所有的html标记过滤掉，拿出来和大家分享。 Public Function RemoveHtml(ByVal strHTML) As String Dim Pattern = "<(\/\s*)?!?((\w+:)?\w+)(\w+(\s*=?\s*(([""'])(\\[""'tbnr]|[^\7])*?\7|\w+)|.{0})|\s)*?(\/\s*)?>" strHTML = System.Text.RegularExpressions.Regex.Replace(strHTML, Pattern, String.Empty, System.Text.RegularExpressions.RegexOptions.IgnoreCase) strHTML = strHTML.Replace(" ","") Return strHTML End Function 在线用表单建立文件夹 使用ASP的FSO（filesystemobject）组件，通过表单，用户可以在线建立文件夹。制作方法： HTML格式的Form表单文件FOLDER.htm的内容: <form name="form1" method="post" action="folder-action.asp"> Create a folder <input type="text" name="name"> <input type="submit" name="Submit" value="Submit"> </form> ASP文件FOLDER-ACTION.ASP <%@ LANGUAGE = "VBScript" %> <% Dim Name Name = Request("Name") set fs=createobject("scripting.filesystemobject") MyFolder=server.mappath(""&name&"") If NOT fs.folderexists(MyFolder) then fs.createfolder(MyFolder) End If If fs.folderexists(MyFolder) then %> Folder created successfully! Called <%=MyFolder%> <% Else Response.Write "There has been an error." End If %>