'函數(shù)ID：13 
'函數(shù)作用：個(gè)性化加密 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-2-25 15:12 
'修改時(shí)間： 
'傳人參數(shù)： 
'    StrPassword：需加密的數(shù)據(jù) 
'返回值： 
'    加密后的數(shù)據(jù) 
'============================================================================================================================ 
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 
'============================================================================================================================ 
'函數(shù)ID：14 
'函數(shù)作用：禁止瀏覽器緩存本頁(yè) 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-3-5 2:45 
'修改時(shí)間： 
'傳人參數(shù)： 
'返回值： 
'============================================================================================================================ 
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 
'============================================================================================================================ 
'函數(shù)ID：15 
'函數(shù)作用：網(wǎng)頁(yè)格式化輸入文本 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-3-5 2:50 
'修改時(shí)間： 
'傳人參數(shù)： 
'     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 
'============================================================================================================================ 
'函數(shù)ID：16 
'函數(shù)作用：從頭部截取字符串的指定長(zhǎng)度(按字符數(shù)算) 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-3-5 3:04 
'修改時(shí)間： 
'傳人參數(shù)： 
'     Str：源字符串 
'    StrLen：長(zhǎng)度 
'返回值：截取得到的字符串 
'============================================================================================================================ 
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 
'============================================================================================================================ 
'函數(shù)ID：17 
'函數(shù)作用：檢測(cè)驗(yàn)證碼 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-3-5 3:09 
'修改時(shí)間： 
'傳人參數(shù)： 
'     RadomPass：輸入的驗(yàn)證碼 
'返回值： 
'============================================================================================================================ 
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 
'============================================================================================================================ 
'函數(shù)ID：18 
'函數(shù)作用：生成驗(yàn)證碼 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-3-5 3:16 
'修改時(shí)間： 
'傳人參數(shù)： 
'返回值： 
'============================================================================================================================ 
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 
'============================================================================================================================ 
'函數(shù)ID：19 
'函數(shù)作用：獲取客戶端操作系統(tǒng)版本 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-3-5 3:21 
'修改時(shí)間： 
'傳人參數(shù)： 
'返回值：操作系統(tǒng)版本名稱 
'============================================================================================================================ 
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 
'============================================================================================================================ 
'函數(shù)ID：20 
'函數(shù)作用：數(shù)據(jù)庫(kù)事務(wù)處理 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-3-5 3:25 
'修改時(shí)間： 
'傳人參數(shù)： 
'返回值：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 
'============================================================================================================================ 
'函數(shù)ID：21 
'函數(shù)作用：快速排序（遞歸） 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-4-9 19:53 
'修改時(shí)間： 
'傳人參數(shù)： 
'    arr:需排序的數(shù)組 
'    Low:數(shù)組最小下標(biāo) 
'    High:數(shù)組最大下標(biāo) 
'返回值： 
'============================================================================================================================ 
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 
'============================================================================================================================ 
'函數(shù)ID：22 
'函數(shù)作用：將數(shù)組的元素以特定字符串連起來(lái) 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-4-9 21:16 
'修改時(shí)間： 
'傳人參數(shù)： 
'    arr:需串連的數(shù)組 
'    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 
'============================================================================================================================ 
'函數(shù)ID：23 
'函數(shù)作用：返回字符串以某分割符分割的數(shù)目 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-2-16 16:29 
'修改時(shí)間： 
'傳人參數(shù)： 
'    errStr:錯(cuò)誤提示-字符型 
'返回值：返回提交頁(yè)面 
'============================================================================================================================ 
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 
'============================================================================================================================ 
'函數(shù)ID：24 
'函數(shù)作用：截取含有分割符的字符串中指定數(shù)目的字符串 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-2-16 16:29 
'修改時(shí)間： 
'傳人參數(shù)： 
'    errStr:錯(cuò)誤提示-字符型 
'返回值：返回提交頁(yè)面 
'============================================================================================================================ 
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 
'============================================================================================================================ 
'函數(shù)ID：25 
'函數(shù)作用：利用Stream下載文件 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-2-16 16:29 
'修改時(shí)間： 
'傳人參數(shù)： 
'    errStr:錯(cuò)誤提示-字符型 
'返回值：返回提交頁(yè)面 
'============================================================================================================================ 
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>文件下載錯(cuò)誤<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 
'============================================================================================================================ 
'函數(shù)ID：26 
'函數(shù)作用：返回信息 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-2-21 20：45 
'修改時(shí)間： 
'傳人參數(shù)： 
'返回值： 
'============================================================================================================================ 
sub send_back(ResultWords) 
    dim objResult 
    Set objResult = Server.CreateObject("MSXML2.DOMDocument") 
    objResult.loadXML ("<返回結(jié)果></返回結(jié)果>") 
    objResult.selectSingleNode("返回結(jié)果").text = ResultWords 
    Response.ContentType = "text/xml" 
    objResult.save (Response) 
    Response.End 
    Set objResult = Nothing 
end sub 
'============================================================================================================================ 
'函數(shù)ID：27 
'函數(shù)作用：獲取錯(cuò)誤信息 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-4-22 13：13 
'修改時(shí)間： 
'傳人參數(shù)： 
'返回值： 
'============================================================================================================================ 
function get_err() 
    if Err.Number > 0 then 
        get_err = Err.Description 
    else 
        get_err = "T" 
    end if     
end function 
'============================================================================================================================ 
'函數(shù)ID：28 
'函數(shù)作用：與SafeRequest相反 
'作者名稱：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com 
'建立時(shí)間：2006-2-16 15:32 
'修改時(shí)間： 
'傳人參數(shù)： 
'    paraName:參數(shù)名稱-字符型 
'    paraType:參數(shù)類型-數(shù)字型(1表示以上參數(shù)是數(shù)字，0表示以上參數(shù)為字符)　 
'返回值： 
'    過(guò)濾后的字符串 
'============================================================================================================================ 
function SafeResponse(content) 
    dim paraValue 
    paraValue = content 
    paraValue = replace(paraValue,"[system:34]","'") 
    paraValue = replace(paraValue,"[system:61]","=") 
    SafeResponse = paraValue 
end function 
'============================================================================================================================ 
'函數(shù)ID：29 
'函數(shù)作用：保存遠(yuǎn)程圖片 
'作者名稱：http://news.dvbbs.net/infoview/Article_2906.html 
'建立時(shí)間：2006-2-16 15:32 
'修改時(shí)間： 
'傳人參數(shù)： 
'    LocalFileName:本地文件名 
'   RemoteFileUrl:遠(yuǎn)程文件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 
%>