文章来源: 视点设计 8see.net http://blog.8see.net/ rem ---表单提示函数 Being----------------------------- CODE Copy ... Function Check_submit(str,restr) if str="" then response.write "<script>" response.write "alert('"&restr&"');" response.write "history.go(-1)" response.write "</script>" response.end else Check_submit=str end if End Function CODE Copy ... Function Alert_submit(str) response.write "<script>" response.write "alert('"&str&"');" 'response.write "location.reload();" response.write "</script>" End Function
CODE Copy ... Function localhost_submit(str,urls) response.write "<script>" if str<>"" then response.write "alert('"&str&"');" end if response.write "location='"&urls&"';" response.write "</script>" End Function
rem ---生成自定义位随机数 Being----------------------------- CODE Copy ... Function makerndid(byVal maxLen) Dim strNewPass Dim whatsNext, upper, lower, intCounter RANdomize For intCounter = 1 To maxLen whatsNext = int(2 * Rnd) If whatsNext = 0 Then upper = 80 lower = 70 Else upper = 48 lower = 39 End If strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + upper)) Next makerndid = strNewPass End Function rem ---生成四位随机数 Being----------------------------- CODE Copy ... Function get_rand() dim num1 dim rndnum Randomize Do While Len(rndnum)<4 num1=CStr(Chr((57-48)*rnd+48)) rndnum=rndnum&num1 loop get_rand=rndnum End Function rem ---判断数据是否整型 Being----------------------------- CODE Copy ... 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 rem ---数据库链接函数 Being----------------------------- CODE Copy ... Function OpenCONN Set conn = Server.CreateObject("ADODB.Connection") connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(DB_login) conn.Open connstr End Function rem ---中文字符转Uncode代码函数 Being----------------------------- CODE Copy ... Function URLEncoding(vstrIn) strReturn = "" For i = 1 To Len(vstrIn) ThisChr = Mid(vStrIn,i,1) If Abs(Asc(ThisChr)) < &HFF Then strReturn = strReturn & ThisChr Else innerCode = Asc(ThisChr) If innerCode < 0 Then innerCode = innerCode + &H10000 End If Hight8 = (innerCode And &HFF00)\ &HFF Low8 = innerCode And &HFF strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8) End If Next URLEncoding = strReturn End Function rem ---Html过滤函数 Being-----------------------------Function Htmlout(str) CODE Copy ... dim result dim l if isNULL(str) then Htmlout="" exit function end if l=len(str) result="" dim i for i = 1 to l select case mid(str,i,1) case "<" result=result+"<" case ">" result=result+">" case chr(13) if session("admin_system")="" then result=result+"<br>" end if case chr(34) result=result+""" case "&" result=result+"&" case chr(32) 'result=result+" " if i+1<=l and i-1>0 then if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9) then result=result+" " else result=result+" " end if else result=result+" " end if case chr(9) result=result+" " case else result=result+mid(str,i,1) end select next Htmlout=result End Function rem ---textarea显示用--- CODE Copy ... function htmlencode1(fString) if fString<>"" and not isnull(fString) then fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") fString = Replace(fString, " ", chr(32)) fString = Replace(fString, "</p><p>", CHR(10) & CHR(10)) fString = Replace(fString, "<br>", CHR(10)) htmlencode1=fString else htmlencode1="" end if end function rem ---页面显示用--- CODE Copy ... function htmlencode2(fString) if fString<>"" and not isnull(fString) then fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") fString = Replace(fString, chr(32), " ") fString = Replace(fString, CHR(10) & CHR(10), "</p><p>") fString = Replace(fString, CHR(10), "<br>") htmlencode2=fString else htmlencode2="" end if end function rem ---取出指定字符串前后的字符串方法--- CODE Copy ... function GetStrs(str1,CharFlag,Dflag) dim tmpstr if Dflag=0 then'取左 pos1=instr(str1,charFlag) if pos1<=20 then tmpstr=left(str1,pos1-1) else tmpstr=mid(str1,pos1-20,20) end if else '取右 pos1=instr(str1,charFlag)+len(charFlag) if len(str1)-pos1<=20 then tmpstr=right(str1,len(str1)-pos1) else tmpstr=mid(str1,pos1+1,20) end if end if GetStrs=tmpstr end function
rem ---取出文件名--- CODE Copy ... function getfilename(str) pos=instr(str,".") if str<>"" then str=mid(str,pos,len(str)) end if getfilename=str end function
rem ---取到浏览器版本转换字符串--- CODE Copy ... function browser() dim text text = Request.ServerVariables("HTTP_USER_AGENT") if Instr(text,"MSIE 5.5")>0 then browser="IE 5.5" elseif Instr(text,"MSIE 6.0")>0 then browser="IE 6.0" elseif Instr(text,"MSIE 5.01")>0 then browser="IE 5.01" elseif Instr(text,"MSIE 5.0")>0 then browser="IE 5.00" elseif Instr(text,"MSIE 4.0")>0 then browser="IE 4.01" else browser="未知" end if end function rem ---取到系统脚本转换字符串--- CODE Copy ... function system(text) if Instr(text,"NT 5.1")>0 then system=system+"Windows XP" elseif Instr(text,"NT 5")>0 then system=system+"Windows 2000" elseif Instr(text,"NT 4")>0 then system=system+"Windows NT4" elseif Instr(text,"4.9")>0 then system=system+"Windows ME" elseif Instr(text,"98")>0 then system=system+"Windows 98" elseif Instr(text,"95")>0 then system=system+"Windows 95" else system=system+"未知" end if end function
rem ---=删除文件--- CODE Copy ... function delfile(filepath) imangepath=trim(filepath) path=server.MapPath(imangepath) SET fs=server.CreateObject("Scripting.FileSystemObject") if FS.FileExists(path) then FS.DeleteFile(path) end if set fs=nothing end function
rem ---得到真实的客户端IP--- CODE Copy ... Public Function GetClientIP() dim uIpAddr ' 本函数参考webcn.Net/AspHouse 文献<取真实的客户IP> uIpAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR") If uIpAddr = "" Then uIpAddr = Request.ServerVariables("REMOTE_ADDR") GetClientIP = uIpAddr uIpAddr = "" End function
数据库查询中的特殊字符的问题 在进行数据库的查询时,会经常遇到这样的情况: 例如想在一个用户数据库中查询他的用户名和他的密码,但恰好该用户使用的名字和密码中有特殊的字符,例如单引号,“|”号,双引号或者连字符“&”。 例如他的名字是1"test,密码是A|&900 这时当你执行以下的查询语句时,肯定会报错: SQL = "SELECT * FROM SecurityLevel WHERE UID="" & UserID & """ SQL = SQL & " AND PWD="" & Password & """ 因为你的SQL将会是这样: SELECT * FROM SecurityLevel WHERE UID="1"test" AND PWD="A|&900" 在SQL中,"|"为分割字段用的,显然会出错了。现在提供下面的几个函数 专门用来处理这些头疼的东西: Quoted from Unkown:
Function ReplaceStr (TextIn, ByVal SearchStr As String, _ ByVal Replacement As String, _ ByVal CompMode As Integer) Dim WorkText As String, Pointer As Integer If IsNull(TextIn) Then ReplaceStr = Null Else WorkText = TextIn Pointer = InStr(1, WorkText, SearchStr, CompMode) Do While Pointer > 0 WorkText = Left(WorkText, Pointer - 1) & Replacement & _ Mid(WorkText, Pointer + Len(SearchStr)) Pointer = InStr(Pointer + Len(Replacement), WorkText, SearchStr, CompMode) Loop ReplaceStr = WorkText End If End Function
Function SQLFixup(TextIn) SQLFixup = ReplaceStr(TextIn, """, """", 0) End Function Function JetSQLFixup(TextIn) Dim Temp Temp = ReplaceStr(TextIn, """, """", 0) JetSQLFixup = ReplaceStr(Temp, "|", "" & chr(124) & "", 0) End Function
Function FindFirstFixup(TextIn) Dim Temp Temp = ReplaceStr(TextIn, """, "" & chr(39) & "", 0) FindFirstFixup = ReplaceStr(Temp, "|", "" & chr(124) & "", 0) End Function rem 借助RecordSet将二进制流转化成文本 Quoted from Unkown: Function BinaryToString(biData,Size) Const adLongVarChar = 201 Set RS = CreateObject("ADODB.Recordset") RS.Fields.Append "mBinary", adLongVarChar, Size RS.Open RS.AddNew RS("mBinary").AppendChunk(biData) RS.Update BinaryToString = RS("mBinary").Value RS.Close End Function
[ Edited by S.Sams at 2005-02-01 12:37:08 AM ]
http://blog.8see.net/feedcomm.asp?logID=13 
|