ASP的一些自定义函数整理第1/2页


            <%  '============================================================================================================================  '函数列表：  '1：    建立数据库的连接 ConnOpen(DataBaseConnectStr,DBType,Conn_object)  '2：    断开数据库的连接 ConnClose(Conn_object)  '3：    防止SQL注入 SafeRequest(paraName,paraType)  '4：    格式化日期 DateFormat(dateStr,dateType)  '5：    显示错误提示 ShowErr(errStr)  '6：    查询字符串中特定数据 SelectStr(contentStr,patternStr,patternNum)  '7：    过滤指定字符 Leach(contentStr,badWords)  '8：    远程文件内容抓取 Seize(urlStr)  '9：    数据流编码处理 BytesToBstr(body,cset)  '10：    编码cookies codeCookie(contentStr)  '11：    解码cookies DecodeCookie(contentStr)  '12：    检验数据提交来源是否合法 ChkPost()  '13：    个性化加密 MyEncrypt(StrPassword)  '14：    禁止浏览器缓存本页 NoBuffer()  '15：    网页格式化输入文本 HTMLEncode(fString)  '16：    从头部截取字符串的指定长度(按字符数算) GotTopic(Str,StrLen)  '17：    检测验证码 CheckRadomPass(RadomPass)  '18：    生成验证码 GetCode()  '19：    获取客户端操作系统版本 GetSystem()  '20：    数据库事务处理 ConnManage(Conn_object)  '21：    快速排序（递归） QuickSort(arr,Low,High)  '22：    将数组的元素以特定字符串连起来 arr_join(arr,character)  '23：    返回字符串以某分割符分割的数目 count_character(str,character)  '24：    截取含有分割符的字符串中指定数目的字符串 inter_str_by_character_num(str,character,start,num)  '25：    利用Stream下载文件 downloadFile(strFile)  '26：    返回信息 send_back(ResultWords)  '27：    获取错误信息 get_err()  '28：    与SafeRequest相反 SafeResponse(content)  '29：    保存远程图片 SaveRemoteFile(LocalFileName,RemoteFileUrl)  '30：    ...  dim language_arr(10)  language_arr(0) = "数据库连接的参数设置错误！"  language_arr(1) = "数据库连接的类型参数设置错误！"  language_arr(2) = "数据库连接失败！"  language_arr(3) = "非法的参数值！"  language_arr(4) = "参数值不是有效的日期格式！"  language_arr(5) = "操作失败！"  language_arr(6) = "栏目有重名！"  language_arr(7) = "栏目名称为空！"  language_arr(8) = "栏目文件夹创建失败！"  language_arr(9) = "您没有此权限！"  '============================================================================================================================  '函数ID：1  '函数作用：建立数据库的连接  '作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  '建立时间：2006-2-15 10：28  '修改时间：  '传人参数：  '    connectStr：数据库连接字符串  '    connectType：数据库类别-数字型，0为Access,1为MS SQL  '返回值：  '============================================================================================================================  sub ConnOpen(DataBaseConnectStr,DBType,Conn_object)      Set Conn_object = Server.Createobject("adodb.connection")      if DataBaseConnectStr = "" then call ShowErr(language_arr(0))      if DBType = 0 then          Conn_object.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DataBaseConnectStr      elseif DBType = 1 then          Conn_object.Open "Provider=SQLOLEDB.1;" & DataBaseConnectStr      else          call ShowErr(language_arr(1))      end if      err.clear  end sub  '============================================================================================================================  '函数ID：2  '函数作用：断开数据库的连接  '作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  '建立时间：2006-2-16 15:10  '修改时间：  '传人参数：  '返回值：  '============================================================================================================================  Sub ConnClose(Conn_object)      Conn_object.close      set Conn_object = nothing  End sub  '============================================================================================================================  '函数ID：3  '函数作用：防止SQL注入  '作者名称：http://news.dvbbs.net/infoview/Article_2906.html  '建立时间：2006-2-16 15:32  '修改时间：  '传人参数：  '    paraName:参数名称-字符型  '    paraType:参数类型-数字型(1表示以上参数是数字，0表示以上参数为字符)　  '返回值：  '    过滤后的字符串  '============================================================================================================================  Function SafeRequest(paraName,paraType)      dim paraValue      paraValue = Request(paraName)      select case paraType          case 0              paraValue = replace(paraValue,"'","[system:34]")              paraValue = replace(paraValue,"=","[system:61]")          case 1              if not IsNumeric(paraValue) then call ShowErr(language_arr(3))          case -1              if not IsNumeric(paraValue) then call ShowErr(language_arr(3))              if paraValue = "" then paraValue = 0          case else              if len(paraValue) > paraType then call ShowErr(language_arr(3))              paraValue = replace(paraValue,"'","[system:34]")              paraValue = replace(paraValue,"=","[system:61]")      end select      SafeRequest = paraValue  End function  '============================================================================================================================  '函数ID：4  '函数作用：格式化日期  '作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  '建立时间：2006-2-16 15:45  '修改时间：  '传人参数：  '    dateStr:日期字符串  '    paraType:日期类型-数字型  '返回值：  '    格式化后的日期  '============================================================================================================================  Function  DateFormat(dateStr,dateType)      Dim dateString      if IsDate(dateStr) = False then          call ShowErr(language_arr(4))      end if      Select Case dateType        Case "1"            dateString = Year(dateStr)&"-"&Month(dateStr)&"-"&Day(dateStr)        Case "2"            dateString = Year(dateStr)&"."&Month(dateStr)&"."&Day(dateStr)        Case "3"            dateString = Year(dateStr)&"/"&Month(dateStr)&"/"&Day(dateStr)        Case "4"            dateString = Month(dateStr)&"/"&Day(dateStr)&"/"&Year(dateStr)        Case "5"            dateString = Day(dateStr)&"/"&Month(dateStr)&"/"&Year(dateStr)        Case "6"            dateString = Month(dateStr)&"-"&Day(dateStr)&"-"&Year(dateStr)        Case "7"            dateString = Month(dateStr)&"."&Day(dateStr)&"."&Year(dateStr)        Case "8"            dateString = Month(dateStr)&"-"&Day(dateStr)        Case "9"            dateString = Month(dateStr)&"/"&Day(dateStr)        Case "10"            dateString = Month(dateStr)&"."&Day(dateStr)        Case "11"            dateString = Month(dateStr)&language_arr(6)&Day(dateStr)&language_arr(7)        Case "12"            dateString = Day(dateStr)&language_arr(7)&Hour(dateStr)&language_arr(8)        case "13"            dateString = Day(dateStr)&language_arr(7)&Hour(dateStr)&language_arr(8)        Case "14"            dateString = Hour(dateStr)&language_arr(8)&Minute(dateStr)&language_arr(9)        Case "15"            dateString = Hour(dateStr)&":"&Minute(dateStr)        Case "16"            dateString = Year(dateStr)&language_arr(5)&Month(dateStr)&language_arr(6)&Day(dateStr)&language_arr(7)        Case Else            dateString = dateStr       End Select       DateFormat = dateString  End Function  '============================================================================================================================  '函数ID：5  '函数作用：显示错误提示  '作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  '建立时间：2006-2-16 16:29  '修改时间：  '传人参数：  '    errStr:错误提示-字符型  '返回值：返回提交页面  '============================================================================================================================  sub ShowErr(errStr)      Response.Write("<script>alert("""&errStr&""");location.href=""javascript:history.back()"";</script>")      Response.End  End sub  '============================================================================================================================  '函数ID：6  '函数作用：查询字符串中特定数据  '作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  '建立时间：2006-2-16 16:40  '修改时间：  '传人参数：  '    contentStr:查询字符串  '    patternStr:匹配式字符串  '    patternNum:查询定位-数字型  '返回值：  '    找不到返回false  '    patternNum为-1返回所有匹配字符串并以[10]隔开  '    否则返回指定位置的字符串  '============================================================================================================================  Function SelectStr(contentStr,patternStr,patternNum)      dim objRegExp,matches,matche      if contentStr = "" then          call ShowErr(language_arr(12))      end if      Set objRegExp=new RegExp   '建立正则表达式      objRegExp.pattern = patternStr    '设置模式      objRegExp.IgnoreCase =False    '设置是否区分字符大小写      objRegExp.Global=true    '设置全局可用性      objRegExp.pattern = patternStr    '匹配式      if objRegExp.test(contentStr) = false then    '全局匹配          SelectStr = false      else          Set matches = objRegExp.Execute(contentStr)    '执行搜索          if patternNum = -1 then              for each matche in matches                  SelectStr = SelectStr &"[10]"& matche.value              next          else              SelectStr = matches.Item(patternNum).value          end if      end if      Set objRegExp=Nothing  End Function  '============================================================================================================================  '函数ID：7  '函数作用：过滤指定字符  '作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  '建立时间：2006-2-16 16:59  '修改时间：  '传人参数：  '    contentStr:源字符串  '    badWords:要过滤的字符串，若数目大于1则用英文状态的"^"隔开  '返回值：  '    返回过滤后的字符串  '============================================================================================================================  Function Leach(contentStr,badWords)      dim badWordsArr,i      badWordsArr = Split(badWords,"^")      for i = 0 to UBound(badWordsArr)          contentStr = replace(contentStr,badWordsArr(i),"")      next      leach = contentStr  end Function  '============================================================================================================================  '函数ID：8  '函数作用：远程文件内容抓取  '作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  '建立时间：2006-2-16 17:24  '修改时间：  '传人参数：  '    urlStr:远程文件地址  '返回值：  '    返回远程文件内容  '============================================================================================================================  function Seize(urlStr)      dim connect      if urlStr = "" then          call ShowErr(language_arr(13))      else          Set connect = CreateObject("Microsoft.XMLHTTP")    '建立XMLHTTP对象          connect.open "GET",urlStr,false    '设置参数，通信方式为get，请求为同步，后面还有两个可选属性：userID，password用于用户验证          connect.send()     '数据发送，Send方法的参数类型可以是字符串、DOM树或任意数据流          Seize = BytesToBStr(connect.responseBody,"GB2312")    '返回信息，编码为中文          set connect = nothing      end if  end function  '============================================================================================================================  '函数ID：9  '函数作用：数据流编码处理  '作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  '建立时间：2006-2-16 17:30  '修改时间：  '传人参数：  '    body:数据内容  '    cset:编码格式      '返回值：  '    编码处理后的信息  '============================================================================================================================  Function BytesToBstr(body,cset)      dim objstream      set objstream = Server.CreateObject("adodb.stream")      objstream.Type = 1    '以二进制模式打开      objstream.Mode =3      objstream.Open      objstream.Write body      objstream.Position = 0      objstream.Type = 2      objstream.Charset = cset      BytesToBstr = objstream.ReadText      objstream.Close      set objstream = nothing  End Function  '============================================================================================================================  '函数ID：10  '函数作用：编码cookies  '作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  '建立时间：2006-2-16 17:36  '修改时间：  '传人参数：  '    contentStr:数据内容  '返回值：  '    编码处理后的信息，字符以"a"隔开  '============================================================================================================================  Function codeCookie(contentStr)      Dim i,returnStr      For i = Len(contentStr) to 1 Step -1          returnStr = returnStr & Ascw(Mid(contentStr,i,1))          If (i <> 1) Then returnStr = returnStr & "a"      Next      CodeCookie = returnStr  End Function  '============================================================================================================================  '函数ID：11  '函数作用：解码cookies  '作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  '建立时间：2006-2-17 16:58  '修改时间：  '传人参数：  '    contentStr:数据内容          '返回值：  '    解码处理后的信息          '============================================================================================================================  Function DecodeCookie(contentStr)      Dim i      Dim StrArr,StrRtn      StrArr = Split(contentStr,"a")      For i = 0 to UBound(StrArr)          If isNumeric(StrArr(i)) = True Then              StrRtn = Chrw(StrArr(i)) & StrRtn          Else              StrRtn = contentStr              Exit Function          End If      Next      DecodeCookie = StrRtn  End Function  '============================================================================================================================  '函数ID：12  '函数作用：检验数据提交来源是否合法  '作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  '建立时间：2006-2-18 18:55  '修改时间：  '传人参数：  '  '返回值：  '    Boolean  '============================================================================================================================  Function ChkPost()      Dim server_v1,server_v2      Chkpost=False      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 Chkpost=True  End Function  '============================================================================================================================  

            12下一页阅读全文