ASP的一些自定义函数整理

<%  
'============================================================================================================================  
'函数列表：  
'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  
'============================================================================================================================  
'函数ID：13  
'函数作用：个性化加密  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-2-25 15:12  
'修改时间：  
'传人参数：  
'    StrPassword：需加密的数据  
'返回值：  
'    加密后的数据  
'============================================================================================================================  
Function  MyEncrypt(StrPassword)  
    Dim StrLen,StrLeft,StrRight,n  
    n = 8  
    StrPassword = MD5(StrPassword)  
    StrLen = len(StrPassword)  
    StrLeft = left(StrPassword,n)  
    StrRight = right(StrPassword,StrLen-n)  
    MyEncrypt = StrRight&StrLeft  
End function  
'============================================================================================================================  
'函数ID：14  
'函数作用：禁止浏览器缓存本页  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-3-5 2:45  
'修改时间：  
'传人参数：  
'返回值：  
'============================================================================================================================  
Sub NoBuffer()  
    Response.expires = 0  
    Response.expiresabsolute = Now() - 1  
    Response.addHeader "pragma","no-cache"  
    Response.addHeader "cache-control","private"  
    Response.CacheControl = "no-cache"  
end sub  
'============================================================================================================================  
'函数ID：15  
'函数作用：网页格式化输入文本  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-3-5 2:50  
'修改时间：  
'传人参数：  
'     fString：源字符串  
'返回值：格式化后的字符串  
'============================================================================================================================  
function HTMLEncode(fString)  
    if not isnull(fString) then  
        fString = replace(fString, ">", ">")  
        fString = replace(fString, "<", "<")  
        fString = Replace(fString, CHR(32)&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), "</P><P>")  
        fString = Replace(fString, CHR(10), "<BR>")  
        HTMLEncode = fString  
    end if  
end function  
'============================================================================================================================  
'函数ID：16  
'函数作用：从头部截取字符串的指定长度(按字符数算)  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-3-5 3:04  
'修改时间：  
'传人参数：  
'     Str：源字符串  
'    StrLen：长度  
'返回值：截取得到的字符串  
'============================================================================================================================  
Function GotTopic(Str,StrLen)  
    Dim l,t,c, i,LableStr,regEx,Match,Matches,focus,last_str  
    if IsNull(Str) then  
        GotTopic = ""  
        Exit Function  
    end if  
    if Str = "" then  
        GotTopic=""  
        Exit Function  
    end if  
    Set regEx = New RegExp  
    regEx.Pattern = "\[[^\[\]]*\]"  
    regEx.IgnoreCase = True  
    regEx.Global = True  
    Set Matches = regEx.Execute(Str)  
    For Each Match in Matches  
        LableStr = LableStr & Match.Value  
    Next  
    Str = regEx.Replace(Str,"")  
    Str=Replace(Replace(Replace(Replace(Str," "," "),""",Chr(34)),">",">"),"<","<")  
    l=len(str)  
    t=0  
    strlen=Clng(strLen)  
    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  
        if t = strLen-2 then  
            focus = i  
            last_str = ".."  
        end if  
        if t = strLen-1 then  
            focus = i  
            last_str = "."  
        end if  
        if t>=strlen then  
            GotTopic=left(str,focus)&last_str  
            exit for  
        else  
            GotTopic=str  
        end if  
    next  
    GotTopic = Replace(Replace(Replace(Replace(GotTopic," "," "),Chr(34),"""),">",">"),"<","<") & LableStr  
end function  
'============================================================================================================================  
'函数ID：17  
'函数作用：检测验证码  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-3-5 3:09  
'修改时间：  
'传人参数：  
'     RadomPass：输入的验证码  
'返回值：  
'============================================================================================================================  
Sub CheckRadomPass(RadomPass)  
    if radompass = "" then  
        call ShowErr(language_arr(14))  
    elseif Session("GetCode") = "9999" then  
        Session("GetCode")=""  
    elseif Session("GetCode") = "" then  
        call ShowErr(language_arr(15))  
    elseif cstr(Session("GetCode"))<>radompass then  
        call ShowErr(language_arr(16))  
    end if  
    Session("GetCode")=""  
End sub  
'============================================================================================================================  
'函数ID：18  
'函数作用：生成验证码  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-3-5 3:16  
'修改时间：  
'传人参数：  
'返回值：  
'============================================================================================================================  
Function GetCode()  
    Dim TestObj  
    On Error Resume Next  
    Set TestObj = Server.CreateObject("Adodb.Stream")  
    Set TestObj = Nothing  
    If Err Then  
        Dim TempNum  
        Randomize timer  
        TempNum = cint(8999*Rnd+1000)  
        Session("GetCode") = TempNum  
        GetCode = Session("GetCode")  
    Else  
        GetCode = "<img src="""&Site_Url&"inc/GetCode.asp"">"  
    End If  
