<%
Const IsDeBug = 1
Class NewaspMain_Cls

    Public membername, memberpass, membergrade, membergroup, memberid
    Public memberclass, menbernickname, Cookies_Name, CheckPassword

    Public SiteName, SiteUrl, MasterMail, keywords, Copyright
    Public InstallDir, IndexName, IstopSite, StopReadme, IsCloseMail
    Public SendMailType, MailFrom, MailServer, MailUserName, MailPassword, MailInformPass, ChkSameMail
    Public CheckUserReg, AdminCheckReg, AddUserPoint, SendRegMessage, FullContQuery, ActionTime
    Public IsRunTime, UploadClass, UploadFileSize, UploadFileType, ContentKeyword, PreviewSetting
    Public StopApplyLink, FSO_ScriptName, InitTitleColor, StopBankPay
    Public ChinaeBank, VersionID, Badwords, Badwordr, serialcode, passedcode

    Public ChannelName, ChannelDir, StopChannel, ChannelType
    Public modules, ChannelSkin, HtmlPath, HtmlForm, HtmlPrefix
    Public IsCreateHtml, HtmlExtName, StopUpload, MaxFileSize, UpFileType
    Public IsAuditing, AppearGrade, ModuleName, BindDomain, DomainName
    Public PostGrade, LeastString, MaxString, PaginalNum, LeastHotHist, Channel_Setting
    Public ChannelSetting,ChannelData,ChannelPath
    Public ChannelModule,ChannelHtmlPath,ChannelHtmlForm,ChannelUseHtml,ChannelHtmlExt,ChannelPrefix

    Public ThisEdition, CopyrightStr, Version, Values, startime
    Public SqlQueryNum, GetUserip, CacheName, Reloadtime

    Public ScriptName, Admin_Page, skinid, SkinPath, HtmlCss, HtmlTop, HtmlFoot, HtmlContent, sHtmlContent
    Private Main_Style, Main_Setting, MainStyle, Html_Setting
    Private LocalCacheName, Cache_Data
    Private CacheChannel, CacheData

    Private arrGroupSetting, blnGroupSetting, binUserLong

    Private Sub Class_Initialize()
        On Error Resume Next
        Reloadtime = 28800
        SqlQueryNum = 0
        '--緩存名稱
        CacheName = "newasp"
        Cookies_Name = "newasp_net"
        binUserLong = False
        blnGroupSetting = False
        GetUserip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
        If Len(GetUserip) = 0 Then GetUserip = Request.ServerVariables("REMOTE_ADDR")
        GetUserip = CheckStr(GetUserip)
        membername = CheckStr(Request.Cookies(Cookies_Name)("username"))
        memberpass = CheckStr(Request.Cookies(Cookies_Name)("password"))
        menbernickname = CheckStr(Request.Cookies(Cookies_Name)("nickname"))
        membergrade = ChkNumeric(Request.Cookies(Cookies_Name)("UserGrade"))
        membergroup = CheckStr(Request.Cookies(Cookies_Name)("UserGroup"))
        memberclass = ChkNumeric(Request.Cookies(Cookies_Name)("UserClass"))
        memberid = ChkNumeric(Request.Cookies(Cookies_Name)("userid"))
        CheckPassword = CheckStr(Request.Cookies(Cookies_Name)("CheckPassword"))
        Dim tmpstr, i
        tmpstr = Request.ServerVariables("PATH_INFO")
        tmpstr = Split(tmpstr, "/")
        i = UBound(tmpstr)
        ScriptName = LCase(tmpstr(i))
        Admin_Page = False
        If InStr(ScriptName, "showerr") > 0 Or InStr(ScriptName, "login") > 0 Or InStr(ScriptName, "admin_") > 0 Then Admin_Page = True
    End Sub

    Private Sub Class_Terminate()
        If IsObject(Conn) Then Conn.Close : Set Conn = Nothing
    End Sub

    '===================服務(wù)器緩存部分函數(shù)開始===================
    Public Property Let Name(ByVal vNewValue)
        LocalCacheName = LCase(vNewValue)
        Cache_Data = Application(CacheName & "_" & LocalCacheName)
    End Property
    Public Property Let Value(ByVal vNewValue)
        If LocalCacheName <> "" Then
            ReDim Cache_Data(2)
            Cache_Data(0) = vNewValue
            Cache_Data(1) = Now()
            Application.Lock
            Application(CacheName & "_" & LocalCacheName) = Cache_Data
            Application.UnLock
        Else
            Err.Raise vbObjectError + 1, "NewaspCacheServer", " please change the CacheName."
        End If
    End Property
    Public Property Get Value()
        If LocalCacheName <> "" Then
            If IsArray(Cache_Data) Then
                Value = Cache_Data(0)
            Else
                'Err.Raise vbObjectError + 1, "NewaspCacheServer", " The Cache_Data("&LocalCacheName&") Is Empty."
            End If
        Else
            Err.Raise vbObjectError + 1, "NewaspCacheServer", " please change the CacheName."
        End If
    End Property
    Public Function ObjIsEmpty()
        ObjIsEmpty = True
        If Not IsArray(Cache_Data) Then Exit Function
        If Not IsDate(Cache_Data(1)) Then Exit Function
        If DateDiff("s", CDate(Cache_Data(1)), Now()) < (60 * Reloadtime) Then ObjIsEmpty = False
    End Function
    Public Sub DelCahe(MyCaheName)
        Application.Lock
        Application.Contents.Remove (CacheName & "_" & MyCaheName)
        Application.UnLock
    End Sub
    Public Sub DelCache(MyCaheName)
        Application.Lock
        Application.Contents.Remove ("mynewasp_" & MyCaheName)
        Application.UnLock
    End Sub
    '===================服務(wù)器緩存部分函數(shù)結(jié)束===================

    Public Function ChkBoolean(ByVal Values)
        If TypeName(Values) = "Boolean" Or IsNumeric(Values) Or LCase(Values) = "false" Or LCase(Values) = "true" Then
            ChkBoolean = CBool(Values)
        Else
            ChkBoolean = False
        End If
    End Function

    Public Function CheckNumeric(ByVal CHECK_ID)
        If CHECK_ID <> "" And IsNumeric(CHECK_ID) Then
            CHECK_ID = CCur(CHECK_ID)
        Else
            CHECK_ID = 0
        End If
        CheckNumeric = CHECK_ID
    End Function

    Public Function ChkNumeric(ByVal CHECK_ID)
        If CHECK_ID <> "" And IsNumeric(CHECK_ID) Then
            CHECK_ID = CLng(CHECK_ID)
            If CHECK_ID < 0 Then CHECK_ID = 0
        Else
            CHECK_ID = 0
        End If
        ChkNumeric = CHECK_ID
    End Function

    Public Function CheckStr(ByVal str)
        If IsNull(str) Then
            CheckStr = ""
            Exit Function
        End If
        str = Replace(str, Chr(0), "")
        CheckStr = Replace(str, "'", "''")
    End Function
    '================================================
    '過程名：CheckNull
    '作  用：是否有效值
    '================================================
    Public Function CheckNull(ByVal sValue)
        On Error Resume Next
        If IsNull(sValue) Then
            CheckNull = False
            Exit Function
        End If
        If Trim(sValue) <> "" And LCase(Trim(sValue)) <> "http://" Then
            CheckNull = True
        Else
            CheckNull = False
        End If
    End Function
    Public Function ChkNull(ByVal str)
        On Error Resume Next
        If IsNull(str) Then
            ChkNull = ""
            Exit Function
        End If
        If Trim(str) <> "" And LCase(Trim(str)) <> "http://" Then
            ChkNull = Trim(str)
        Else
            ChkNull = ""
        End If
    End Function
    '=============================================================
    '函數(shù)名：ChkFormStr
    '作  用：過濾表單字符
    '參  數(shù)：str   ----原字符串
    '返回值：過濾后的字符串
    '=============================================================
    Public Function ChkFormStr(ByVal str)
        Dim fString
        fString = str
        If IsNull(fString) Then
            ChkFormStr = ""
            Exit Function
        End If
        fString = Replace(fString, "'", "&#39;")
        fString = Replace(fString, Chr(34), "&quot;")
        fString = Replace(fString, Chr(13), "")
        fString = Replace(fString, Chr(10), "")
        fString = Replace(fString, Chr(9), "")
        fString = Replace(fString, ">", "&gt;")
        fString = Replace(fString, "<", "&lt;")
        fString = Replace(fString, "%", "％")
        ChkFormStr = Trim(JAPEncode(fString))
    End Function
    '=============================================================
    '函數(shù)作用：過濾SQL非法字符
    '=============================================================
    Public Function CheckRequest(ByVal str,ByVal strLen)
        On Error Resume Next
        str = Trim(str)
        str = Replace(str, Chr(0), "")
        str = Replace(str, "'", "")
        str = Replace(str, "%", "")
        str = Replace(str, "^", "")
        str = Replace(str, ";", "")
        str = Replace(str, "*", "")
        str = Replace(str, "<", "")
        str = Replace(str, ">", "")
        str = Replace(str, "|", "")
        str = Replace(str, "and", "")
        str = Replace(str, "chr", "")

        If Len(str) > 0 And strLen > 0 Then
            str = Left(str, strLen)
        End If
        CheckRequest = str
    End Function
    '-- 移除有害字符
    Public Function RemoveBadCharacters(ByVal strTemp)
        Dim re
        On Error Resume Next
        Set re = New RegExp
        re.Pattern = "[^\s\w]"
        re.Global = True
        RemoveBadCharacters = re.Replace(strTemp, "")
        Set re = Nothing
    End Function
    '-- 去掉HTML標(biāo)記
    Public Function RemoveHtml(ByVal Textstr)
        Dim Str,re
        Str = Textstr
        On Error Resume Next
        Set re = New RegExp
        re.IgnoreCase = True
        re.Global = True
        re.Pattern = "<(.[^>]*)>"
        Str = re.Replace(Str, "")
        Set re = Nothing
        RemoveHtml=Str
    End Function
    '-- 數(shù)據(jù)庫(kù)連接
    Public Function Execute(Command)
        If Not IsObject(Conn) Then ConnectionDatabase        
        If IsDeBug = 0 Then 
            On Error Resume Next
            Set Execute = Conn.Execute(Command)
            If Err Then
                err.Clear
                Set Conn = Nothing
                Response.Write "查詢數(shù)據(jù)的時(shí)候發(fā)現(xiàn)錯(cuò)誤，請(qǐng)檢查您的查詢代碼是否正確。<br /><li>"
                Response.Write Command
                Response.End
            End If
        Else
            Set Execute = Conn.Execute(Command)
        End If    
        SqlQueryNum = SqlQueryNum+1
    End Function

    Public Sub ReadConfig()
        On Error Resume Next
        Name = "Config"
        If ObjIsEmpty() Then ReloadConfig
        CacheData = Value
        '第一次起用系統(tǒng)或者重啟IIS的時(shí)候加載緩存
        Name = "Date"
        If ObjIsEmpty() Then
            Value = Date
        Else
            If CStr(Value) <> CStr(Date) Then
                Name = "Config"
                Call ReloadConfig
                CacheData = Value
            End If
        End If
        SiteName = CacheData(1, 0): SiteUrl = CacheData(2, 0): MasterMail = CacheData(3, 0): keywords = CacheData(4, 0): Copyright = CacheData(5, 0): InstallDir = CacheData(6, 0)
        IndexName = CacheData(7, 0): IstopSite = CacheData(8, 0): StopReadme = CacheData(9, 0): IsCloseMail = CacheData(10, 0): SendMailType = CacheData(11, 0): MailFrom = CacheData(12, 0)
        MailServer = CacheData(13, 0): MailUserName = CacheData(14, 0): MailPassword = CacheData(15, 0): CheckUserReg = CacheData(16, 0): AdminCheckReg = CacheData(17, 0): MailInformPass = CacheData(18, 0)
        ChkSameMail = CacheData(19, 0): AddUserPoint = CacheData(20, 0): SendRegMessage = CacheData(21, 0): FullContQuery = CacheData(22, 0): ActionTime = CacheData(23, 0): IsRunTime = CacheData(24, 0)
        UploadClass = CacheData(25, 0): UploadFileSize = CacheData(26, 0): UploadFileType = CacheData(27, 0): ContentKeyword = CacheData(28, 0): StopApplyLink = CacheData(29, 0): FSO_ScriptName = CacheData(30, 0)
        InitTitleColor = CacheData(31, 0): StopBankPay = CacheData(32, 0): ChinaeBank = CacheData(33, 0): VersionID = CacheData(34, 0): Badwords = CacheData(35, 0): Badwordr = CacheData(36, 0)
        serialcode = CacheData(37, 0): passedcode = CacheData(38, 0) : PreviewSetting = CacheData(39, 0)
        ThisEdition = "免費(fèi)版 (Free Edition)"
        Version = "Powered by：<a href=""http://www.newasp.net"" target=""_blank""  class=""navmenu"">NewCloud SiteManageSystem Version 2.0.0 SP1</a>"
        CopyrightStr = "<!--" & vbCrLf
        CopyrightStr = CopyrightStr & "┌─────────────────NEWASP──┐" & vbCrLf
        CopyrightStr = CopyrightStr & "│NewCloud SiteManageSystem Version 2.0.0 SP1 │" & vbCrLf
        CopyrightStr = CopyrightStr & "│版權(quán)所有: 新云網(wǎng)絡(luò) (newasp.net)             │" & vbCrLf
        CopyrightStr = CopyrightStr & "│官方主頁(yè): http://www.newasp.net             │" & vbCrLf
        CopyrightStr = CopyrightStr & "│論壇地址: http://bbs.newasp.net             │" & vbCrLf
        CopyrightStr = CopyrightStr & "│E-Mail:   webenvoy@163.com  QQ: 94022511    │" & vbCrLf
        CopyrightStr = CopyrightStr & "└────────────────────.NET┘" & vbCrLf
        CopyrightStr = CopyrightStr & "-->" & vbCrLf
        If CInt(IstopSite) = 1 And Not Admin_Page Then Response.Redirect ("" & SiteUrl & InstallDir & "showerr.asp?action=stop")
    End Sub
    Public Sub ReloadConfig()
        Dim SQL, Rs
        On Error Resume Next
        SQL = "SELECT * from [NC_Config] "
        Set Rs = Execute(SQL)
        Value = Rs.GetRows(1)
        Set Rs = Nothing
    End Sub
    '=============================================================
    '過程名：ReloadChannel
    '作  用：再裝頻道設(shè)置
    '參  數(shù)：ChannelID   ----頻道ID
    '=============================================================
    Private Sub ReloadChannel(ChannelID)
        Dim SQL, Rs
        On Error Resume Next
        SQL = "SELECT ChannelID,ChannelName,ChannelDir,StopChannel,ChannelType,modules,ModuleName,BindDomain,DomainName,ChannelSkin,HtmlPath,HtmlForm,IsCreateHtml,HtmlExtName,HtmlPrefix,StopUpload,MaxFileSize,UpFileType,IsAuditing,AppearGrade,PostGrade,LeastString,MaxString,PaginalNum,LeastHotHist,Channel_Setting from NC_Channel where ChannelType <= 1 And ChannelID = " & CLng(ChannelID)
        Set Rs = Execute(SQL)
        If Rs.BOF And Rs.EOF Then
            Response.Write "錯(cuò)誤的頻道參數(shù)！"
            Exit Sub
        End If
        Value = Rs.GetRows(1)
        Set Rs = Nothing
    End Sub
    '=============================================================
    '過程名：ReadChannel
    '作  用：讀取頻道設(shè)置
    '參  數(shù)：ChannelID   ----頻道ID
    '=============================================================
    Public Sub ReadChannel(ChannelID)
        On Error Resume Next
        If Not IsNumeric(ChannelID) Then ChannelID = 1
        ChannelID = Clng(ChannelID)
        Name = "Channel" & ChannelID
        If ObjIsEmpty() Then Call ReloadChannel(ChannelID)
        CacheChannel = Value
        If CLng(CacheChannel(0, 0)) <> ChannelID Then
            Call ReloadChannel(ChannelID)
            CacheChannel = Value
        End If
        ChannelName = CacheChannel(1, 0): ChannelDir = CacheChannel(2, 0): StopChannel = CacheChannel(3, 0): ChannelType = CacheChannel(4, 0): modules = CacheChannel(5, 0): ModuleName = CacheChannel(6, 0): BindDomain = CacheChannel(7, 0): DomainName = CacheChannel(8, 0): ChannelSkin = CacheChannel(9, 0): HtmlPath = CacheChannel(10, 0)
        HtmlForm = CacheChannel(11, 0): IsCreateHtml = CacheChannel(12, 0): HtmlExtName = CacheChannel(13, 0): HtmlPrefix = CacheChannel(14, 0): StopUpload = CacheChannel(15, 0): MaxFileSize = CacheChannel(16, 0): UpFileType = CacheChannel(17, 0): IsAuditing = CacheChannel(18, 0): AppearGrade = CacheChannel(19, 0)
        PostGrade = CacheChannel(20, 0): LeastString = CacheChannel(21, 0): MaxString = CacheChannel(22, 0): PaginalNum = CacheChannel(23, 0): LeastHotHist = CacheChannel(24, 0): Channel_Setting = CacheChannel(25, 0)
        If CInt(StopChannel) = 1 And Not Admin_Page Then Response.Redirect (InstallDir & "showerr.asp?action=ChanStop")
    End Sub
    Public Sub LoadChannel(chanid)
        On Error Resume Next
        Dim Rs,SQL,tmpdata
        chanid = CLng(chanid)
        Name = "MyChannel" & chanid
        If ObjIsEmpty() Then
            SQL = "SELECT ChannelName,ChannelDir,ModuleName,HtmlPath,HtmlForm,IsCreateHtml,HtmlExtName,HtmlPrefix,StopUpload,LeastString,MaxString,LeastHotHist FROM NC_Channel WHERE ChannelType<=1 And ChannelID= " & Clng(chanid)
            Set Rs = Execute(SQL)
            tmpdata = Rs.GetString(, , "|||", "@@@", "")
            tmpdata = Left(tmpdata, Len(tmpdata) - 3)
            Set Rs = Nothing
            Value = tmpdata
        End If

        ChannelData = Split(Value, "|||")
        ChannelPath = InstallDir & ChannelData(1)
        ChannelModule = ChannelData(2)
        ChannelHtmlPath = ChannelData(3)
        ChannelHtmlForm = ChannelData(4)
        ChannelUseHtml = ChannelData(5)
        ChannelHtmlExt = ChannelData(6)
        ChannelPrefix = ChannelData(7)

    End Sub
    '=============================================================
    '過程名：LoadTemplates
    '作  用：載入模板
    '參  數(shù)：Page_Mark   ----StyleID
    '=============================================================
    Public Sub LoadTemplates(ChannelID, pageid, StyleID)
        Dim rstmp, TempSkinID
        On Error Resume Next
        ChannelID = CLng(ChannelID)
        pageid = CInt(pageid)
        Name = "DefaultSkinID"
        If ObjIsEmpty() Then
            Set rstmp = Execute("SELECT skinid from [NC_Template] where pageid = 0 And isDefault = 1")
            Value = rstmp(0)
            Set rstmp = Nothing
        End If
        TempSkinID = Value
        If StyleID = 0 Or StyleID = "" Then
            skinid = TempSkinID
        Else
            Set rstmp = Execute("SELECT skinid from [NC_Template] where pageid = 0 And skinid = " & StyleID)
            If Not rstmp.EOF Then
                skinid = rstmp(0)
            Else
                skinid = TempSkinID
            End If
            Set rstmp = Nothing
        End If
        skinid = CLng(skinid)
        Name = "MainStyle" & skinid
        If ObjIsEmpty() Then TemplatesMainCache (skinid)
        Main_Style = Value
        SkinPath = Main_Style(0, 0)
        Main_Setting = Split(Main_Style(2, 0), "|||")
        MainStyle = Main_Style(1, 0)
        'MainStyle = Replace(MainStyle, "{$InstallDir}", ReadInstallDir(BindDomain))
        MainStyle = Replace(MainStyle, "{$SkinPath}", SkinPath)
        MainStyle = Split(MainStyle, "|||")
        HtmlCss = MainStyle(0)
        HtmlTop = MainStyle(1)
        HtmlFoot = MainStyle(2)
        If pageid <> 0 Then
            Name = "Templates" & ChannelID & skinid & pageid
            If ObjIsEmpty() Then
                TemplatesToCache ChannelID, pageid
            End If
            ByValue = Value
        End If
    End Sub
    Private Sub TemplatesToCache(ChannelID, pageid)
        On Error Resume Next
        Dim Rs, SQL, rstmp
        SQL = "SELECT skinid,page_content,page_setting FROM [NC_Template] WHERE ChannelID = " & ChannelID & " And skinid = " & skinid & " And pageid = " & pageid
        Set Rs = Execute(SQL)
        If Not Rs.EOF Then
            Value = Rs.GetRows(1)
        Else
            Set rstmp = Execute("SELECT skinid,page_content,page_setting FROM [NC_Template] WHERE ChannelID = " & ChannelID & " And isDefault = 1 And pageid = " & pageid)
            Value = rstmp.GetRows(1)
            Set rstmp = Nothing
        End If
        Set Rs = Nothing
    End Sub
    Private Sub TemplatesMainCache(skinid)
        On Error Resume Next
        Dim Rs, SQL, rstmp
        SQL = "SELECT TemplateDir,page_content,page_setting FROM [NC_Template] WHERE pageid = 0 And skinid = " & skinid & " And ChannelID = 0"
        Set Rs = Execute(SQL)
        If Not Rs.EOF Then
            Value = Rs.GetRows(1)
        Else
            Set rstmp = Execute("SELECT TemplateDir,page_content,page_setting from [NC_Template] WHERE pageid = 0 And isDefault = 1 And ChannelID = 0")
            Value = rstmp.GetRows(1)
            Set rstmp = Nothing
        End If
        Set Rs = Nothing
    End Sub
    Public Property Let ByValue(ByVal vNewValue)
        Dim tmpstr
        tmpstr = vNewValue
        Html_Setting = tmpstr(2, 0)
        Html_Setting = Split(Html_Setting, "|||")
        HtmlContent = tmpstr(1, 0)
        If CInt(Html_Setting(0)) <> 0 Then
            HtmlContent = HtmlTop & HtmlContent & HtmlFoot
        End If
        HtmlContent = Replace(HtmlContent, "{$Style_CSS}", HtmlCss)
        HtmlContent = Replace(HtmlContent, "{$SkinPath}", SkinPath)
        HtmlContent = Replace(HtmlContent, "{$Width}", Main_Setting(0))
        HtmlContent = Replace(HtmlContent, "{$ChannelMenu}", ChannelMenu)
        HtmlContent = Replace(HtmlContent, "{$WebSiteName}", SiteName)
        HtmlContent = Replace(HtmlContent, "{$WebSiteUrl}", SiteUrl)
        HtmlContent = Replace(HtmlContent, "{$MasterMail}", MasterMail)
        HtmlContent = Replace(HtmlContent, "{$Keyword}", keywords)
        HtmlContent = Replace(HtmlContent, "{$Copyright}", Copyright)
        HtmlContent = Replace(HtmlContent, "{$IndexName}", IndexName)
        HtmlContent = Replace(HtmlContent, "{$Version}", "")
        HtmlContent = HtmlContent
    End Property
    Public Property Get ByValue()
        ByValue = HtmlContent
    End Property
    Public Property Let HTMLValue(ByVal vNewValue)
        Dim TempStr
        TempStr = vNewValue
        TempStr = Replace(TempStr, "{$Style_CSS}", HtmlCss)
        TempStr = Replace(TempStr, "{$SkinPath}", SkinPath)
        TempStr = Replace(TempStr, "{$Width}", Main_Setting(0))
        TempStr = Replace(TempStr, "{$ChannelMenu}", ChannelMenu)
        TempStr = Replace(TempStr, "{$WebSiteName}", SiteName)
        TempStr = Replace(TempStr, "{$WebSiteUrl}", SiteUrl)
        TempStr = Replace(TempStr, "{$MasterMail}", MasterMail)
        TempStr = Replace(TempStr, "{$Keyword}", keywords)
        TempStr = Replace(TempStr, "{$Copyright}", Copyright)
        TempStr = Replace(TempStr, "{$IndexName}", IndexName)
        TempStr = Replace(TempStr, "{$Version}", "")
        sHtmlContent = TempStr
    End Property
    Public Property Get HTMLValue()
        HTMLValue = sHtmlContent
    End Property
    Public Property Get HtmlSetting(n)
        HtmlSetting = Html_Setting(n)
    End Property
    Public Property Get MainSetting(n)
        MainSetting = Main_Setting(n)
    End Property
    '================================================
    '過程名：GetSiteUrl
    '作  用：取得帶端口的URL
    '================================================
    Public Property Get GetSiteUrl()
        If Request.ServerVariables("SERVER_PORT") = "80" Then
            GetSiteUrl = "http://" & Request.ServerVariables("server_name")
        Else
            GetSiteUrl = "http://" & Request.ServerVariables("server_name") & ":" & Request.ServerVariables("SERVER_PORT")
        End If
    End Property
    '================================================
    '函數(shù)名：FormEncode
    '作  用：過慮提交的表單數(shù)據(jù)
    '參  數(shù)：str ----原字符串  n ----字符長(zhǎng)度
    '================================================
    Public Function FormEncode(ByVal str, ByVal n)
        If Not IsNull(str) And Trim(str) <> "" Then
            str = Left(str, n)
            str = Replace(str, ">", "&gt;")
            str = Replace(str, "<", "&lt;")
            str = Replace(str, "&#62;", "&gt;")
            str = Replace(str, "&#60;", "&lt;")
            str = Replace(str, "'", "&#39;")
            str = Replace(str, Chr(34), "&quot;")
            str = Replace(str, "%", "％")
            str = Replace(str, vbNewLine, "")
            FormEncode = Trim(str)
        Else
            FormEncode = ""
        End If
    End Function
    '================================================
    '函數(shù)名：ChkKeyWord
    '作  用：過濾關(guān)鍵字
    '參  數(shù)：keyword ----關(guān)鍵字
    '================================================
    Public Function ChkKeyWord(ByVal keyword)
        Dim FobWords, i
        On Error Resume Next
        FobWords = Array(91, 92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65339, 65340)
        For i = 1 To UBound(FobWords, 1)
            If InStr(keyword, ChrW(FobWords(i))) > 0 Then
                keyword = Replace(keyword, ChrW(FobWords(i)), "")
            End If
        Next
        keyword = Left(keyword, 100)
        FobWords = Array("~", "!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "_", "+", "=", "`", "[", "]", "{", "}", ";", ":", """", "'", ",", "<", ">", ".", "/", "\", "?", "_")
        For i = 0 To UBound(FobWords, 1)
            If InStr(keyword, FobWords(i)) > 0 Then
                keyword = Replace(keyword, FobWords(i), "")
            End If
        Next
        ChkKeyWord = keyword
    End Function
    '================================================
    '函數(shù)名：JAPEncode
    '作  用：日文片假名編碼
    '參  數(shù)：str ----原字符
    '================================================
    Public Function JAPEncode(ByVal str)
        Dim FobWords, i
        On Error Resume Next
        If IsNull(str) Or Trim(str) = "" Then
            JAPEncode = ""
            Exit Function
        End If
        FobWords = Array(92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65340)
        For i = 1 To UBound(FobWords, 1)
            If InStr(str, ChrW(FobWords(i))) > 0 Then
                str = Replace(str, ChrW(FobWords(i)), "&#" & FobWords(i) & ";")
            End If
        Next
        JAPEncode = str
    End Function
    '================================================
    '函數(shù)名：JAPUncode
    '作  用：日文片假名解碼
    '參  數(shù)：str ----原字符
    '================================================
    Public Function JAPUncode(ByVal str)
        Dim FobWords, i
        On Error Resume Next
        If IsNull(str) Or Trim(str) = "" Then
            JAPUncode = ""
            Exit Function
        End If
        FobWords = Array(92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65340)
        For i = 1 To UBound(FobWords, 1)
            If InStr(str, "&#" & FobWords(i) & ";") > 0 Then
                str = Replace(str, "&#" & FobWords(i) & ";", ChrW(FobWords(i)))
            End If
        Next
        str = Replace(str, Chr(0), "")
        str = Replace(str, "'", "''")
        JAPUncode = str
    End Function
    '=============================================================
    '函數(shù)作用：帶臟話過濾
    '=============================================================
    Public Function ChkBadWords(ByVal str)
        If IsNull(str) Then Exit Function
        Dim i, Bwords, Bwordr
        Bwords = Split(Badwords, "|")
        Bwordr = Split(Badwordr, "|")
        For i = 0 To UBound(Bwords)
            If i > UBound(Bwordr) Then
                str = Replace(str, Bwords(i), "*")
            Else
                str = Replace(str, Bwords(i), Bwordr(i))
            End If
        Next
        ChkBadWords = str
    End Function
    '=============================================================
    '函數(shù)作用：過濾HTML代碼，帶臟話過濾
    '=============================================================
    Public Function HTMLEncode(ByVal fString)
        If Not IsNull(fString) Then
            fString = Replace(fString, ">", "&gt;")
            fString = Replace(fString, "<", "&lt;")
            fString = Replace(fString, Chr(32), " ")
            fString = Replace(fString, Chr(9), " ")
            fString = Replace(fString, Chr(34), "&quot;")
            fString = Replace(fString, Chr(39), "&#39;")
            fString = Replace(fString, Chr(13), "")
            fString = Replace(fString, " ", "&nbsp;")
            fString = Replace(fString, Chr(10), "<br /> ")
            fString = ChkBadWords(fString)
            HTMLEncode = fString
        End If
    End Function
    '=============================================================
    '函數(shù)作用：過濾HTML代碼，不帶臟話過濾
    '=============================================================
    Public Function HTMLEncodes(ByVal fString)
        If Not IsNull(fString) Then
            fString = Replace(fString, "'", "&#39;")
            fString = Replace(fString, ">", "&gt;")
            fString = Replace(fString, "<", "&lt;")
            fString = Replace(fString, Chr(32), " ")
            fString = Replace(fString, Chr(9), " ")
            fString = Replace(fString, Chr(34), "&quot;")
            fString = Replace(fString, Chr(39), "&#39;")
            fString = Replace(fString, Chr(13), "")
            fString = Replace(fString, Chr(10), "<br /> ")
            fString = Replace(fString, " ", "&nbsp;")
            HTMLEncodes = fString
        End If
    End Function
    '=============================================================
    '函數(shù)作用：判斷發(fā)言是否來自外部
    '=============================================================
    Public Function CheckPost()
        On Error Resume Next
        Dim server_v1, server_v2
        CheckPost = 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
            CheckPost = True
        End If
    End Function
    '=============================================================
    '函數(shù)作用：判斷來源URL是否來自外部
    '=============================================================
    Public Function CheckOuterUrl()
        On Error Resume Next
        Dim server_v1, server_v2
        server_v1 = Replace(LCase(Trim(Request.ServerVariables("HTTP_REFERER"))), "http://", "")
        server_v2 = LCase(Trim(Request.ServerVariables("SERVER_NAME")))
        If server_v1 <> "" And Left(server_v1, Len(server_v2)) <> server_v2 Then
            CheckOuterUrl = False
        Else
            CheckOuterUrl = True
        End If
    End Function
    '================================================
    '函數(shù)名：GotTopic
    '作  用：顯示字符串長(zhǎng)度
    '參  數(shù)：str   ----原字符串
    '        strlen  ----顯示字符長(zhǎng)度
    '================================================
    Public Function GotTopic(ByVal str, ByVal strLen)
        Dim l, t, c, i
        Dim strTemp
        On Error Resume Next
        str = Trim(str)
        str = Replace(str, "&nbsp;", " ")
        str = Replace(str, "&gt;", ">")
        str = Replace(str, "&lt;", "<")
        str = Replace(str, "&#62;", ">")
        str = Replace(str, "&#60;", "<")
        str = Replace(str, "&#39;", "'")
        str = Replace(str, "&quot;", Chr(34))
        str = Replace(str, vbNewLine, "")
        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
                strTemp = Left(str, i) & "..."
                Exit For
            Else
                strTemp = str & " "
            End If
        Next
        GotTopic = CheckTopic(strTemp)
    End Function
    Public Function CheckTopic(ByVal strContent)
        Dim re
        On Error Resume Next
        Set re = New RegExp
        re.IgnoreCase = True
        re.Global = True
        re.Pattern = "(<s+cript(.+?)<\/s+cript>)"
        strContent = re.Replace(strContent, "")
        re.Pattern = "(<iframe(.+?)<\/iframe>)"
        strContent = re.Replace(strContent, "")
        re.Pattern = "(&#62;)"
        strContent = re.Replace(strContent, "&gt;")
        re.Pattern = "(&#60;)"
        strContent = re.Replace(strContent, "&lt;")
        Set re = Nothing
        strContent = Replace(strContent, ">", "&gt;")
        strContent = Replace(strContent, "<", "&lt;")
        strContent = Replace(strContent, "'", "&#39;")
        strContent = Replace(strContent, Chr(34), "&quot;")
        strContent = Replace(strContent, "%", "％")
        strContent = Replace(strContent, vbNewLine, "")
        CheckTopic = Trim(strContent)
    End Function
    '================================================
    '函數(shù)名：ReadTopic
    '作  用：顯示字符串長(zhǎng)度
    '參  數(shù)：str   ----原字符串
    '        strlen  ----顯示字符長(zhǎng)度
    '================================================
    Public Function ReadTopic(ByVal str, ByVal strLen)
        Dim l, t, c, i
        On Error Resume Next
        str = Replace(str, "&nbsp;", " ")
        If Len(str) < strLen Then
            str = str & String(strLen - Len(str), ".")
        Else
            str = str
        End If
        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
                ReadTopic = Left(str, i) & "..."
                Exit For
            Else
                ReadTopic = str & "..."
            End If
        Next
    End Function
    '================================================
    '函數(shù)名：strLength
    '作  用：計(jì)字符串長(zhǎng)度
    '參  數(shù)：str   ----字符串
    '================================================
    Public Function strLength(ByVal str)
        On Error Resume Next
        If IsNull(str) Or str = "" Then
            strLength = 0
            Exit Function
        End If
        Dim WINNT_CHINESE
        WINNT_CHINESE = (Len("例子") = 2)
        If WINNT_CHINESE Then
            Dim l, t
            Dim i, c
            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
            strLength = t
        Else
            strLength = Len(str)
        End If
    End Function
    '=================================================
    '函數(shù)名：isInteger
    '作  用：判斷數(shù)字是否整型
    '參  數(shù)：para ----參數(shù)
    '=================================================
    Public Function isInteger(ByVal 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
    Public Function CutString(ByVal str, ByVal strLen)
        On Error Resume Next

        Dim HtmlStr, l, re, strContent

        HtmlStr = str
        HtmlStr = Replace(HtmlStr, "&nbsp;", " ")
        HtmlStr = Replace(HtmlStr, "&quot;", Chr(34))
        HtmlStr = Replace(HtmlStr, "&#39;", Chr(39))
        HtmlStr = Replace(HtmlStr, "&#123;", Chr(123))
        HtmlStr = Replace(HtmlStr, "&#125;", Chr(125))
        HtmlStr = Replace(HtmlStr, "&#36;", Chr(36))
        HtmlStr = Replace(HtmlStr, vbCrLf, "")
        HtmlStr = Replace(HtmlStr, "====", "")
        HtmlStr = Replace(HtmlStr, "----", "")
        HtmlStr = Replace(HtmlStr, "http:////", "")
        HtmlStr = Replace(HtmlStr, "\\\\", "")
        HtmlStr = Replace(HtmlStr, "####", "")
        HtmlStr = Replace(HtmlStr, "@@@@", "")
        HtmlStr = Replace(HtmlStr, "****", "")
        HtmlStr = Replace(HtmlStr, "~~~~", "")
        Set re = New RegExp
        re.IgnoreCase = True
        re.Global = True
        re.Pattern = "\[br\]"
        HtmlStr = re.Replace(HtmlStr, "")
        re.Pattern = "\[align=right\](.*)\[\/align\]"
        HtmlStr = re.Replace(HtmlStr, "")
        re.Pattern = "<(.[^>]*)>"
        HtmlStr = re.Replace(HtmlStr, "")
        Set re = Nothing
        HtmlStr = Replace(HtmlStr, "&gt;", ">")
        HtmlStr = Replace(HtmlStr, "&lt;", "<")
        l = Len(HtmlStr)
        If l >= strLen Then
            strContent = Left(HtmlStr, strLen) & "..."
        Else
            strContent = HtmlStr & " "
        End If
        strContent = Replace(strContent, Chr(34), "&quot;")
        strContent = Replace(strContent, Chr(39), "&#39;")
        strContent = Replace(strContent, Chr(36), "&#36;")
        strContent = Replace(strContent, Chr(123), "&#123;")
        strContent = Replace(strContent, Chr(125), "&#125;")
        strContent = Replace(strContent, ">", "&gt;")
        strContent = Replace(strContent, "<", "&lt;")
        CutString = strContent
    End Function
    '================================================
    '函數(shù)名：CheckInfuse
    '作  用：防止SQL注入
    '參  數(shù)：str   ----原字符串
    '        strLen  ----提交字符串長(zhǎng)度
    '================================================
    Public Function CheckInfuse(ByVal str, ByVal strLen)
        Dim strUnsafe, arrUnsafe
        Dim i

        If Trim(str) = "" Then
            CheckInfuse = ""
            Exit Function
        End If
        str = Left(str, strLen)

        On Error Resume Next
        strUnsafe = "'|^|;|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"
        If Trim(str) <> "" Then
            If Len(str) > strLen Then
                Response.Write "<Script Language=JavaScript>alert('安全系統(tǒng)提示↓\n\n您提交的字符數(shù)超過了限制！');history.back(-1)</Script>"
                CheckInfuse = ""
                Response.End
            End If
            arrUnsafe = Split(strUnsafe, "|")
            For i = 0 To UBound(arrUnsafe)
                If InStr(1, str, arrUnsafe(i), 1) > 0 Then
                    Response.Write "<Script Language=JavaScript>alert('安全系統(tǒng)提示↓\n\n請(qǐng)不要在參數(shù)中包含非法字符！');history.back(-1)</Script>"
                    CheckInfuse = ""
                    Response.End
                End If
            Next
        End If
        CheckInfuse = Trim(str)
        Exit Function
        If Err.Number <> 0 Then
            Err.Clear
            Response.Write "<Script Language=JavaScript>alert('安全系統(tǒng)提示↓\n\n請(qǐng)不要在參數(shù)中包含非法字符！');history.back(-1)</Script>"
            CheckInfuse = ""
            Response.End
        End If
    End Function
    Public Sub PreventInfuse()
        On Error Resume Next
        Dim SQL_Nonlicet, arrNonlicet
        Dim PostRefer, GetRefer, Sql_DATA

        SQL_Nonlicet = "'|;|^|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"
        arrNonlicet = Split(SQL_Nonlicet, "|")
        If Request.Form <> "" Then
            For Each PostRefer In Request.Form
                For Sql_DATA = 0 To UBound(arrNonlicet)
                    If InStr(1, Request.Form(PostRefer), arrNonlicet(Sql_DATA), 1) > 0 Then
                    Response.Write "<Script Language=JavaScript>alert('安全系統(tǒng)提示↓\n\n請(qǐng)不要在參數(shù)中包含非法字符！');history.back(-1)</Script>"
                    Response.End
                    End If
                Next
            Next
        End If

        If Request.QueryString <> "" Then
            For Each GetRefer In Request.QueryString
                For Sql_DATA = 0 To UBound(arrNonlicet)
                    If InStr(1, Request.QueryString(GetRefer), arrNonlicet(Sql_DATA), 1) > 0 Then
                    Response.Write "<Script Language=JavaScript>alert('安全系統(tǒng)提示↓\n\n請(qǐng)不要在參數(shù)中包含非法字符！');history.back(-1)</Script>"
                    Response.End
                    End If
                Next
            Next
        End If
    End Sub
    '================================================
    '函數(shù)名：ChkQueryStr
    '作  用：過慮查詢的非法字符
    '參  數(shù)：str   ----原字符串
    '返回值：過濾后的字符
    '================================================
    Public Function ChkQueryStr(ByVal str)
        On Error Resume Next
        If IsNull(str) Then
            ChkQueryStr = ""
            Exit Function
        End If
        str = Replace(str, "!", "")
        str = Replace(str, "]", "")
        str = Replace(str, "[", "")
        str = Replace(str, ")", "")
        str = Replace(str, "(", "")
        str = Replace(str, "|", "")
        str = Replace(str, "+", "")
        str = Replace(str, "=", "")
        str = Replace(str, "'", "''")
        str = Replace(str, "%", "")
        str = Replace(str, "&", "")
        str = Replace(str, "#", "")
        str = Replace(str, "^", "")
        str = Replace(str, "&nbsp;", " ")
        str = Replace(str, Chr(37), "")
        str = Replace(str, Chr(0), "")
        ChkQueryStr = str
    End Function
    '================================================
    '過程名：CheckQuery
    '作  用：限制搜索的關(guān)鍵字
    '參  數(shù)：str ----搜索的字符串
    '返回值：True; False
    '================================================
    Public Function CheckQuery(ByVal str)
        Dim FobWords, i, keyword
        keyword = str
        On Error Resume Next
        FobWords = Array(91, 92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12532, 12533, 65339, 65340)
        For i = 1 To UBound(FobWords, 1)
            If InStr(keyword, ChrW(FobWords(i))) > 0 Then
                CheckQuery = False
                Exit Function
            End If
        Next
        FobWords = Array("~", "!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "_", "+", "=", "`", "[", "]", "{", "}", ";", ":", """", "'", "<", ">", ".", "/", "\", "|", "?", "about", "after", "all", "also", "an", "and", "another", "any", "are", "as", "at", "be", "because", "been", "before", "being", "between", "both", "but", "by", "came", "can", "come", "could", "did", "do", "each", "for", "from", "get", "got", "had", "has", "have", "he", "her", "here", "him", "himself", "his", "how", "if", "in", "into", "is", "it", "like", "make", "many", "me", "might", "more", "most", "much", "must", "my", "never", "now", "of", "on", "only", "or", "other", "our", "out", "over", "said", "same", "see", "should", "since", "some", "still", "such", "take", "than", "that", "the", "their", "them", "then", "there", "these", "they", "this")
        keyword = Left(keyword, 100)
        keyword = Replace(keyword, "!", " ")
        keyword = Replace(keyword, "]", " ")
        keyword = Replace(keyword, "[", " ")
        keyword = Replace(keyword, ")", " ")
        keyword = Replace(keyword, "(", " ")
        keyword = Replace(keyword, "　", " ")
        keyword = Replace(keyword, "-", " ")
        keyword = Replace(keyword, "/", " ")
        keyword = Replace(keyword, "+", " ")
        keyword = Replace(keyword, "=", " ")
        keyword = Replace(keyword, ",", " ")
        keyword = Replace(keyword, "'", " ")
        For i = 0 To UBound(FobWords, 1)
            If keyword = FobWords(i) Then
                CheckQuery = False
                Exit Function
            End If
        Next
        CheckQuery = True
    End Function
    '================================================
    '函數(shù)名：IsValidStr
    '作  用：判斷字符串中是否含有非法字符
    '參  數(shù)：str   ----原字符串
    '返回值：False,True -----布爾值
    '================================================
    Public Function IsValidStr(ByVal str)
        IsValidStr = False
        On Error Resume Next
        If IsNull(str) Then Exit Function
        If Trim(str) = Empty Then Exit Function
        Dim ForbidStr, i
        ForbidStr = "and|chr|:|=|%|&|$|#|@|+|-|*|/|\|<|>|;|,|^|" & Chr(32) & "|" & Chr(34) & "|" & Chr(39) & "|" & Chr(9)
        ForbidStr = Split(ForbidStr, "|")
        For i = 0 To UBound(ForbidStr)
            If InStr(1,str, ForbidStr(i),1) > 0 Then
                IsValidStr = False
                Exit Function
            End If
        Next
        IsValidStr = True
    End Function
    '================================================
    '函數(shù)名：IsValidPassword
    '作  用：判斷密碼中是否含有非法字符
    '參  數(shù)：str   ----原字符串
    '返回值：False,True -----布爾值
    '================================================
    Public Function IsValidPassword(ByVal str)
        IsValidPassword = False
        On Error Resume Next
        If IsNull(str) Then Exit Function
        If Trim(str) = Empty Then Exit Function
        Dim ForbidStr, i
        ForbidStr = "=and|chr|*|^|%|&|;|,|" & Chr(32) & "|" & Chr(34) & "|" & Chr(39) & "|" & Chr(9)
        ForbidStr = Split(ForbidStr, "|")
        For i = 0 To UBound(ForbidStr)
            If InStr(1, str, ForbidStr(i), 1) > 0 Then
                IsValidPassword = False
                Exit Function
            End If
        Next
        IsValidPassword = True
    End Function
    '================================================
    '函數(shù)名：IsValidChar
    '作  用：判斷字符串中是否含有非法字符和中文
    '參  數(shù)：str   ----原字符串
    '返回值：False,True -----布爾值
    '================================================
    Public Function IsValidChar(ByVal str)
        IsValidChar = False
        On Error Resume Next

        If IsNull(str) Then Exit Function
        If Trim(str) = Empty Then Exit Function
        Dim ValidStr
        Dim i, l, s, c

        ValidStr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ.-_:~\/0123456789"
        l = Len(str)
        s = UCase(str)
        For i = 1 To l
            c = Mid(s, i, 1)
            If InStr(ValidStr, c) = 0 Then
                IsValidChar = False
                Exit Function
            End If
        Next
        IsValidChar = True
    End Function
    '================================================
    '函數(shù)名：FormatDate
    '作  用：格式化日期
    '參  數(shù)：DateAndTime   ----原日期和時(shí)間
    '        para   ----日期格式
    '返回值：格式化后的日期
    '================================================
    Public Function FormatDate(DateAndTime, para)
        On Error Resume Next
        Dim y, m, d, h, mi, s, strDateTime
        FormatDate = DateAndTime
        If Not IsNumeric(para) Then Exit Function
        If Not IsDate(DateAndTime) Then Exit Function
        y = CStr(Year(DateAndTime))
        m = CStr(Month(DateAndTime))
        If Len(m) = 1 Then m = "0" & m
        d = CStr(Day(DateAndTime))
        If Len(d) = 1 Then d = "0" & d
        h = CStr(Hour(DateAndTime))
        If Len(h) = 1 Then h = "0" & h
        mi = CStr(Minute(DateAndTime))
        If Len(mi) = 1 Then mi = "0" & mi
        s = CStr(Second(DateAndTime))
        If Len(s) = 1 Then s = "0" & s
        Select Case para
        Case "1"
            strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
        Case "2"
            strDateTime = y & "-" & m & "-" & d
        Case "3"
            strDateTime = y & "/" & m & "/" & d
        Case "4"
            strDateTime = y & "年" & m & "月" & d & "日"
        Case "5"
            strDateTime = m & "-" & d
        Case "6"
            strDateTime = m & "/" & d
        Case "7"
            strDateTime = m & "月" & d & "日"
        Case "8"
            strDateTime = y & "年" & m & "月"
        Case "9"
            strDateTime = y & "-" & m
        Case "10"
            strDateTime = y & "/" & m
        Case Else
            strDateTime = DateAndTime
        End Select
        FormatDate = strDateTime
    End Function
    '================================================
    '函數(shù)名：ReadFontMode
    '作  用：讀取字體模式
    '參  數(shù)：str   ----原字符串
    '        vColor   -----顏色的值
    '        vFont   -----字體的值
    '返回值：新字符串
    '================================================
    Public Function ReadFontMode(str, vColor, vFont)
        Dim FontStr, tColor
        Dim ColorStr, arrColor

        If IsNull(str) Then
            ReadFontMode = ""
            Exit Function
        End If
        ReadFontMode = str
        On Error Resume Next
        If Not IsNumeric(vColor) Then Exit Function
        If Not IsNumeric(vFont) Then Exit Function

        Select Case CInt(vFont)
            Case 1
                FontStr = "<b>" & str & "</b>"
            Case 2
                FontStr = "<em>" & str & "</em>"
            Case 3
                FontStr = "<u>" & str & "</u>"
            Case 4
                FontStr = "<b><em>" & str & "</em></b>"
            Case 5
                FontStr = "<b><u>" & str & "</u></b>"
            Case 6
                FontStr = "<em><u>" & str & "</u></em>"
            Case 7
                FontStr = "<b><em><u>" & str & "</u></em></b>"
        Case Else
            FontStr = str
        End Select
        ReadFontMode = FontStr

        If vColor = "" Or vColor = 0 Then Exit Function
        ColorStr = "," & InitTitleColor
        arrColor = Split(ColorStr, ",")
        If vColor > UBound(arrColor) Then Exit Function
        tColor = Trim(arrColor(vColor))
        ReadFontMode = "<font color=" & tColor & ">" & FontStr & "</font>"
    End Function
    '=============================================================
    '函數(shù)名：ShowDateTime
    '作  用：讀取日期格式
    '參  數(shù)：DateAndTime ---- 當(dāng)前時(shí)間
    '        para ---- 時(shí)間格式
    '=============================================================
    Public Function ShowDateTime(DateAndTime, para)
        ShowDateTime = ""
        Dim strDate
        If Not IsDate(DateAndTime) Then Exit Function
        If DateAndTime >= Date Then
            strDate = "<font color='" & Main_Setting(1) & "'>"
            strDate = strDate & FormatDate(DateAndTime, para)
            strDate = strDate & "</font>"
        Else
            strDate = "<font color='" & Main_Setting(2) & "'>"
            strDate = strDate & FormatDate(DateAndTime, para)
            strDate = strDate & "</font>"
        End If
        ShowDateTime = strDate
    End Function
    Public Function ShowDatePath(strval, n)
        ShowDatePath = ""
        If Trim(strval) = "" Then Exit Function
        Dim strTempPath, strTime
        Dim y, m, d

        strTime = Left(strval, 8)
        y = Left(strTime, 4)
        m = Mid(strTime, 5, 2)
        d = Right(strTime, 2)
        Select Case CInt(n)
            Case 1
                strTempPath = y & "/" & m & "/" & d & "/"
            Case 2
                strTempPath = y & "/" & m & "/"
            Case 3
                strTempPath = y & m & "/"
            Case 4
                strTempPath = y & "/"
            Case 5
                strTempPath = y & "-" & m & "-" & d & "/"
            Case 6
                strTempPath = y & "-" & m & "/"
            Case 7
                strTempPath = "html/"
            Case 8
                strTempPath = "show/"
        Case Else
            strTempPath = ""
        End Select
        strTempPath = Replace(strTempPath, " ", "")
        ShowDatePath = CStr(strTempPath)
    End Function
    '=============================================================
    '函數(shù)名：ReadBriefTopicffd
    '作  用：讀取簡(jiǎn)短標(biāo)題
    '參  數(shù)：para
    '返回值：簡(jiǎn)短標(biāo)題
    '=============================================================
    Public Function ReadBriefTopic(ByVal para)
        Dim sBriefTopic

        ReadBriefTopic = ""
        If Not IsNumeric(para) Then Exit Function
        If para = 0 Then Exit Function
        Select Case para
        Case "1"
            sBriefTopic = "<font color='blue'>[圖文]</font>"
        Case "2"
            sBriefTopic = "<font color='red'>[組圖]</font>"
        Case "3"
            sBriefTopic = "<font color='green'>[新聞]</font>"
        Case "4"
            sBriefTopic = "<font color='blue'>[推薦]</font>"
        Case "5"
            sBriefTopic = "<font color='red'>[注意]</font>"
        Case "6"
            sBriefTopic = "<font color='green'>[轉(zhuǎn)載]</font>"
        Case Else
            sBriefTopic = ""
        End Select
        ReadBriefTopic = sBriefTopic
    End Function
    '=============================================================
    '函數(shù)名：ReadPicTopic
    '作  用：讀取簡(jiǎn)短標(biāo)題
    '參  數(shù)：para
    '返回值：簡(jiǎn)短標(biāo)題
    '=============================================================
    Public Function ReadPicTopic(ByVal para)
        Dim sBriefTopic
        ReadPicTopic = ""
        If Not IsNumeric(para) Then Exit Function
        If para = 0 Then Exit Function
        Select Case para
        Case "1"
            sBriefTopic = "<font color='" & Main_Setting(4) & "'>[圖文]</font>"
        Case "2"
            sBriefTopic = "<font color='" & Main_Setting(5) & "'>[組圖]</font>"
        Case "3"
            sBriefTopic = "<font color='" & Main_Setting(6) & "'>[新聞]</font>"
        Case "4"
            sBriefTopic = "<font color='" & Main_Setting(4) & "'>[推薦]</font>"
        Case "5"
            sBriefTopic = "<font color='" & Main_Setting(5) & "'>[注意]</font>"
        Case "6"
            sBriefTopic = "<font color='" & Main_Setting(6) & "'>[轉(zhuǎn)載]</font>"
        Case Else
            sBriefTopic = ""
        End Select
        ReadPicTopic = sBriefTopic
    End Function
    '=============================================================
    '函數(shù)名：ReadPayMoney
    '作  用：讀取要支付的金錢
    '參  數(shù)：money   ----實(shí)際金錢
    '返回值：加上手續(xù)費(fèi)后的金錢
    '=============================================================
    Public Function ReadPayMoney(ByVal money, ByVal Reduce)
        On Error Resume Next
        If money = 0 Then
            ReadPayMoney = 0
            Exit Function
        End If
        Dim arrChinaeBank, valPercent, Percents

        arrChinaeBank = Split(ChinaeBank, "|||")
        Percents = CCur(arrChinaeBank(2) / 100)

        If Percents = 0 Then
            ReadPayMoney = CCur(money)
        Else
            If CBool(Reduce) = True Then
                valPercent = Round(CCur(money) / (1 + 1 * Percents), 2)
                ReadPayMoney = CCur(valPercent)
            Else
                valPercent = Round(CCur(money) * Percents, 2)
                ReadPayMoney = CCur(money + valPercent)
            End If
        End If
    End Function
    '=============================================================
    '函數(shù)名：RebateMoney
    '作  用：讀取打折的后金錢
    '參  數(shù)：money   ----實(shí)際金錢
    '        Discount   ----折扣
    '=============================================================
    Public Function RebateMoney(ByVal money, ByVal Discount)
        On Error Resume Next
        Dim Rebate

        money = CheckNumeric(money)
        Discount = CheckNumeric(Discount)
        If Discount > 0 And Discount < 10 Then
            Rebate = Round(money * (Discount / 10), 2)
            RebateMoney = CCur(Rebate)
        Else
            RebateMoney = CCur(money)
        End If
    End Function
    '================================================
    '函數(shù)名：Supplemental
    '作  用：補(bǔ)足參數(shù)
    '參  數(shù)：para ----原參數(shù)
    '        n ----增補(bǔ)的位數(shù)
    '================================================
    Public Function Supplemental(para, n)
        Supplemental = ""
        If Not IsNumeric(para) Then Exit Function
        If Len(para) < n Then
            Supplemental = String(n - Len(para), "0") & para
        Else
            Supplemental = para
        End If
    End Function
    '-----------------------------------------------------------------
    Public Function GetChannelDir(ByVal chanid)
        On Error Resume Next
        If Not IsNumeric(chanid) Then chanid = 1
        Name = "Channel" & chanid
        If ObjIsEmpty() Then ReloadChannel (chanid)
        CacheChannel = Value
        GetChannelDir = InstallDir & CacheChannel(2,0)
    End Function

    '================================================
    '函數(shù)名：GetImageUrl
    '作  用：獲取圖片URL
    '================================================
    Public Function GetImageUrl(ByVal url, ByVal ChannelDir)
        On Error Resume Next
        Dim strTempUrl, strImageUrl

        If Not IsNull(url) And Trim(url) <> "" And LCase(url) <> "http://" Then
            strTempUrl = InstallDir & ChannelDir
            If CheckUrl(url) = 1 Then
                strImageUrl = Trim(url)
            ElseIf CheckUrl(url) = 2 Then
                strImageUrl = url
            Else
                strImageUrl = Replace(url, "../", "")
                strImageUrl = Trim(strTempUrl & strImageUrl)
            End If
        Else
            strImageUrl = InstallDir & "images/no_pic.gif"
        End If
        GetImageUrl = strImageUrl
    End Function
    '-----------------------------------------------------------------
    '================================================
    '作  用：讀取圖片或者FLASH
    '參  數(shù)：url ----文件URL
    '        height ----高度
    '        width ----寬度
    '================================================
    Function GetFlashAndPic(ByVal url, ByVal height, ByVal width)
        On Error Resume Next
        Dim sExtName, ExtName, strTemp
        Dim strHeight, strWidth

        If Not IsNumeric(height) Or height < 1 Then
            strHeight = ""
        Else
            strHeight = " height=" & height
        End If
        If Not IsNumeric(width) Or width < 1 Then
            strWidth = ""
        Else
            strWidth = " width=" & width
        End If
        sExtName = Split(url, ".")
        ExtName = sExtName(UBound(sExtName))
        If LCase(ExtName) = "swf" Then
            strTemp = "<embed src=""" & url & """" & strWidth & strHeight & ">"
        Else
            strTemp = "<img src=""" & url & """" & strWidth & strHeight & " border=0>"
        End If
        GetFlashAndPic = strTemp
    End Function
    '================================================
    '函數(shù)名：ReadFileUrl
    '作  用：讀取文件URL
    '================================================
    Public Function ReadFileUrl(url)
        On Error Resume Next
        ReadFileUrl = ""
        If url = "" Then Exit Function
        Dim strTemp
        If CheckUrl(url) = 1 Then
            strTemp = Trim(url)
        ElseIf CheckUrl(url) = 2 Then
            strTemp = Trim(url)
        Else
            strTemp = Replace(url, "../", "")
            strTemp = Trim(InstallDir & strTemp)
        End If
        ReadFileUrl = strTemp
    End Function
    Public Function CheckUrl(ByVal url)
        Dim strUrl
        If Left(url, 1) = "/" Then
            CheckUrl = 1
            Exit Function
        End If
        strUrl = LCase(Left(url, 6))
        Select Case Trim(strUrl)
        Case "http:/", "https:", "ftp://", "rtsp:/", "mms://"
            CheckUrl = 2
            Exit Function
        Case Else
            CheckUrl = 0
        End Select
    End Function
    '================================================
    '函數(shù)名：ReadFileName
    '作  用：讀取HTML文件名
    '參  數(shù)：strname ----文件名稱
    '        id ----數(shù)據(jù)ID
    '        ExtName ----HTML擴(kuò)展名
    '        PrefixStr ----HTML名稱前綴
    '        HtmlForm ----HTML文件格式
    '        n ----HTML分頁(yè)
    '================================================
    Public Function ReadFileName(ByVal strname, ByVal id, ByVal ExtName, ByVal PrefixStr, ByVal HtmlForm, ByVal n)

        Dim strFileName, strExtName, CurrentPage
        If Trim(strname) = "" Then Exit Function
        If Trim(ExtName) = "" Then ExtName = ".html"
        If Not IsNumeric(n) Then n = 0
        On Error Resume Next
        If CInt(n) <= 1 Then
            CurrentPage = ""
        Else
            CurrentPage = "_" & n
        End If
        If Left(ExtName, 1) <> "." Then
            strExtName = "." & Trim(ExtName)
        Else
            strExtName = Trim(ExtName)
        End If
        Select Case Trim(HtmlForm)
            Case "1"
                strFileName = Trim(id)
            Case "2"
                strFileName = Trim(PrefixStr) & Trim(Supplemental(id, 3))
            Case "3"
                strFileName = Left(strname, 8)
                strFileName = strFileName & Trim(Supplemental(id, 3))
            Case "4"
                strFileName = Right(strname, 7)
                strFileName = strFileName & Trim(Supplemental(id, 3))
            Case Else
                strFileName = strname
        End Select
        strFileName = Replace(strFileName & CurrentPage & strExtName, " ", "")
        ReadFileName = CStr(strFileName)
    End Function
    '================================================
    '過程名：HtmlRndFileName
    '作  用：取HTML的隨機(jī)文件名
    '================================================
    Function HtmlRndFileName()
        Dim sRnd
        Randomize
        sRnd = Int(90 * Rnd) + 10
        HtmlRndFileName = Replace(Replace(Replace(FormatDate(Now(), 1), "-", ""), ":", ""), " ", "") & sRnd
    End Function
    '================================================
    '函數(shù)名：ClassFileName
    '作  用：讀取HTML文件列表名
    '參  數(shù)：ClassID ----分類ID
    '================================================
    Public Function ClassFileName(ByVal ClassID, ByVal ExtName, ByVal PrefixStr, ByVal n)
        Dim strFileName, strExtName, strClassID

        If Trim(ExtName) = "" Then ExtName = ".html"
        If Not IsNumeric(n) Then n = 0
        If Left(ExtName, 1) <> "." Then
            strExtName = "." & Trim(ExtName)
        Else
            strExtName = Trim(ExtName)
        End If
        If CInt(n) <= 1 Then
            strFileName = "index" & strExtName
        Else
            strClassID = Supplemental(ClassID, 3)
            strFileName = PrefixStr & strClassID & "_" & n & strExtName
        End If
        strFileName = Replace(strFileName, " ", "")
        ClassFileName = CStr(strFileName)
    End Function
    '================================================
    '函數(shù)名：SpecialFileName
    '作  用：讀取專題HTML文件名
    '參  數(shù)：specid ----專題ID
    '================================================
    Public Function SpecialFileName(ByVal specid, ByVal ExtName, ByVal n)
        Dim strFileName, strExtName, strSpecialID

        If Trim(ExtName) = "" Then ExtName = ".html"
        If Not IsNumeric(n) Then n = 0
        If Left(ExtName, 1) <> "." Then
            strExtName = "." & Trim(ExtName)
        Else
            strExtName = Trim(ExtName)
        End If
        If CInt(n) <= 1 Then
            strFileName = "index" & strExtName
        Else
            strSpecialID = Supplemental(specid, 3)
            strFileName = "Special" & strSpecialID & "_" & n & strExtName
        End If
        strFileName = Replace(strFileName, " ", "")
        SpecialFileName = CStr(strFileName)
    End Function
    '================================================
    '函數(shù)名：ChannelMenu
    '作  用：顯示頻道菜單
    '================================================
    Public Function ChannelMenu()
        Dim SQL, Rs, i, TotalNumber,strTop
        Dim strContent, LinkTarget, ChannelName
        Dim ChannelUrl, HtmlContent, sCaption

        
        Name = "ChannelMenu"
        If ObjIsEmpty() Then
            If ChkNumeric(Main_Setting(7)) = 0 Then
                strTop = vbNullString
            Else
                strTop = "TOP " & CInt(Main_Setting(7))
            End If
            SQL = "SELECT " & strTop & " ChannelID,orders,ColorModes,FontModes,ChannelName,Caption,ChannelDir,StopChannel,IsHidden,BindDomain,DomainName,LinkTarget,ChannelType,ChannelUrl,IsHidden FROM [NC_Channel] WHERE IsHidden = 0 Order By orders"
            Set Rs = Execute(SQL)
            If Rs.BOF And Rs.EOF Then
                strContent = ""
            Else
            i = 0
            TotalNumber = Rs.RecordCount
            Do While Not Rs.EOF
                i = i + 1
                If Rs("LinkTarget") <> 0 Then
                    LinkTarget = " target=""_blank"""
                Else
                    LinkTarget = ""
                End If
                HtmlContent = HtmlContent & Main_Setting(9)
                ChannelName = ReadFontMode(Rs("ChannelName"), Rs("ColorModes"), Rs("FontModes"))
                If Rs("ChannelType") < 2 Then
                    ChannelUrl = InstallDir & Rs("ChannelDir")
                Else
                    ChannelUrl = Rs("ChannelUrl")
                End If
                If Rs("StopChannel") <> 0 Then
                    sCaption = "此頻道暫時(shí)關(guān)閉,不能訪問！"
                Else
                    sCaption = Rs("Caption")
                End If
                strContent = "<a href=""" & ChannelUrl & """" & LinkTarget & " title=""" & sCaption & """ class=navmenu>" & ChannelName & "</a>"
                If i Mod CInt(Main_Setting(8)) = 0 Then strContent = strContent & "<br>"
                HtmlContent = Replace(HtmlContent, "{$ChannelMenu}", strContent)    
            Rs.MoveNext
            Loop
            End If
            Rs.Close: Set Rs = Nothing
            'Value = strContent
        End If
        'strContent = Value

        ChannelMenu = HtmlContent
    End Function
    '=============================================================
    '函數(shù)名：LoadSelectClass
    '作  用：載入緩存下拉分類列表
    '參  數(shù)：ChannelID   ----頻道ID
    '返回值：下拉分類列表
    '=============================================================
    Public Function LoadSelectClass(ChannelID)
        Dim CacheSelClass, SQL, Rs1, i

        Name = "SelectClass" & ChannelID
        If ObjIsEmpty() Then
            SQL = "select ClassID,ClassName,depth,TurnLink,child from NC_Classify where ChannelID = " & ChannelID & " order by rootid,orders"
            Set Rs1 = Execute(SQL)
            If Rs1.BOF And Rs1.EOF Then
                CacheSelClass = CacheSelClass & "<option>沒有添加分類</option>"
            End If
            Do While Not Rs1.EOF
                If Rs1("TurnLink") <> 0 Then
                    CacheSelClass = CacheSelClass & "<option value=""0"""
                Else
                    If Rs1("depth") = 0 And Rs1("child") <> 0 Then
                        CacheSelClass = CacheSelClass & "<option"
                    Else
                        CacheSelClass = CacheSelClass & "<option value=""" & Rs1("ClassID") & """"
                    End If
                End If
                CacheSelClass = CacheSelClass & " {ClassID=" & Rs1("ClassID") & "}>"
                If Rs1("depth") = 1 Then CacheSelClass = CacheSelClass & "　├ "
                If Rs1("depth") > 1 Then
                    For i = 2 To Rs1("depth")
                        CacheSelClass = CacheSelClass & "　"
                    Next
                    CacheSelClass = CacheSelClass & "　├ "
                End If
                CacheSelClass = CacheSelClass & Rs1("ClassName") & "</option>" & vbCrLf
                Rs1.MoveNext
            Loop
            Rs1.Close
            Set Rs1 = Nothing
            Value = CacheSelClass
        End If
        LoadSelectClass = Value
    End Function
    Public Function ClassJumpMenu(ChannelID)
        Dim CacheJumpMenu
        Dim Rs1
        Dim i
        Name = "ClassJumpMenu" & ChannelID
        If ObjIsEmpty() Then
            Set Rs1 = Execute("select ClassID,ChannelID,ClassName,depth,TurnLink,TurnLinkUrl from [NC_Classify] where ChannelID = " & ChannelID & " order by rootid,orders")
            Do While Not Rs1.EOF
                If Rs1("TurnLink") <> 0 Then
                    CacheJumpMenu = CacheJumpMenu & "<option value=""" & Rs1("TurnLinkUrl") & """ {ClassID=" & Rs1("classid") & "}"
                Else
                    CacheJumpMenu = CacheJumpMenu & "<option value=""?ChannelID=" & Rs1("ChannelID") & "&sortid=" & Rs1("classid") & """ {ClassID=" & Rs1("classid") & "}"
                End If
                If Trim(Request("sortid")) <> "" Then
                    If CLng(Request("sortid")) = Rs1("classid") Then CacheJumpMenu = CacheJumpMenu & " selected"
                End If
                CacheJumpMenu = CacheJumpMenu & ">"
                If Rs1("depth") = 1 Then CacheJumpMenu = CacheJumpMenu & "　├ "
                If Rs1("depth") > 1 Then
                    For i = 2 To Rs1("depth")
                        CacheJumpMenu = CacheJumpMenu & "　"
                    Next
                    CacheJumpMenu = CacheJumpMenu & "　├ "
                End If
                CacheJumpMenu = CacheJumpMenu & Rs1("ClassName") & "</option>" & vbCrLf
                Rs1.MoveNext
            Loop
            Rs1.Close
            Set Rs1 = Nothing
            Value = CacheJumpMenu
        End If
        ClassJumpMenu = Value
    End Function
    '================================================
    '函數(shù)名：GetRandomCode
    '作  用：系統(tǒng)分配隨機(jī)代碼
    '================================================
    Public Function GetRandomCode()
        Dim Ran, i, LengthNum

        LengthNum = 16
        GetRandomCode = ""
        For i = 1 To LengthNum
            Randomize
            Ran = CInt(Rnd * 2)
            Randomize
            If Ran = 0 Then
                Ran = CInt(Rnd * 25) + 97
                GetRandomCode = GetRandomCode & UCase(Chr(Ran))
            ElseIf Ran = 1 Then
                Ran = CInt(Rnd * 9)
                GetRandomCode = GetRandomCode & Ran
            ElseIf Ran = 2 Then
                Ran = CInt(Rnd * 25) + 97
                GetRandomCode = GetRandomCode & Chr(Ran)
            End If
        Next
    End Function
    '================================================
    ' 函數(shù)名：CodeIsTrue
    ' 作  用：檢查驗(yàn)證碼是否正確
    '================================================
    Public Function CodeIsTrue()
        Dim CodeStr
        CodeStr = Trim(Request("CodeStr"))
        On Error Resume Next
        If CStr(Session("GetCode")) = CStr(CodeStr) And CodeStr <> "" Then
            CodeIsTrue = True
            Session("GetCode") = Empty
        Else
            CodeIsTrue = False
            Session("GetCode") = Empty
        End If
    End Function
    Public Function CheckAdmin(ByVal Flag)
        Dim Rs, SQL
        Dim i, TempAdmin, AdminFlag, AdminGrade

        CheckAdmin = False
        On Error Resume Next
        SQL = "SELECT AdminGrade,Adminflag FROM NC_Admin WHERE username='" & Replace(Session("AdminName"), "'", "''") & "' And password='" & Replace(Session("AdminPass"), "'", "''") & "' And isLock=0 And id=" & CLng(Session("AdminID"))
        Set Rs = Execute(SQL)
        If Rs.BOF And Rs.EOF Then
            CheckAdmin = False
            Set Rs = Nothing
            Exit Function
        Else
            AdminFlag = Rs("Adminflag")
            AdminGrade = Rs("AdminGrade")
        End If
        Rs.Close: Set Rs = Nothing
        If CInt(AdminGrade) = 999 Then
            CheckAdmin = True
            Exit Function
        Else
            If Trim(Flag) = "" Then Exit Function
            If AdminFlag = "" Then
                CheckAdmin = False
                Exit Function
            Else
                TempAdmin = Split(AdminFlag, ",")
                For i = 0 To UBound(TempAdmin)
                    If Trim(LCase(TempAdmin(i))) = Trim(LCase(Flag)) Then
                        CheckAdmin = True
                        Exit For
                    End If
                Next
            End If
        End If
    End Function
    '================================================
    '函數(shù)名：ReadAlpha
    '作  用：讀取字符串的第一個(gè)字母
    '參  數(shù)：str   ----字符
    '返回值：返回第一個(gè)字母
    '================================================
    Public Function ReadAlpha(ByVal str)
        Dim strTemp
        If IsNull(str) Or Trim(str) = "" Then
            ReadAlpha = "A-9"
            Exit Function
        End If
        str = Trim(str)
        strTemp = 65536 + Asc(str)
        If (strTemp >= 45217 And strTemp <= 45252) Or (strTemp = 65601) Or (strTemp = 65633) Or (strTemp = 37083) Then
            ReadAlpha = "A-Z"
        ElseIf (strTemp >= 45253 And strTemp <= 45760) Or (strTemp = 65602) Or (strTemp = 65634) Or (strTemp = 39658) Then
            ReadAlpha = "B-Z"
        ElseIf (strTemp >= 45761 And strTemp <= 46317) Or (strTemp = 65603) Or (strTemp = 65635) Or (strTemp = 33405) Then
            ReadAlpha = "C-Z"
        ElseIf (strTemp >= 46318 And strTemp <= 46930) Or (strTemp >= 61884 And strTemp <= 61884) Or (strTemp = 65604) Or (strTemp >= 36820 And strTemp <= 38524) Or (strTemp = 65636) Then
            ReadAlpha = "D-Z"
        ElseIf (strTemp >= 46931 And strTemp <= 47009) Or (strTemp = 65605) Or (strTemp = 65637) Or (strTemp = 61513) Then
            ReadAlpha = "E-Z"
        ElseIf (strTemp >= 47010 And strTemp <= 47296) Or (strTemp = 65606) Or (strTemp = 65638) Or (strTemp = 61320) Or (strTemp = 63568) Or (strTemp = 36281) Then
            ReadAlpha = "F-Z"
        ElseIf (strTemp >= 47297 And strTemp <= 47613) Or (strTemp = 65607) Or (strTemp = 65639) Or (strTemp = 35949) Or (strTemp = 36089) Or (strTemp = 36694) Or (strTemp = 34808) Then
            ReadAlpha = "G-Z"
        ElseIf (strTemp >= 47614 And strTemp <= 48118) Or (strTemp >= 59112 And strTemp <= 59112) Or (strTemp = 65608) Or (strTemp = 65640) Then
            ReadAlpha = "H-Z"
        ElseIf (strTemp = 65641) Or (strTemp = 65609) Or (strTemp = 65641) Then
            ReadAlpha = "I-Z"
        ElseIf (strTemp >= 48119 And strTemp <= 49061 And strTemp <> 48739) Or (strTemp >= 62430 And strTemp <= 62430) Or (strTemp = 65610) Or (strTemp = 65642) Or (strTemp = 39048) Then
            ReadAlpha = "J-Z"
        ElseIf (strTemp >= 49062 And strTemp <= 49323) Or (strTemp = 65611) Or (strTemp = 65643) Then
            ReadAlpha = "K-Z"
        ElseIf (strTemp >= 49324 And strTemp <= 49895) Or (strTemp >= 58838 And strTemp <= 58838) Or (strTemp = 65612) Or (strTemp = 65644) Or (strTemp = 62418) Or (strTemp = 48739) Then
            ReadAlpha = "L-Z"
        ElseIf (strTemp >= 49896 And strTemp <= 50370) Or (strTemp = 65613) Or (strTemp = 65645) Then
            ReadAlpha = "M-Z"
        ElseIf (strTemp >= 50371 And strTemp <= 50613) Or (strTemp = 65614) Or (strTemp = 65646) Then
            ReadAlpha = "N-Z"
        ElseIf (strTemp >= 50614 And strTemp <= 50621) Or (strTemp = 65615) Or (strTemp = 65647) Then
            ReadAlpha = "O-Z"
        ElseIf (strTemp >= 50622 And strTemp <= 50905) Or (strTemp = 65616) Or (strTemp = 65648) Then
            ReadAlpha = "P-Z"
        ElseIf (strTemp >= 50906 And strTemp <= 51386) Or (strTemp >= 62659 And strTemp <= 63172) Or (strTemp = 65617) Or (strTemp = 65649) Then
            ReadAlpha = "Q-Z"
        ElseIf (strTemp >= 51387 And strTemp <= 51445) Or (strTemp = 65618) Or (strTemp = 65650) Then
            ReadAlpha = "R-Z"
        ElseIf (strTemp >= 51446 And strTemp <= 52217) Or (strTemp = 65619) Or (strTemp = 65651) Or (strTemp = 34009) Then
            ReadAlpha = "S-Z"
        ElseIf (strTemp >= 52218 And strTemp <= 52697) Or (strTemp = 65620) Or (strTemp = 65652) Then
            ReadAlpha = "T-Z"
        ElseIf (strTemp = 65621) Or (strTemp = 65653) Then
            ReadAlpha = "U-Z"
        ElseIf (strTemp = 65622) Or (strTemp = 65654) Then
            ReadAlpha = "V-Z"
        ElseIf (strTemp >= 52698 And strTemp <= 52979) Or (strTemp = 65623) Or (strTemp = 65655) Then
            ReadAlpha = "W-Z"
        ElseIf (strTemp >= 52980 And strTemp <= 53688) Or (strTemp = 65624) Or (strTemp = 65656) Then
            ReadAlpha = "X-Z"
        ElseIf (strTemp >= 53689 And strTemp <= 54480) Or (strTemp = 65625) Or (strTemp = 65657) Then
            ReadAlpha = "Y-Z"
        ElseIf (strTemp >= 54481 And strTemp <= 62383 And strTemp <> 59112 And strTemp <> 58838) Or (strTemp = 65626) Or (strTemp = 65658) Or (strTemp = 38395) Or (strTemp = 39783) Then
            ReadAlpha = "Z-Z"
        Else
            ReadAlpha = "A-9"
        End If
        If (strTemp >= 65633 And strTemp <= 65658) Or (strTemp >= 65601 And strTemp <= 65626) Then ReadAlpha = UCase(Left(str, 1))
        If (strTemp >= 65584 And strTemp <= 65593) Then ReadAlpha = "0-9"
    End Function
    '-- 修正文件路徑
    Public Function CheckPath(ByVal sPath)
        sPath = Trim(sPath)
        If Right(sPath, 1) <> "\" And sPath <> "" Then
            sPath = sPath & "\"
        End If
        CheckPath = sPath
    End Function
    '-- 生成目錄
    Public Function CreatPathEx(ByVal sPath)
        sPath = Replace(sPath, "/", "\")
        sPath = Replace(sPath, "\\", "\")
        On Error Resume Next

        Dim strHostPath,strPath
        Dim sPathItem,sTempPath
        Dim i,fso

        Set fso = Server.CreateObject(FSO_ScriptName)
        strHostPath = Server.MapPath("/")
        If InStr(sPath, ":") = 0 Then sPath = Server.MapPath(sPath)
        If fso.FolderExists(sPath) Or Len(sPath) < 3 Then
            CreatPathEx = True
            Exit Function
        End If

        strPath = Replace(sPath, strHostPath, vbNullString,1,-1,1)
        sPathItem = Split(strPath, "\")

        If InStr(LCase(sPath), LCase(strHostPath)) = 0 Then
            sTempPath = sPathItem(0)
        Else
            sTempPath = strHostPath
        End If

        For i = 1 To UBound(sPathItem)
            If sPathItem(i) <> "" Then
                sTempPath = sTempPath & "\" & sPathItem(i)
                If fso.FolderExists(sTempPath) = False Then
                    fso.CreateFolder sTempPath
                End If
            End If
        Next
        Set fso = Nothing
        If Err.Number <> 0 Then Err.Clear
        CreatPathEx = True
    End Function
    '================================================
    '函數(shù)名：FilesDelete
    '作  用：FSO刪除文件
    '參  數(shù)：filepath   ----文件路徑
    '返回值：False  ----  True
    '================================================
    Public Function FileDelete(ByVal FilePath)
        On Error Resume Next
        FileDelete = False
        Dim fso
        Set fso = Server.CreateObject(FSO_ScriptName)
        If FilePath = "" Then Exit Function
        If InStr(FilePath, ":") = 0 Then FilePath = Server.MapPath(FilePath)
        If fso.FileExists(FilePath) Then
            fso.DeleteFile FilePath, True
            FileDelete = True
        End If
        Set fso = Nothing
        If Err.Number <> 0 Then Err.Clear
    End Function
    '================================================
    '函數(shù)名：FolderDelete
    '作  用：FSO刪除目錄
    '參  數(shù)：folderpath   ----目錄路徑
    '返回值：False  ----  True
    '================================================
    Public Function FolderDelete(ByVal FolderPath)
        FolderDelete = False
        On Error Resume Next
        Dim fso
        Set fso = Server.CreateObject(FSO_ScriptName)
        If FolderPath = "" Then Exit Function
        If InStr(FolderPath, ":") = 0 Then FolderPath = Server.MapPath(FolderPath)
        If fso.FolderExists(FolderPath) Then
            fso.DeleteFolder FolderPath, True
            FolderDelete = True
        End If
        Set fso = Nothing
        If Err.Number <> 0 Then Err.Clear
    End Function
    '================================================
    '函數(shù)名：CopyToFile
    '作  用：復(fù)制文件
    '參  數(shù)：SoureFile   ----原文件路徑
    '        NewFile  ----目標(biāo)文件路徑
    '================================================
    Public Function CopyToFile(ByVal SoureFile, ByVal NewFile)
        On Error Resume Next
        If SoureFile = "" Then Exit Function
        If NewFile = "" Then Exit Function
        If InStr(SoureFile, ":") = 0 Then SoureFile = Server.MapPath(SoureFile)
        If InStr(NewFile, ":") = 0 Then NewFile = Server.MapPath(NewFile)
        Dim fso
        Set fso = Server.CreateObject(FSO_ScriptName)
        If fso.FileExists(SoureFile) Then
            fso.CopyFile SoureFile, NewFile
        End If
        Set fso = Nothing
        If Err.Number <> 0 Then Err.Clear
    End Function
    '================================================
    '函數(shù)名：CopyToFolder
    '作  用：復(fù)制文件夾
    '參  數(shù)：SoureFolder   ----原路徑
    '        NewFolder  ----目標(biāo)路徑
    '================================================
    Public Function CopyToFolder(ByVal SoureFolder, ByVal NewFolder)
        On Error Resume Next
        If SoureFolder = "" Then Exit Function
        If NewFolder = "" Then Exit Function
        If InStr(SoureFolder, ":") = 0 Then SoureFolder = Server.MapPath(SoureFolder)
        If InStr(NewFolder, ":") = 0 Then NewFolder = Server.MapPath(NewFolder)
        Dim fso
        Set fso = Server.CreateObject(FSO_ScriptName)
        If fso.FolderExists(SoureFolder) Then
            fso.CopyFolder SoureFolder, NewFolder
        End If
        Set fso = Nothing
        If Err.Number <> 0 Then Err.Clear
    End Function
    '=============================================================
    '過程名：CreatedTextFile
    '作  用：創(chuàng)建文本文件
    '參  數(shù)：filename  ----文件名
    '        body  ----主要內(nèi)容
    '=============================================================
    Public Function CreatedTextFile(ByVal FileName, ByVal body)
        On Error Resume Next
        If InStr(FileName, ":") = 0 Then FileName = Server.MapPath(FileName)
        Dim fso,f
        Set fso = Server.CreateObject(FSO_ScriptName)
        Set f = fso.CreateTextFile(FileName)
        f.WriteLine body
        f.Close
        Set f = Nothing
        Set fso = Nothing
        If Err.Number <> 0 Then Err.Clear
    End Function
    '================================================
    '函數(shù)名：Readfile
    '作  用：讀取文件內(nèi)容
    '參  數(shù)：fromPath   ----來源文件路徑
    '================================================
    Public Function Readfile(ByVal fromPath)
        On Error Resume Next
        Dim strTemp,fso,f
        If InStr(fromPath, ":") = 0 Then fromPath = Server.MapPath(fromPath)
        Set fso = Server.CreateObject(FSO_ScriptName)
        If fso.FileExists(fromPath) Then
            Set f = fso.OpenTextFile(fromPath, 1, True)
            strTemp = f.ReadAll
            f.Close
            Set f = Nothing
        End If
        Set fso = Nothing
        Readfile = strTemp
        If Err.Number <> 0 Then Err.Clear
    End Function

    '================================================
    '函數(shù)名：CutMatchContent
    '作  用：截取相匹配的內(nèi)容
    '參  數(shù)：Str   ----原字符串
    '        PatStr   ----符合條件字符
    '================================================
    Public Function CutMatchContent(ByVal str, ByVal start, ByVal last, ByVal Condition)

        Dim Match,s,re
        Dim FilterStr,MatchStr
        Dim strContent,ArrayFilter
        Dim i, n,bRepeat

        If Len(start) = 0 Or Len(last) = 0 Then Exit Function

        On Error Resume Next

        MatchStr = "(" & CorrectPattern(start) & ")(.+?)(" & CorrectPattern(last) & ")"

        Set re = New RegExp
        re.IgnoreCase = True
        re.Global = True
        re.Pattern = MatchStr
        Set s = re.Execute(str)
        n = 0
        For Each Match In s
            If n = 0 Then
                n = n + 1
                ReDim ArrayFilter(n)
                ArrayFilter(n) = Match
            Else
                bRepeat = False
                For i = 0 To UBound(ArrayFilter)
                    If UCase(Match) = UCase(ArrayFilter(i)) Then
                        bRepeat = True
                        Exit For
                    End If
                Next
                If bRepeat = False Then
                    n = n + 1
                    ReDim Preserve ArrayFilter(n)
                    ArrayFilter(n) = Match
                End If
            End If
        Next

        Set s = Nothing
        Set re = Nothing

        If CBool(Condition) Then
            strContent = Join(ArrayFilter, "|||")
        Else
            strContent = Join(ArrayFilter, "|||")
            strContent = Replace(strContent, start, "")
            strContent = Replace(strContent, last, "")
        End If

        CutMatchContent = Replace(strContent, "|||", vbNullString, 1, 1)
    End Function

    Function CutFixContent(ByVal str, ByVal start, ByVal last, ByVal n)
        Dim strTemp
        On Error Resume Next
        If InStr(str, start) > 0 Then
            Select Case n
            Case 0  '左右都截?。ǘ既∏懊妫ㄈヌ庩P(guān)鍵字）
                strTemp = Right(str, Len(str) - InStr(str, start) - Len(start) + 1)
                strTemp = Left(strTemp, InStr(strTemp, last) - 1)
            Case Else  '左右都截取（都取前面）（保留關(guān)鍵字）
                strTemp = Right(str, Len(str) - InStr(str, start) + 1)
                strTemp = Left(strTemp, InStr(strTemp, last) + Len(last) - 1)
            End Select
        Else
            strTemp = ""
        End If
        CutFixContent = strTemp
    End Function
    Private Function CorrectPattern(ByVal str)
        str = Replace(str, "\", "\\")
        str = Replace(str, "~", "\~")
        str = Replace(str, "!", "\!")
        str = Replace(str, "@", "\@")
        str = Replace(str, "#", "\#")
        str = Replace(str, "%", "\%")
        str = Replace(str, "^", "\^")
        str = Replace(str, "&", "\&")
        str = Replace(str, "*", "\*")
        str = Replace(str, "(", "\(")
        str = Replace(str, ")", "\)")
        str = Replace(str, "-", "\-")
        str = Replace(str, "+", "\+")
        str = Replace(str, "[", "\[")
        str = Replace(str, "]", "\]")
        str = Replace(str, "<", "\<")
        str = Replace(str, ">", "\>")
        str = Replace(str, ".", "\.")
        str = Replace(str, "/", "\/")
        str = Replace(str, "?", "\?")
        str = Replace(str, "=", "\=")
        str = Replace(str, "|", "\|")
        str = Replace(str, "$", "\$")
        CorrectPattern = str
    End Function
    '=============================================================
    '函數(shù)名：UserGroupSetting
    '作  用：取用戶級(jí)權(quán)限設(shè)置
    '參  數(shù)：gradeid   ----等級(jí)ID
    '=============================================================
    Public Function UserGroupSetting(ByVal gradeid)
        If Not IsNumeric(gradeid) Then
            gradeid = 0
        End If
        On Error Resume Next
        Dim Rs, SQL

        Name = "GroupSetting" & gradeid
        If ObjIsEmpty() Then
            SQL = "Select Groupname,GroupSet from [NC_UserGroup] where Grades =" & gradeid
            Set Rs = Execute(SQL)
            If Rs.BOF And Rs.EOF Then
                UserGroupSetting = ""
                Set Rs = Nothing
                Exit Function
            End If
            Value = Rs("GroupSet") & Rs("Groupname")
            Set Rs = Nothing
        End If
        UserGroupSetting = Value
    End Function
    Private Sub LoadGroupSetting()
        Dim strGroupSetting
        Dim Rs, SQL
        Dim Grades
        Grades = CInt(membergrade)
        On Error Resume Next
        If Grades > 0 And memberid > 0 Then
            If binUserLong = False Then
                Set Rs = Execute("SELECT userid FROM [NC_User] WHERE password='" & CheckRequest(memberpass, 45) & "' And UserGrade=" & Grades & " And UserLock=0 And  userid =" & memberid)
                If Rs.BOF And Rs.EOF Then
                    Grades = 0
                    Response.Cookies(Cookies_Name) = ""
                    binUserLong = False
                Else
                    binUserLong = True
                End If
                Set Rs = Nothing
            End If
        End If

        Name = "GroupSetting" & Grades
        If ObjIsEmpty() Then
            SQL = "Select Groupname,GroupSet from [NC_UserGroup] where Grades =" & Grades
            Set Rs = Execute(SQL)
            If Rs.BOF And Rs.EOF Then
                Response.Cookies(Cookies_Name) = ""
                Set Rs = Nothing
                Exit Sub
            End If
            Value = Rs("GroupSet") & Rs("Groupname")
            Set Rs = Nothing
        End If
        blnGroupSetting = True
        strGroupSetting = Value
        arrGroupSetting = Split(strGroupSetting, "|||")
    End Sub
    Public Property Get GroupSetting(i)
        If Not blnGroupSetting Then LoadGroupSetting
        GroupSetting = arrGroupSetting(i)
    End Property
    Public Function ReadContent(ByVal strContent)
        On Error Resume Next
        Dim re, i
        Dim sContentKeyword, strKeyword

        Set re = New RegExp
        re.IgnoreCase = True
        re.Global = True
        '過濾危險(xiǎn)腳本
        re.Pattern = "(<s+cript(.[^>]*)>)"
        strContent = re.Replace(strContent, "&lt;&#83cript$2&gt;")
        re.Pattern = "(<\/s+cript>)"
        strContent = re.Replace(strContent, "&lt;/&#83cript&gt;")
        re.Pattern = "(<body(.[^>]*)>)"
        strContent = re.Replace(strContent, "<body>")
        re.Pattern = "(<\!(.[^>]*)>)"
        strContent = re.Replace(strContent, "&lt;$2&gt;")
        re.Pattern = "(<\!)"
        strContent = re.Replace(strContent, "&lt;!")
        re.Pattern = "(-->)"
        strContent = re.Replace(strContent, "--&gt;")
        re.Pattern = "(javascript:)"
        strContent = re.Replace(strContent, "<i>javascript</i>:")

        If Trim(ContentKeyword) <> "" Then
            sContentKeyword = Split(ContentKeyword, "@@@")
            For i = 0 To UBound(sContentKeyword) - 1
                strKeyword = Split(sContentKeyword(i), "$$$")
                re.Pattern = "(" & strKeyword(0) & ")"
                strContent = re.Replace(strContent, "<a target=""_blank"" href=""" & strKeyword(1) & """ class=""wordstyle"">$1</a>")
            Next
        End If

        re.Pattern = "(\[i\])(.[^\[]*)(\[\/i\])"
        strContent = re.Replace(strContent, "<i>$2</i>")
        re.Pattern = "(\[u\])(.[^\[]*)(\[\/u\])"
        strContent = re.Replace(strContent, "<u>$2</u>")
        re.Pattern = "(\[b\])(.[^\[]*)(\[\/b\])"
        strContent = re.Replace(strContent, "<b>$2</b>")
        re.Pattern = "(\[fly\])(.*)(\[\/fly\])"
        strContent = re.Replace(strContent, "<marquee>$2</marquee>")

        re.Pattern = "\[size=([1-9])\](.[^\[]*)\[\/size\]"
        strContent = re.Replace(strContent, "<font size=$1>$2</font>")
        re.Pattern = "(\[center\])(.[^\[]*)(\[\/center\])"
        strContent = re.Replace(strContent, "<center>$2</center>")

        're.Pattern = "<IMG.[^>]*SRC(=| )(.[^>]*)>"
        'strContent = re.Replace(strContent, "<IMG SRC=$2 border=""0"">")
        re.Pattern = "<img(.[^>]*)>"

        strContent = re.Replace(strContent, "<img$1 onload=""return imgzoom(this,550)"">")

        re.Pattern = "\[DIR=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/DIR]"
        strContent = re.Replace(strContent, "<embed src=$3 pluginspage=http://www.macromedia.com/shockwave/download/ width=$1 height=$2></embed>")
        re.Pattern = "\[QT=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/QT]"
        strContent = re.Replace(strContent, "<embed src=$3 width=$1 height=$2 autoplay=true loop=false controller=true playeveryframe=false cache=false scale=TOFIT bgcolor=#000000 kioskmode=false targetcache=false pluginspage=http://www.apple.com/quicktime/>")
        re.Pattern = "\[MP=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/MP]"
        strContent = re.Replace(strContent, "<embed type=application/x-oleobject codebase=http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=5,1,52,701 flename=mp src=$3  width=$1 height=$2></embed>")
        re.Pattern = "\[RM=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/RM]"
        strContent = re.Replace(strContent, "<OBJECT classid=clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA class=OBJECT id=RAOCX width=$1 height=$2><PARAM NAME=SRC VALUE=$3><PARAM NAME=CONSOLE VALUE=Clip1><PARAM NAME=CONTROLS VALUE=imagewindow><PARAM NAME=AUTOSTART VALUE=true></OBJECT><br><OBJECT classid=CLSID:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA height=32 id=video2 width=$1><PARAM NAME=SRC VALUE=$3><PARAM NAME=AUTOSTART VALUE=-1><PARAM NAME=CONTROLS VALUE=controlpanel><PARAM NAME=CONSOLE VALUE=Clip1></OBJECT>")

        re.Pattern = "(\[FLASH\])(.[^\[]*)(\[\/FLASH\])"
        strContent = re.Replace(strContent, "<embed src=""$2"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=500 height=400>$2</embed>")
        re.Pattern = "(\[FLASH=*([0-9]*),*([0-9]*)\])(.[^\[]*)(\[\/FLASH\])"
        strContent = re.Replace(strContent, "<embed src=""$4"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=$2 height=$3>$4</embed>")
        re.Pattern = "\[UPLOAD=(gif|jpg|jpeg|bmp|png)\](.[^\[]*)(gif|jpg|jpeg|bmp|png)\[\/UPLOAD\]"
        strContent = re.Replace(strContent, "<br><A HREF=""$2$1"" TARGET=_blank><IMG SRC=""$2$1"" border=0 alt=按此在新窗口瀏覽圖片 onload=""javascript:if(this.width>screen.width-333)this.width=screen.width-333""></A>")

        re.Pattern = "(\[UPLOAD=(.[^\[]*)\])(.[^\[]*)(\[\/UPLOAD\])"
        strContent = re.Replace(strContent, "<br><a href=""$3"">點(diǎn)擊瀏覽該文件</a>")

        re.Pattern = "(\[URL\])(.[^\[]*)(\[\/URL\])"
        strContent = re.Replace(strContent, "<A HREF=""$2"" TARGET=_blank>$2</A>")
        re.Pattern = "(\[URL=(.[^\[]*)\])(.[^\[]*)(\[\/URL\])"
        strContent = re.Replace(strContent, "<A HREF=""$2"" TARGET=_blank>$3</A>")

        re.Pattern = "(\[EMAIL\])(.[^\[]*)(\[\/EMAIL\])"
        strContent = re.Replace(strContent, "<A HREF=""mailto:$2"">$2</A>")
        re.Pattern = "(\[EMAIL=(.[^\[]*)\])(.[^\[]*)(\[\/EMAIL\])"
        strContent = re.Replace(strContent, "<A HREF=""mailto:$2"" TARGET=_blank>$3</A>")

        re.Pattern = "(\[HTML\])(.[^\[]*)(\[\/HTML\])"
        strContent = re.Replace(strContent, "<table width='100%' border='0' cellspacing='0' cellpadding='6' bgcolor='#F6F6F6'><td><b>以下內(nèi)容為程序代碼:</b><br>$2</td></table>")
        re.Pattern = "(\[code\])(.[^\[]*)(\[\/code\])"
        strContent = re.Replace(strContent, "<table width='100%' border='0' cellspacing='0' cellpadding='6' bgcolor='#F6F6F6'><td><b>以下內(nèi)容為程序代碼:</b><br>$2</td></table>")

        re.Pattern = "(\[color=(.[^\[]*)\])(.[^\[]*)(\[\/color\])"
        strContent = re.Replace(strContent, "<font color=$2>$3</font>")
        re.Pattern = "(\[face=(.[^\[]*)\])(.[^\[]*)(\[\/face\])"
        strContent = re.Replace(strContent, "<font face=$2>$3</font>")
        re.Pattern = "\[align=(center|left|right)\](.*)\[\/align\]"
        strContent = re.Replace(strContent, "<div align=$1>$2</div>")

        re.Pattern = "(\[QUOTE\])(.*)(\[\/QUOTE\])"
        strContent = re.Replace(strContent, "<table cellpadding=0 cellspacing=0 border=1 WIDTH=94% bordercolor=#000000 bgcolor=#F2F8FF align=center  ><tr><td  ><table width=100% cellpadding=5 cellspacing=1 border=0><TR><TD BGCOLOR='#F6F6F6'>$2</table></table><br>")
        re.Pattern = "(\[move\])(.*)(\[\/move\])"
        strContent = re.Replace(strContent, "<MARQUEE scrollamount=3>$2</marquee>")
        re.Pattern = "\[GLOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/GLOW]"
        strContent = re.Replace(strContent, "<table width=$1 style=""filter:glow(color=$2, strength=$3)"">$4</table>")
        re.Pattern = "\[SHADOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/SHADOW]"
        strContent = re.Replace(strContent, "<table width=$1 style=""filter:shadow(color=$2, strength=$3)"">$4</table>")
        Set re = Nothing

        strContent = Replace(strContent, "[InstallDir_ChannelDir]", InstallDir & "/" & ChannelDir)
        strContent = Replace(strContent, "{", "&#123;")
        strContent = Replace(strContent, "}", "&#125;")
        strContent = Replace(strContent, "$", "&#36;")
        ReadContent = strContent
    End Function

End Class
%>