ASP通用函數(shù)庫

2019-11-17 04:13:05

字體：大中小

供稿：網(wǎng)友

程序代碼
<%
    '******************************
    '類名：
    '名稱：通用庫
    '日期：2008/10/28
    '作者：by xilou
    '網(wǎng)址：    '版權(quán)：轉(zhuǎn)載請注名出處，作者
    '******************************
    '最后修改：20090108
    '修改次數(shù)：2
    '修改說明：
    '20090108 增加下列函數(shù)：
    '    A2U(),U2A(),UrlEncode(),UrlDecode(),GBToUTF8(),Bytes2Str(),Str2Bytes()
    '20090108 增加下列函數(shù)：
    '    AryToVbsString(arr)
    '目前版本：
    '******************************/

    '輸出
    Sub Echo(str)
        Response.Write str
    End Sub

    '斷點(diǎn)
    Sub Halt()
        Response.End()
    End Sub

    '輸出并換行
    Sub Br(str)
        Echo str & "<br />" & vbcrlf
    End Sub

    '簡化Request.Form()
    'f : 表單名稱
    Function P(f)
        P = Replace(Request.Form(f), Chr(0), "")
    End Function

    '接收表單并替換單引號
    Function PR(f)
        Pr = Replace(Request.Form(f), Chr(0), "")
        Pr = Replace(Pr, "'", "''")
    End Function

    '簡化Request.Querystring()
    'f : 表單名稱
    Function G(f)
        G = Replace(Request.QueryString(f), Chr(0), "")
    End Function

    '接收url參數(shù)并替換單引號
    Function Gr(f)
        Gr = Replace(Request.QueryString(f), Chr(0), "")
        Gr = Replace(Gr, "'", "''")
    End Function

    '//構(gòu)造()?:三目運(yùn)算 by xilou     Function IfThen(ifTrue, s1, s2)
        Dim t
        If ifTrue Then
            t = s1
        Else
            t = s2
        End If
        IfThen = t
    End Function

    '顯示不同顏色的是和否
    Function IfThenFont(ifTrue, s1, s2)
        Dim str
        If ifTrue Then
            str = "<font color=""#006600"">" & s1 & "</font>"
        Else
            str = "<font color=""#FF0000"">" & s2 & "</font>"
        End If
        IfThenFont = str
    End Function

    '創(chuàng)建Dictionary對象
    Function NewHashTable()
        Set NewHashTable = Server.CreateObj("Scr         NewHashTable.CompareMode = 1 '鍵值不區(qū)分大小寫
    End Function

    '創(chuàng)建 xmlHttp
    Function Newxmlhttp()
        Set NewXmlHttp = Server.createobject("MSXML2.XMLHTTP")
    End Function

    '創(chuàng)建XmlDom
    Function NewXmlDom()
    End Function

    '創(chuàng)建AdoStream
    Function NewAdoStream()
        Set NewAdoStream = Server.CreateObject("Adodb.Stream")
    End Function

    '創(chuàng)建一個(gè)1維數(shù)組
    '返回n個(gè)元素的空數(shù)組
    'n : 元素個(gè)數(shù)
    Function NewArray(n)
        Dim ary : ary = array()
        ReDim ary(n-1)
        NewArray = ary
    End Function

    '構(gòu)造Try..Catch
    Sub Try()
        On Error Resume Next
    End Sub

    '構(gòu)造Try..Catch
    'msg : 拋出的錯(cuò)誤信息，如果為空則拋出Err.Description
    Sub Catch(msg)
        Dim html
        html = "<ul><li>$1</li></ul>"
        If Err Then
            If msg <> "" Then
                echo Replace(html, "$1", msg)
                Halt
            Else
                echo Replace(html, "$1", Err.Description)
                Halt
            End If
            Err.Clear
            Response.End()
        End If
    End Sub

    '--------------------------------數(shù)組操作開始
    '判斷數(shù)組中是否存在某個(gè)值
    Function InArray(arr, s)
        If Not IsArray(arr) Then InArray = False : Exit Function
        Dim i
        For i = LBound(arr) To UBound(arr)
            If s = arr(i) Then InArray = True : Exit Function
        Next
        InArray = False
    End Function

    '用ary數(shù)組中的值分別替換str中的占位符
    '返回替換后的字符串
    'str:要替換的字符串,占位符分別為$0,$1,$2...
    'ary:用來替換的數(shù)組,每個(gè)值分別對應(yīng)占位符中的$0,$1,$2...
    '如:ReplaceByAry("$0-$1-$2 $3:$4:$5",Array(y,m,d,h,i,s))
    Function ReplaceByAry(str,ary)
        Dim i, j, L1, L2 : j = 0
        If IsArray(ary) Then
            L1 = LBound(ary) : L2 = UBound(ary)
            For i = L1 To L2
                str = Replace(str, "$"&j, ary(i))
                j   = j+1
            Next
        End If
        ReplaceByAry = str
    End Function
    '--------------------------------數(shù)組操作結(jié)束

    '--------------------------------隨機(jī)數(shù)操作開始
    '獲取隨機(jī)數(shù)
    'm-n的隨機(jī)數(shù)字
    Function RndNumber(m,n)
        Randomize
        RndNumber = Int((n - m + 1) * Rnd + m)
    End Function

    '獲取隨機(jī)字符串
    'n : 產(chǎn)生的長度
    Function RndText(n)
        Dim str1, str2, i, x, L
        str1 = "NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz"
        L    = Len(str1)
        Randomize
        For i = 1 To n
            x    = Int((L - 1 + 1) * Rnd + 1)
            str2 = str2 & Mid(str1,x,1)
        Next
        RndText = str2
    End Function

    '從字符串str中產(chǎn)生m至n個(gè)的隨機(jī)字符串
    '如果str為空則默認(rèn)從數(shù)字和字母中產(chǎn)生隨機(jī)字符串
    'str : 要從該字符串中產(chǎn)生隨機(jī)字符串
    'm,n : 產(chǎn)生n到m位
    Function RndByText(str, m, n)
        Dim i, k, str2, L, x
        If str = "" Then str = "NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz"
        L = Len(str)
        If n = m Then
            k = n
        Else
            Randomize
            k = Int((n - m + 1) * Rnd + m)
        End If
        Randomize
        For i = 1 To k
            x    = Int((L - 1 + 1) * Rnd + 1)
            str2 = str2 & Mid(str, x, 1)
        Next
        RndByText = str2
    End Function

    '日期時(shí)間組成隨機(jī)數(shù)
    '返回當(dāng)前時(shí)間的數(shù)字組合
    Function RndByDateTime()
        Dim dt : dt = Now()
        RndByDateTime = Year(dt) & Month(dt) & Day(dt) & Hour(dt) & Minute(dt) & Second(dt)
    End Function
    '--------------------------------隨機(jī)數(shù)操作結(jié)束

    '--------------------------------字符串操作開始
    '判斷一字符串str2在另一個(gè)字符串str1中出現(xiàn)的次數(shù)
    '返回次數(shù)，沒有則返回0
    'str1 :接受搜索的字符串表達(dá)式
    'str2 :要搜索的字符串表達(dá)式
    'start:要搜索的開始位置,為空表示默認(rèn)從1開始搜索
    Function InStrTimes(str1, str2, start)
        Dim a,c
        If start = "" Then start = 1
        c = 0
        a = InStr(start, str1, str2)
        Do While a > 0
            c = c + 1
            a = InStr(a+1, str1, str2)
        Loop
        InStrTimes = c
    End Function

    '字符串連接
    '無返回
    'strResult : 連接后保存的字符
    'str       : 要連接的字符
    'partition : 連接字符間的分割符號
    Sub JoinStr(byref strResult,str,partition)
        If strResult <> "" Then
            strResult = strResult & partition & str
        Else
            strResult = str
        End If
    End Sub

    '計(jì)算字符串的字節(jié)長度，一個(gè)漢字=2字節(jié)
    Function StrLen(str)
        If isNull(str) or Str = "" Then
            StrLen = 0
            Exit Function
        End If
        Dim WINNT_CHINESE
        WINNT_CHINESE = (len("例子")=2)
        If WINNT_CHINESE Then
            Dim l,t,c
            Dim i
            l = len(str)
            t = l
            For i = 1 To l
                c = asc(mid(str,i,1))
                If c<0 Then c = c + 65536
                If c>255 Then t = t + 1
            Next
            StrLen = t
        Else
            StrLen = len(str)
        End If
    End Function

    '截取字符串
    ' str    : 要截取的字符串
    ' strlen : 要截取的長度
    ' addStr : 超過長度的用這個(gè)代替，如:...
    Function CutStr(str, strlen, addStr)
        Dim i,l, t, c
        If Is_Empty(str) Then CutStr = "" : Exit Function
        l = len(str) : t = 0
        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 Then
                CutStr = left(str, i) & addStr
                Exit For
            Else
                CutStr = str
            End If
        Next
    End Function

    '全角轉(zhuǎn)換成半角
    Function SBCcaseConvert(str)
        Dim b, c, i
        b = "１,２,３,４,５,６,７,８,９,０," _
        &"Ａ,Ｂ,Ｃ,Ｄ,Ｅ,Ｆ,Ｇ,Ｈ,Ｉ,Ｊ,Ｋ,Ｌ,Ｍ,Ｎ,Ｏ,Ｐ,Ｑ,Ｒ,Ｓ,Ｔ,Ｕ,Ｖ,Ｗ,Ｘ,Ｙ,Ｚ"
        c = "1,2,3,4,5,6,7,8,9,0," _
        &"A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z"
        b = split(b,",")
        c = split(c,",")
        For i = 0 To Ubound(b)
            If instr(str,b(i)) > 0 Then
                str = Replace(str, b(i), c(i))
            End If
        Next
        SBCcaseConvert = str
    End Function

    '與javascript中的escape()等效
    Function VbsEscape(str)
        dim i,s,c,a
        s = ""
        For i=1 to Len(str)
            c = Mid(str,i,1)
            a = ASCW(c)
            If (a>=48 and a<=57) or (a>=65 and a<=90) or (a>=97 and a<=122) Then
                s = s & c
            ElseIf InStr("@*_+-./",c) > 0 Then
                s = s & c
            ElseIf a>0 and a<16 Then
                s = s & "%0" & Hex(a)
            ElseIf a>=16 and a<256 Then
                s = s & "%" & Hex(a)
            Else
                s = s & "%u" & Hex(a)
            End If
        Next
        VbsEscape = s
    End Function

    '對Javascript中使用escape()編碼過的數(shù)據(jù)進(jìn)行解碼,Ajax調(diào)用時(shí)用
    Function VbsUnEscape(str)
        Dim x
        x = InStr(str,"%")
        Do While x > 0
            VbsUnEscape = VbsUnEscape & Mid(str,1,x-1)
            If LCase(Mid(str,x+1,1)) = "u" Then
                VbsUnEscape = VbsUnEscape & ChrW(CLng("&H"&Mid(str,x+2,4)))
                str = Mid(str,x+6)
            Else
                VbsUnEscape = VbsUnEscape & Chr(CLng("&H"&Mid(str,x+1,2)))
                str = Mid(str,x+3)
            End If
            x = InStr(str,"%")
        Loop
        VbsUnEscape = VbsUnEscape & str
    End Function

    '將ascii字符轉(zhuǎn)為unicode編碼形式
    Function A2U(str)
        Dim i,L,uText
        L = Len(str)
        For i = 1 To L
            uText = uText & "&#" & AscW(Mid(str,i,1)) & ";"
        Next
        A2U = uText
    End Function

    '將unicode編碼轉(zhuǎn)為ascii
    'str : 要轉(zhuǎn)碼的字符串，必須全部都是unicode字符，否則會(huì)出錯(cuò)
    Function U2A(str)
        Dim ary,i,L,newStr
        ary = Split(str,";")
        L   = UBound(ary)
        For i = 0 To L - 1
            newStr = newStr & ChrW(Replace(ary(i),"&#",""))
        Next
        U2A = newStr
    End Function

    'url編碼
    Function UrlEncode(str)
        UrlEncode = Server.UrlEncode(str)
    End Function

    'url解碼
    Function UrlDecode(str)
        Dim newstr, havechar, lastchar, i, char_c, next_1_c, next_1_Num
        newstr   = ""
        havechar = false
        lastchar = ""
        For i = 1 To Len(str)
            char_c = Mid(str,i,1)
            If char_c = "+" Then
                newstr = newstr & " "
            ElseIf char_c = "%" Then
                next_1_c = Mid(str, i+1, 2)
                next_1_num = Cint("&H" & next_1_c)
                If havechar Then
                    havechar = false
                    newstr = newstr & Chr(CInt("&H" & lastchar & next_1_c))
                Else
                    If Abs(next_1_num) <= 127 Then
                        newstr = newstr & Chr(next_1_num)
                    Else
                        havechar = true
                        lastchar = next_1_c
                    End If
                End If
                i = i + 2
            Else
                newstr = newstr & char_c
            End If
        Next
        UrlDecode = newstr
    End Function

    'GB轉(zhuǎn)UTF8--將GB編碼文字轉(zhuǎn)換為UTF8編碼文字
    Function GBToUTF8(gbStr)
        Dim wch, uch, szRet,szInput
        Dim x
        Dim nAsc, nAsc2, nAsc3
        szInput = gbStr
        '如果輸入?yún)?shù)為空，則退出函數(shù)
        If szInput = "" Then
            toUTF8 = szInput
            Exit Function
        End If
        '開始轉(zhuǎn)換
         For x = 1 To Len(szInput)
            '利用mid函數(shù)分拆GB編碼文字
            wch = Mid(szInput, x, 1)
            '利用ascW函數(shù)返回每一個(gè)GB編碼文字的Unicode字符代碼
            '注：asc函數(shù)返回的是ANSI 字符代碼，注意區(qū)別
            nAsc = AscW(wch)
            If nAsc < 0 Then nAsc = nAsc + 65536

            If (nAsc And &HFF80) = 0 Then
                szRet = szRet & wch
            Else
                If (nAsc And &HF000) = 0 Then
                    uch = "%" & Hex(((nAsc / 2 ^ 6)) or &HC0) & Hex(nAsc And &H3F or &H80)
                    szRet = szRet & uch
                Else
                   'GB編碼文字的Unicode字符代碼在0800 - FFFF之間采用三字節(jié)模版
                    uch = "%" & Hex((nAsc / 2 ^ 12) or &HE0) & "%" & _
                                Hex((nAsc / 2 ^ 6) And &H3F or &H80) & "%" & _
                                Hex(nAsc And &H3F or &H80)
                    szRet = szRet & uch
                End If
            End If
        Next
        GBToUTF8 = szRet
    End Function

    'Byte流到Char流的轉(zhuǎn)換
    Function Bytes2Str(vin,charset)
        Dim ms,strRet
        Set ms = Server.CreateObject("ADODB.Stream")    '建立流對象
        ms.Type = 1             ' Binary
        ms.Open
        ms.Write vin            '把vin寫入流對象中

        ms.Position = 0         '設(shè)置流對象的起始位置是0 以設(shè)置Charset屬性
        ms.Type = 2              'Text
        ms.Charset = charset    '設(shè)置流對象的編碼方式為 charset

        strRet = ms.ReadText    '取字符流
        ms.close                '關(guān)閉流對象
        Set ms = nothing
        Bytes2Str = strRet
    End Function

    'Char流到Byte流的轉(zhuǎn)換
    Function Str2Bytes(str,charset)
        Dim ms,strRet
        Set ms = CreateObject("ADODB.Stream")    '建立流對象
        ms.Type = 2             ' Text
        ms.Charset = charset    '設(shè)置流對象的編碼方式為 charset
        ms.Open
        ms.WriteText str            '把str寫入流對象中

        ms.Position = 0         '設(shè)置流對象的起始位置是0 以設(shè)置Charset屬性
        ms.Type = 1              'Binary

        vout = ms.Read(ms.Size)    '取字符流
        ms.close                '關(guān)閉流對象
        Set ms = nothing
        Str2Bytes = vout
    End Function
    '--------------------------------字符串操作結(jié)束

    '--------------------------------時(shí)間日期操作開始
    '根據(jù)年份和月份獲得相應(yīng)的月份天數(shù)
    '返回天數(shù)
    'y : 年份,如：2008
    'm : 月份,如：3
    Function GetDayCount(y,m)
        Dim c
        Select Case m
        Case 1, 3, 5, 7, 8, 10, 12
            c=31
        Case 2
            If IsDate(y&"-"&m&"-"&"29") Then
                c = 29
            Else
                c = 28
            End If
        Case Else
            c = 30
        End Select
        GetDayCount = c
    End Function

    '判斷一個(gè)日期時(shí)間是否在某段時(shí)間之間,包括比較的兩頭時(shí)間
    Function IsBetweenTime(fromTime,toTime,strTime)
        If DateDiff("s",fromTime,strTime) >= 0 And DateDiff("s",toTime,strTime) <= 0 Then
            IsBetweenTime = True
        Else
            IsBetweenTime = False
        End If
    End Function
    '--------------------------------時(shí)間日期操作結(jié)束

    '--------------------------------安全加密相關(guān)操作開始

    '--------------------------------安全加密相關(guān)操作結(jié)束

    '--------------------------------數(shù)據(jù)合法性驗(yàn)證操作開始
    '通過正則檢測字符串,返回true|false
    Function RegExpTest(strPatrn,strText)
        Dim objRegExp, matches
        Set objRegExp = New RegExp
        objRegExp.Pattern    = strPatrn
        objRegExp.IgnoreCase = False
        objRegExp.Global     = True
        RegExpTest    = objRegExp.Test(strText)
        'Set matches   = objRegExp.Execute(strText)
        Set objRegExp = nothing
    End Function

    '是否是正整數(shù)
    Function IsPint(str)
        IsPint = RegExpTest("^[1-9]{1}/d*$", str)
    End Function

    '是否是0或正整數(shù)
    Function IsInt(str)
        IsInt = RegExpTest("^0|([1-9]{1}/d*)$", str)
    End Function

    'Email
    Function IsEmail(str)
        Dim patrn
        patrn = "^/w+((-/w+)|(/./w+))*/@[A-Za-z0-9]+((/.|-)[A-Za-z0-9]+)*/.[A-Za-z0-9]+$"
        IsEmail = RegExpTest(patrn,str)
    End Function

    '手機(jī)
    Function IsMobile(str)
        Dim patrn
        patrn = "^(130|131|132|133|153|134|135|136|137|138|139|158|159){1}/d{8}$"
        IsMobile = RegExpTest(patrn,str)
    End Function

    'QQ
    Function IsQQ(str)
        Dim patrn
        patrn = "^[1-9]/d{4,8}$"
        IsQQ = RegExpTest(patrn,str)
    End Function

    '身份證
    Function IsIdCard(e)
        Dim arrVerifyCode,Wi,Checker
        arrVerifyCode = Split("1,0,x,9,8,7,6,5,4,3,2", ",")
        Wi = Split("7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2", ",")
        Checker = Split("1,9,8,7,6,5,4,3,2,1,1", ",")

        If Len(e) < 15 or Len(e) = 16 or Len(e) = 17 or Len(e) > 18 Then
            IsIdCard = False
            Exit Function
        End If

        Dim Ai
        If Len(e) = 18 Then
            Ai = Mid(e, 1, 17)
        ElseIf Len(e) = 15 Then
            Ai = e
            Ai = Left(Ai, 6) & "19" & Mid(Ai, 7, 9)
        End If
        If Not IsNumeric(Ai) Then
            IsIdCard= False
            Exit Function
        End If
        Dim strYear, strMonth, strDay, BirthDay
        strYear = CInt(Mid(Ai, 7, 4))
        strMonth = CInt(Mid(Ai, 11, 2))
        strDay = CInt(Mid(Ai, 13, 2))
        BirthDay = Trim(strYear) + "-" + Trim(strMonth) + "-" + Trim(strDay)
        If IsDate(BirthDay) Then
            If DateDiff("yyyy",Now,BirthDay)<-140 or cdate(BirthDay)>date() Then
                IsIdCard= False
                Exit Function
            End If
            If strMonth > 12 or strDay > 31 Then
                IsIdCard= False
                Exit Function
            End If
        Else
            IsIdCard= False
            Exit Function
        End If
        Dim i, TotalmulAiWi
        For i = 0 To 16
            TotalmulAiWi = TotalmulAiWi + CInt(Mid(Ai, i + 1, 1)) * Wi(i)
        Next
        Dim modValue
        modValue = TotalmulAiWi Mod 11
        Dim strVerifyCode
        strVerifyCode = arrVerifyCode(modValue)
        Ai = Ai & strVerifyCode
        IsIdCard = Ai

        If Len(e) = 18 And e <> Ai Then
            IsIdCard= False
            Exit Function
        End If
        IsIdCard=True
    End Function

    '郵政編碼
    Function IsZipCode(str)
        Dim patrn
        patrn = "^[1-9]/d{2,5}$"
        IsZipCode = RegExpTest(patrn,str)
    End Function

    '是否為空，包括IsEmpty(),IsNull(),""的功能
    Function Is_Empty(str)
        If IsNull(str) or IsEmpty(str) or str="" Then
            Is_Empty=True
        Else
            Is_Empty=False
        End If
    End Function
    '--------------------------------數(shù)據(jù)合法性驗(yàn)證操作結(jié)束

    '--------------------------------文件操作開始
    '獲取文件后綴，如jpg
    Function GetFileExt(f)
        GetFileExt = Lcase(Mid(f,InStrRev(f,".") + 1))
    End Function

    '生成文件夾
    'path : 要生成的文件夾路徑，用相對路徑
    Sub CFolder(path)
        Dim fso
        Set fso = Server.CreateObject("Scripting.FileSystemObject")
        If Not fso.FolderExists(path) Then
            fso.CreateFolder(path)
        End If
        Set fso = Nothing
    End Sub

    '刪除文件夾
    'path : 文件夾路徑，用相對路徑
    Sub DFolder(path)
        Dim fso
        Set fso = Server.CreateObject("Scripting.FileSystemObject")
        If fso.FolderExists(path) Then
            fso.DeleteFolder path,true
        Else
            echo "路徑不存在:" & path
        End If
        Set fso = Nothing
    End Sub

    '生成文件
    'path   : 生成文件路徑，包括名稱
    'strText: 文件內(nèi)容
    Sub CFile(path,strText)
        Dim f,fso
        Set fso = Server.CreateObject("Scripting.FileSystemObject")
        Set f = fso.CreateTextFile(path)
        f.Write strText
        Set f = Nothing
        Set fso = Nothing
    End Sub

    '刪除文件
    'path   : 文件路徑，包括名稱
    Sub DFile(path)
        Dim fso
        Set fso = Server.CreateObject("Scripting.FileSystemObject")
        If fso.FileExists(path) Then
            Fso.DeleteFile(path)
        End If
        Set fso = Nothing
    End Sub

    '采集
    Function GetHTTPPage(url)
        ' Http.setTimeouts 10000,10000,10000,10000
        'On Error Resume Next
        Dim Http
        Set Http = Server.createobject("MSXML2.XMLHTTP")
        Http.open "GET",url,false
        Http.send()
        If Http.Status <> 200 Then
            Exit Function
        End If
        'If Err Then Response.Write url : Response.End()
        GetHTTPPage = bytesToBSTR(Http.ResponseBody,"GB2312")
        'Http.Close()
        'if err.number<>0 then err.Clear
    End Function

    '編碼轉(zhuǎn)換
    Function BytesToBstr(body,Cset)
        Dim StreamObj
        Set StreamObj = Server.CreateObject("Adodb.Stream")
        StreamObj.Type = 1
        StreamObj.Mode = 3
        StreamObj.Open
        StreamObj.Write body
        StreamObj.Position = 0
        StreamObj.Type     = 2
        StreamObj.Charset = Cset
        BytesToBstr        = StreamObj.ReadText
        StreamObj.Close
    End Function
    '--------------------------------文件操作結(jié)束

    '--------------------------------其他操作開始
    '顯示信息
    'message : 要顯示的信息
    'url     : 要跳轉(zhuǎn)的URL
    'typeNum : 顯示方式，1彈出信息，回退到上一頁；2彈出信息，轉(zhuǎn)到url處
    Sub ShowMsg(message,url,typeNum)
        message = replace(message,"'","/'")
        Select Case TypeNum
        Case 1
           echo ("<script language=javascript>alert('" & message & "');history.go(-1)</script>")
        Case 2
           echo ("<script language=javascript>alert('" & message & "');location='" & Url &"'</script>")
        End Select
    End Sub

    '顯示option列表并定位,by xilou     'valueArr : 值數(shù)組
    'curValue : 當(dāng)前選定值
    Function ShowOpList(textArr, valueArr, curValue)
        Dim str, style, i
        style = "style=""background-color:#FFCCCC"""
        str   = ""
        If IsNull(curValue) Then curValue = ""
        For I = LBound(textArr) To UBound(valueArr)
            If Cstr(valueArr(I)) = Cstr(curValue) Then
                str = str&"<option value="""&valueArr(I)&""" selected=""selected"" "&style&" >"&textArr(I)&"</option>"&vbcrlf
            Else
                str = str&"<option value="""&valueArr(I)&""" >"&textArr(I)&"</option>"&vbcrlf
            End If
        Next
        ShowOpList = str
    End Function