End Function  
'============================================================================================================================  
'函数ID：19  
'函数作用：获取客户端操作系统版本  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-3-5 3:21  
'修改时间：  
'传人参数：  
'返回值：操作系统版本名称  
'============================================================================================================================  
Function GetSystem()  
    dim System  
    System = Request.ServerVariables("HTTP_USER_AGENT")  
    if Instr(System,"Windows NT 5.2") then  
        System = "Win2003"  
    elseif Instr(System,"Windows NT 5.0") then  
        System="Win2000"  
    elseif Instr(System,"Windows NT 5.1") then  
        System = "WinXP"  
    elseif Instr(System,"Windows NT") then  
        System = "WinNT"  
    elseif Instr(System,"Windows 9") then  
        System = "Win9x"  
    elseif Instr(System,"unix") or instr(System,"linux") or instr(System,"SunOS") or instr(System,"BSD") then  
        System = "Unix"  
    elseif Instr(System,"Mac") then  
        System = "Mac"  
    else  
        System = "Other"  
    end if  
    GetSystem = System  
End Function  
'============================================================================================================================  
'函数ID：20  
'函数作用：数据库事务处理  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-3-5 3:25  
'修改时间：  
'传人参数：  
'返回值：true or false  
'============================================================================================================================  
function ConnManage(Conn_object)  
    if Conn_object.Errors.count<>0 then  
        Conn_object.rollbacktrans  
        err.clear  
        ConnManage = false  
    else  
        Conn_object.committrans  
        ConnManage = true  
    end if  
end function  
'============================================================================================================================  
'函数ID：21  
'函数作用：快速排序（递归）  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-4-9 19:53  
'修改时间：  
'传人参数：  
'    arr:需排序的数组  
'    Low:数组最小下标  
'    High:数组最大下标  
'返回值：  
'============================================================================================================================  
Sub QuickSort(arr,Low,High)  
    Dim i,j,x,y,k  
    i=Low  
    j=High  
    x=arr(Cint((Low+High)/2))  
    Do  
        While (arr(i)-x<0 and i<High)  
            i=i+1  
        Wend  
        While (x-arr(j)<0 and j>Low)  
            j=j-1  
        Wend  
        If i<=j Then  
            y=arr(i)  
            arr(i)=arr(j)  
            arr(j)=y  
            i=i+1  
            j=j-1  
        End if  
    Loop while i<=j  
    If Low<j Then call QuickSort(arr,Low,j)  
    If i<High Then call QuickSort(arr,i,High)  
End sub  
'============================================================================================================================  
'函数ID：22  
'函数作用：将数组的元素以特定字符串连起来  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-4-9 21:16  
'修改时间：  
'传人参数：  
'    arr:需串连的数组  
'    character:串连字符  
'返回值：  
'    串连后的字符串  
'============================================================================================================================  
function arr_join(arr,character)  
    dim i  
    for i = 0 to ubound(arr)  
        if i = 0 then  
            arr_join = arr(i)  
        else  
            arr_join = arr_join & character & arr(i)  
        end if  
    next  
end function  
'============================================================================================================================  
'函数ID：23  
'函数作用：返回字符串以某分割符分割的数目  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-2-16 16:29  
'修改时间：  
'传人参数：  
'    errStr:错误提示-字符型  
'返回值：返回提交页面  
'============================================================================================================================  
function count_character(str,character)  
    dim i  
    i = 0  
    Do Until InStr(str,character) = 0  
      str = Mid(str, InStr(str,character) + 1)  
      i = i + 1  
    Loop  
    count_character = i  
End function  
'============================================================================================================================  
'函数ID：24  
'函数作用：截取含有分割符的字符串中指定数目的字符串  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-2-16 16:29  
'修改时间：  
'传人参数：  
'    errStr:错误提示-字符型  
'返回值：返回提交页面  
'============================================================================================================================  
function inter_str_by_character_num(str,character,start,num)  
    dim i,str_temp,start_location,inter_length,str_length  
    i = 0  
    inter_length = 0  
    str_length = len(str)  
    str = right(left(str,str_length-1),str_length-2)  
    str_length = str_length - 2  
    str_temp = str  
    Do Until InStr(str_temp,character) = 0  
        i = i + 1  
        str_temp = Mid(str_temp,InStr(str_temp,character) + 1)  
        if i = start - 1 then start_location = str_length - len(str_temp)  
        if i = start + num - 1 then  
            inter_length = str_length - len(str_temp) - start_location  
            exit do  
        end if  
    Loop  
    if inter_length = 0 then  
        inter_str_by_character_num = mid(str,start_location+1)  
    else  
        inter_str_by_character_num = mid(str,start_location+1,inter_length-1)  
    end if  
End function  
'============================================================================================================================  
'函数ID：25  
'函数作用：利用Stream下载文件  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-2-16 16:29  
'修改时间：  
'传人参数：  
'    errStr:错误提示-字符型  
'返回值：返回提交页面  
'============================================================================================================================  
function downloadFile(strFile)  
    dim strFilename,s,fso,f,intFilelength  
    Response.Buffer = True  
    Response.Clear  
    Set s = Server.CreateObject("ADODB.Stream")  
    s.Open  
    s.Type = 1  
    on error resume next  
    Set fso = Server.CreateObject("Scripting.FileSystemObject")      
    if not fso.FileExists(strFile)  then      
        Response.Write("<h1>Error:</h1>该文件不存在<p>")      
        Response.End  
    end if  
    Set f = fso.GetFile(strFile)  
    intFilelength = f.size  

    s.LoadFromFile(strFile)  
    if err then  
        Response.Write("<h1>Error:</h1>文件下载错误<p>")  
        Response.End  
    end  if  
    Response.AddHeader "Content-Disposition","attachment;filename=" & f.name  
    Response.AddHeader "Content-Length",intFilelength  
    Response.CharSet = "UTF-8"  
    Response.ContentType = "application/octet-stream"  
    Response.BinaryWrite s.Read  
    Response.Flush  
    s.Close  
    set f = nothing  
    set fso = nothing  
    Set s = Nothing  
end function  
'============================================================================================================================  
'函数ID：26  
'函数作用：返回信息  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-2-21 20：45  
'修改时间：  
'传人参数：  
'返回值：  
'============================================================================================================================  
sub send_back(ResultWords)  
    dim objResult  
    Set objResult = Server.CreateObject("MSXML2.DOMDocument")  
    objResult.loadXML ("<返回结果></返回结果>")  
    objResult.selectSingleNode("返回结果").text = ResultWords  
    Response.ContentType = "text/xml"  
    objResult.save (Response)  
    Response.End  
    Set objResult = Nothing  
end sub  
'============================================================================================================================  
'函数ID：27  
'函数作用：获取错误信息  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-4-22 13：13  
'修改时间：  
'传人参数：  
'返回值：  
'============================================================================================================================  
function get_err()  
    if Err.Number > 0 then  
        get_err = Err.Description  
    else  
        get_err = "T"  
    end if      
end function  
'============================================================================================================================  
'函数ID：28  
'函数作用：与SafeRequest相反  
'作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com  
'建立时间：2006-2-16 15:32  
'修改时间：  
'传人参数：  
'    paraName:参数名称-字符型  
'    paraType:参数类型-数字型(1表示以上参数是数字，0表示以上参数为字符)　  
'返回值：  
'    过滤后的字符串  
'============================================================================================================================  
function SafeResponse(content)  
    dim paraValue  
    paraValue = content  
    paraValue = replace(paraValue,"[system:34]","'")  
    paraValue = replace(paraValue,"[system:61]","=")  
    SafeResponse = paraValue  
end function  
'============================================================================================================================  
'函数ID：29  
'函数作用：保存远程图片  
'作者名称：http://news.dvbbs.net/infoview/Article_2906.html  
'建立时间：2006-2-16 15:32  
'修改时间：  
'传人参数：  
'    LocalFileName:本地文件名  
'   RemoteFileUrl:远程文件URL  
'返回值：  
'============================================================================================================================  
sub SaveRemoteFile(LocalFileName,RemoteFileUrl)  
    dim Ads,Retrieval,GetRemoteData  
    Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")  
    With Retrieval  
      .Open "Get", RemoteFileUrl, False, "", ""  
      .Send  
      GetRemoteData = .ResponseBody  
    End With  
    Set Retrieval = Nothing  
    Set Ads = Server.CreateObject("Adodb.Stream")  
    With Ads  
      .Type = 1  
      .Open  
      .Write GetRemoteData  
      .SaveToFile LocalFileName,2  
      .Cancel()  
      .Close()  
    End With  
    Set Ads=nothing  
end sub  
%>