亲宝软件园·资讯

展开

asp常用函数集合,非常不错以后研究 asp常用函数集合,非常不错以后研究

人气:0
想了解asp常用函数集合,非常不错以后研究的相关内容吗,在本文为您仔细讲解asp常用函数集合,非常不错以后研究的相关知识和一些Code实例,欢迎阅读和指正,我们先划重点:asp,自定义标签,下面大家一起来学习吧。
<%
function loadtempletfile(byval path)
    on error resume next
    dim objstream
    set objstream = server.createobject("adodb.stream")
    with objstream
        .type = 2
        .mode = 3
        .open
        .loadfromfile server.mappath(path)
        if err.number <> 0 then
            err.clear
             response.write("预加载的模板[" & path & "]不存在!")
            response.end()
        end if
        .charset = "" & chrset & ""
        .position = 2
            loadtempletfile = .readtext
        .close
    end with
    set objstream = nothing
end function

function movefiles(sFolder,dFolder)
    on error resume next
    dim fso
    set fso = server.createobject("scripting.filesystemobject")
    if fso.folderexists(server.mappath(sFolder)) and fso.folderexists(server.mappath(dFolder)) then
        fso.copyfolder server.mappath(sFolder),server.mappath(dFolder)
        movefiles = true
    else
        movefiles = false
        set fso = nothing
        call alertbox("系统没有找到指定的路径[" & sFolder & "]!",2)
    end if
    set fso = nothing
end function

function renamefolder(sFolder,dFolder)
    on error resume next
    dim fso
    set fso = server.createobject("scripting.filesystemobject")
    if fso.folderexists(server.mappath(sFolder)) then
        fso.movefolder server.mappath(sFolder),server.mappath(dFolder)
        renamefolder = true
    else
        renamefolder = false
        set fso = nothing
        call alertbox("系统没有找到指定的路径[" & sFolder & "]!",2)
    end if
    set fso = nothing
end function

function checkfolder(sPATH)
    on error resume next
    dim fso
    set fso = server.createobject("scripting.filesystemobject")
    if fso.folderexists(server.mappath(sPATH)) then
        checkfolder = true
    else
        checkfolder = false
    end if
    set fso = nothing
end function

function checkfile(sPATH)
    on error resume next
    dim fso
    set fso = server.createobject("scripting.filesystemobject")
    if fso.fileexists(server.mappath(sPATH)) then
        checkfile = true
    else
        checkfile = false
    end if
    set fso = nothing
end function

function createdir(sPATH)
    dim fso,pathArr,i,path_Level,pathTmp,cPATH
    on error resume next
    sPATH = replace(sPATH,"\","/")
    set fso = server.createobject("scripting.filesystemobject")
        pathArr = split(sPATH,"/")
        path_Level = ubound(pathArr)
        for i = 0 to path_Level
            if i = 0 then pathTmp = pathArr(0) & "/" else pathTmp = pathTmp&pathArr(i) & "/"
            cPATH = left(pathTmp,len(pathTmp)-1)
            if not fso.folderexists(cPATH) then fso.createfolder(cPATH)
        next
    set fso = nothing
    if err.number <> 0 then
        err.clear
        createdir = false
    else
        createdir = true
    end if
end function

function delclassfolder(sPATH)
    on error resume next
    dim fso
    set fso = server.createobject("scripting.filesystemobject")
    if fso.folderexists(server.mappath(sPATH)) then
        fso.deletefolder(server.mappath(sPATH))
    end if
    set fso = nothing
end function

function delnewsfile(sPATH,filename)
    on error resume next
    dim fso,tempArr,cPATH,ePATH,i:i = 0
    set fso = server.createobject("scripting.filesystemobject")
    sPATH = sPATH & filename & site_extname
    if fso.fileexists(server.mappath(sPATH)) then
        fso.deletefile(server.mappath(sPATH))
        while(i <> -1)
            i = i + 1
            ePATH = replace(sPATH,filename & ".",filename & "_" & i + 1 & ".")
            if fso.fileexists(server.mappath(ePATH)) then
                fso.deletefile(server.mappath(ePATH))
            else
                i = -1
            end if
        wend
    end if
end function

class stringclass
    public function getstr(strhtml)
        dim PatrnStr
            PatrnStr="<.*?>"
        dim objRegEx
        set objRegEx = new RegExp
            objRegEx.pattern = PatrnStr
            objRegEx.ignorecase = true
            objRegEx.global = true
        getstr = objRegEx.replace(strhtml,"")
        set objRegEx = nothing
    end function
    public function replacestr(patrn,mstr,replstr)
        dim objRegEx
        set objRegEx = new RegExp
            objRegEx.pattern = patrn
            objRegEx.ignorecase = true
            objRegEx.global = true
        replacestr = objRegEx.replace(mstr,replstr)
        set objRegEx = nothing
    end function
    public function classcustomtag(byval patrn,byval mstr,byval classid,byval indexid,byval pagestr)
        dim objRegEx,match,matches
        set objRegEx = new RegExp
            objRegEx.pattern = patrn
            objRegEx.ignorecase = true
            objRegEx.global = true
        set matches = objRegEx.execute(mstr)
        for each match in matches
            mstr = replace(mstr,match.value,parseclasstag(match.value,classid,indexid,pagestr))
        next
        set matches = nothing
        set objRegEx = nothing
        classcustomtag = mstr
    end function
    public function newscustomtag(byval patrn,byval mstr,byval classid,byval newsid,byval keywords)
        dim objRegEx,match,matches
        set objRegEx = new RegExp
            objRegEx.pattern = patrn
            objRegEx.ignorecase = true
            objRegEx.global = true
        set matches = objRegEx.execute(mstr)
        for each match in matches
            mstr = replace(mstr,match.value,parsenewstag(match.value,classid,newsid,keywords))
        next
        set matches = nothing
        set objRegEx = nothing
        newscustomtag = mstr
    end function
end class

function processcustomtag(byval scontent)
    dim objRegEx,match,matches
    set objRegEx = new RegExp
        objRegEx.pattern = "{ncms:[^<>]+?\/}"
        objRegEx.ignorecase = true
        objRegEx.global = true
    set matches = objRegEx.execute(scontent)
    for each match in matches
        scontent = replace(scontent,match.value,parsetag(match.value))
    next
    set matches = nothing
    set objRegEx = nothing
    processcustomtag = scontent
end function

function X_processcustomtag(byval scontent)
    dim objRegEx,match,matches
    set objRegEx = new RegExp
        objRegEx.pattern = "(\[ncms:).+?(\])(.|\n)+?(\[\/ncms\])"
        objRegEx.ignorecase = true
        objRegEx.global = true
    set matches = objRegEx.execute(scontent)
    for each match in matches
        scontent = replace(scontent,match.value,parsetag(match.value))
    next
    set matches = nothing
    set objRegEx = nothing
    X_processcustomtag = scontent
end function

function getattribute(byval strattribute,byval strtag)
    dim objRegEx,matches
    set objRegEx = new RegExp
        objRegEx.pattern = lcase(strattribute)&"=""[0-9a-zA-Z]*"""
        objRegEx.ignorecase = true
        objRegEx.global = true
    set matches = objRegEx.execute(strtag)
    if matches.count > 0 then
        getattribute = split(matches(0).value,"""")(1)
    else
        getattribute = ""
    end if
    set matches = nothing
    set objRegEx = nothing
end function

function getinnerhtml(byval strhtml)
    dim objregex,matches,str
    set objregex = new regexp
    objregex.pattern = "(\])(.|\n)+?(\[\/ncms\])"
    objregex.ignorecase = true
    objregex.global = false
    set matches = objregex.execute(strhtml)
        if matches.count > 0 then
            str = trim(matches.item(0).value)
        end if
    set matches = nothing
    if len(str) > 8 then
        getinnerhtml = mid(str,2,len(str) - 8)
    end if
end function

function parsetag(byval strtag)
    dim arrresult,classname,arrattributes,objclass
    if len(strtag) = 0 then exit function
    arrresult = split(strtag,":")
    classname = split(arrresult(1)," ")(0)
    select case lcase(classname)
        case "news"
            set objclass = new ncmsnewstag
                if not isnumeric(getattribute("id",strtag)) then
                    response.write("标签[ncms:news]参数错误!参数[id]必须是数字!")
                    response.end()
                end if
                objclass.id = getattribute("id",strtag)
                if not isnumeric(getattribute("num",strtag)) then
                    response.write("标签[ncms:news]参数错误!参数[num]必须是数字!")
                    response.end()
                end if
                objclass.num = getattribute("num",strtag)
                if not isnumeric(getattribute("len",strtag)) then
                    response.write("标签[ncms:news]参数错误!参数[len]必须是数字!")
                    response.end()
                end if
                objclass.len = getattribute("len",strtag)
                objclass.show = getattribute("show",strtag)
                if getattribute("lih",strtag) <> "" and not isnumeric(getattribute("lih",strtag)) then
                    response.write("标签[ncms:news]参数错误!参数[lih]必须是数字!")
                    response.end()
                end if
                objclass.lih = getattribute("lih",strtag)
                if getattribute("imgw",strtag) <> "" and not isnumeric(getattribute("imgw",strtag)) then
                    response.write("标签[ncms:news]参数错误!参数[imgw]必须是数字!")
                    response.end()
                end if
                objclass.imgw = getattribute("imgw",strtag)
                if getattribute("imgh",strtag) <> "" and not isnumeric(getattribute("imgh",strtag)) then
                    response.write("标签[ncms:news]参数错误!参数[imgh]必须是数字!")
                    response.end()
                end if
                objclass.imgh = getattribute("imgh",strtag)
                if getattribute("tgt",strtag) <> "" and getattribute("tgt",strtag) <> "blank" then
                    response.write("标签[ncms:news]参数错误!参数[tgt]必须是[<font color=""red"">blank</font>]!")
                    response.end()
                end if
                objclass.tgt = getattribute("tgt",strtag)
                if getattribute("hit",strtag) <> "" and not isnumeric(getattribute("hit",strtag)) then
                    response.write("标签[ncms:free]参数错误!参数[hit]必须是数字!")
                    response.end()
                end if
                objclass.hit = getattribute("hit",strtag)
                if not isnumeric(getattribute("col",strtag)) then
                    response.write("标签[ncms:news]参数错误!参数[col]必须是数字!")
                    response.end()
                end if
                parsetag = objclass.newsshow(getattribute("ty",strtag),getattribute("col",strtag))
            set objclass = nothing
        case "free"
            set objclass = new X_ncmsnewstag
                if not isnumeric(getattribute("id",strtag)) then
                    response.write("标签[ncms:free]参数错误!参数[id]必须是数字!")
                    response.end()
                end if
                objclass.id = getattribute("id",strtag)
                if not isnumeric(getattribute("num",strtag)) then
                    response.write("标签[ncms:free]参数错误!参数[num]必须是数字!")
                    response.end()
                end if
                objclass.num = getattribute("num",strtag)
                if not isnumeric(getattribute("len",strtag)) then
                    response.write("标签[news:free]参数错误!参数[len]必须是数字!")
                    response.end()
                end if
                objclass.len = getattribute("len",strtag)
                objclass.show = getattribute("show",strtag)
                if getattribute("lih",strtag) <> "" and not isnumeric(getattribute("lih",strtag)) then
                    response.write("标签[ncms:free]参数错误!参数[lih]必须是数字!")
                    response.end()
                end if
                objclass.lih = getattribute("lih",strtag)
                if getattribute("hit",strtag) <> "" and not isnumeric(getattribute("hit",strtag)) then
                    response.write("标签[ncms:free]参数错误!参数[hit]必须是数字!")
                    response.end()
                end if
                objclass.hit = getattribute("hit",strtag)
                if not isnumeric(getattribute("col",strtag)) then
                    response.write("标签[ncms:free]参数错误!参数[col]必须是数字!")
                    response.end()
                end if
                parsetag = objclass.newsshow(getattribute("ty",strtag),getattribute("col",strtag),getinnerhtml(strtag))
        case "menu"
            set objclass = new ncmsmenutag
                parsetag = objclass.menushow(getattribute("show",strtag))
            set objclass = nothing
        case "info"
            set objclass = new ncmsinfotag
                if not isnumeric(getattribute("num",strtag)) then
                    response.write("标签[ncms:info]参数错误!参数[num]必须是数字!")
                    response.end()
                end if
                objclass.num = getattribute("num",strtag)
                if not isnumeric(getattribute("len",strtag)) then
                    response.write("标签[ncms:info]参数错误!参数[len]必须是数字!")
                    response.end()
                end if
                objclass.len = getattribute("len",strtag)
                parsetag = objclass.infoshow()
            set objclass = nothing
        case "head"
            set objclass = new ncmsheadtag
                if not isnumeric(getattribute("num",strtag)) then
                    response.write("标签[ncms:head]参数错误!参数[num]必须是数字!")
                    response.end()
                elseif getattribute("num",strtag) > 6 then
                    response.write("标签[ncms:head]参数错误!参数[num]在[1-6]之间!")
                    response.end()
                end if
                objclass.num = getattribute("num",strtag)
                if not isnumeric(getattribute("len",strtag)) then
                    response.write("标签[ncms:head]参数错误!参数[len]必须是数字!")
                    response.end()
                end if
                objclass.len = getattribute("len",strtag)
                if getattribute("imgw",strtag) <> "" and not isnumeric(getattribute("imgw",strtag)) then
                    response.write("标签[ncms:head]参数错误!参数[imgw]必须是数字!")
                    response.end()
                end if
                objclass.imgw = getattribute("imgw",strtag)
                if getattribute("imgh",strtag) <> "" and not isnumeric(getattribute("imgh",strtag)) then
                    response.write("标签[ncms:head]参数错误!参数[imgh]必须是数字!")
                    response.end()
                end if
                objclass.imgh = getattribute("imgh",strtag)
                if getattribute("size",strtag) <> "" and not isnumeric(getattribute("size",strtag)) then
                    response.write("标签[ncms:head]参数错误!参数[size]必须是数字!")
                    response.end()
                end if
                objclass.size = getattribute("size",strtag)
                parsetag = objclass.headshow(getattribute("ty",strtag))
            set objclass = nothing
        case "link"
            set objclass = new ncmslinktag
                if not isnumeric(getattribute("num",strtag)) then
                    response.write("标签[ncms:link]参数错误!参数[num]必须是数字!")
                    response.end()
                end if
                objclass.num = getattribute("num",strtag)
                if not isnumeric(getattribute("col",strtag)) then
                    response.write("标签[ncms:link]参数错误!参数[col]必须是数字!")
                    response.end()
                end if
                parsetag = objclass.linkshow(getattribute("ty",strtag),getattribute("col",strtag))
            set objclass = nothing
        case else
            response.write("标签[ncms:xxx]构造错误!")
            response.end()
    end select
end function

function parseclasstag(byval strtag,byval classid,byval indexid,byval pagestr)
    dim arrresult,classname,arrattributes,objclass
    if len(strtag) = 0 then exit function
    arrresult = split(strtag,":")
    classname = split(arrresult(1)," ")(0)
    select case lcase(classname)
        case "list"
            set objclass = new ncmsclasstag
                if not isnumeric(getattribute("len",strtag)) then
                    response.write("标签[news:list]参数错误!参数[len]必须是数字!")
                    response.end()
                end if
                objclass.len = getattribute("len",strtag)
                objclass.order = getattribute("order",strtag)
                if getattribute("lih",strtag) <> "" and not isnumeric(getattribute("lih",strtag)) then
                    response.write("标签[news:list]参数错误!参数[lih]必须是数字!")
                    response.end()
                end if
                objclass.lih = getattribute("lih",strtag)
                if not isnumeric(getattribute("col",strtag)) then
                    response.write("标签[news:list]参数错误!参数[col]必须是数字!")
                    response.end()
                end if
                parseclasstag = objclass.classshow(getattribute("ty",strtag),getattribute("col",strtag),classid,indexid,pagestr)
            set objclass = nothing
        case else
            response.write("标签[news:xxxx]构造错误!")
            response.end()
    end select
end function

function parsenewstag(byval strtag,byval classid,byval newsid,byval keywords)
    dim arrresult,classname,arrattributes,objclass
    if len(strtag) = 0 then exit function
    arrresult = split(strtag,":")
    classname = split(arrresult(1)," ")(0)
    select case lcase(classname)
        case "relate"
            set objclass = new ncmsrelatetag
                if not isnumeric(getattribute("num",strtag)) then
                    response.write("标签[news:relate]参数错误!参数[num]必须是数字!")
                    response.end()
                end if
                objclass.num = getattribute("num",strtag)
                if not isnumeric(getattribute("len",strtag)) then
                    response.write("标签[news:relate]参数错误!参数[len]必须是数字!")
                    response.end()
                end if
                objclass.len = getattribute("len",strtag)
                if getattribute("lih",strtag) <> "" and not isnumeric(getattribute("lih",strtag)) then
                    response.write("标签[news:relate]参数错误!参数[lih]必须是数字!")
                    response.end()
                end if
                objclass.lih = getattribute("lih",strtag)
                if not isnumeric(getattribute("col",strtag)) then
                    response.write("标签[news:relate]参数错误!参数[col]必须是数字!")
                    response.end()
                end if
                parsenewstag = objclass.relateshow(getattribute("col",strtag),classid,newsid,keywords)
            set objclass = nothing
        case "page"
            set objclass = new ncmspagetag
                parsenewstag = objclass.pageshow(getattribute("show",strtag),classid,newsid)
            set objclass = nothing
        case else
            response.write("标签[news:xxxx]构造错误!")
            response.end()
    end select
end function

function getcurclasscount(classid)
    dim rs,curclasscount
    set rs = conn.execute("select count(*) from NCMS_news where classid in(" & classid & allchildclass(classid) & ")")
    if instr(rs(0)/n_listnum,".") <> 0 then
        curclasscount = fix(rs(0)/n_listnum) + 1
    else
        curclasscount = rs(0)/n_listnum
    end if
    rs.close:set rs = nothing
    getcurclasscount = curclasscount
end function

class ncmsclasstag
    public ty,len,order,lih
    public function classshow(stype,scolumn,classid,indexid,pagestr)
        dim TempHTM,xsql,rs,sql,databox,l,obox
            TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
            TempHTM = TempHTM & "<tr>" & chr(10)
        if indexid = "" or indexid = 0 then
            indexid = 1
        end if
        select case stype
            case "text"
                set rs = server.createobject("adodb.recordset")
                if order = "desc" then
                    sql = "select classid,title,click,filename,addtime from NCMS_news where classid in(" & classid & allchildclass(classid) & ") and created=1 and pagetype=0 order by id desc"
                elseif order = "asc" then
                    sql = "select classid,title,click,filename,addtime from NCMS_news where classid in(" & classid & allchildclass(classid) & ") and created=1 and pagetype=0 order by id asc"
                else
                    response.write("标签[news:list]参数[order]错误!")
                    response.end()
                end if
                rs.cursorlocation = 3
                rs.open sql,conn,1,3
                if rs.eof then
                    rs.close:set rs = nothing
                    TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
                    classshow = TempHTM
                    exit function
                end if
                rs.pagesize = n_listnum
                rs.absolutepage = indexid
                for l = 1 to rs.pagesize
                    if rs.eof then exit for
                    TempHTM = TempHTM & "<td height=""" & lih & """ align=""left"" valign=""middle"">·<a href=""" & site_root & "/" & site_html & "/" & getclasspath(rs("classid")) & "/" & rs("filename") & site_extname & """ title=""" & rs("title") & """>" & gottopic(rs("title"),len) & "</a></td>" & chr(10)
                    TempHTM = TempHTM & "<td height=""" & lih & """ align=""center"" valign=""middle"">" & rs("click") & "</td>" & chr(10)
                    TempHTM = TempHTM & "<td height=""" & lih & """ align=""center"" valign=""middle"">" & rs("addtime") & "</td>" & chr(10)
                    if l = rs.pagesize then
                        TempHTM = TempHTM & "</tr>" & chr(10)
                    else
                        if cint(l mod scolumn) = 0 then
                            TempHTM = TempHTM & "</tr>" & chr(10)
                            TempHTM = TempHTM & "<tr>" & chr(10)
                        end if
                    end if
                    rs.movenext
                next
                rs.close:set rs = nothing
                TempHTM = TempHTM & "</table>" & chr(10)
                classshow = TempHTM & pagestr
            case "image"
                if IsObjInstalled("persits.jpeg") = true and jpeg_gate = 0 then
                    set rs = server.createobject("adodb.recordset")
                    if order = "desc" then
                        sql = "select classid,title,bimg,filename,addtime from NCMS_news where classid in(" & classid & allchildclass(classid) & ") and isimg=1 and created=1 and pagetype=0 order by id desc"
                    elseif order = "asc" then
                        sql = "select classid,title,bimg,filename,addtime from NCMS_news where classid in(" & classid & allchildclass(classid) & ") and isimg=1 and created=1 and pagetype=0 order by id asc"
                    else
                        response.write("标签[news:list]参数[order]错误!")
                        response.end()
                    end if
                    rs.cursorlocation = 3
                    rs.open sql,conn,1,3
                    if rs.eof then
                        rs.close:set rs = nothing
                        TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
                        classshow = TempHTM
                        exit function
                    end if
                    rs.pagesize = n_listnum
                    rs.absolutepage = indexid
                    for l = 1 to rs.pagesize
                        if rs.eof then exit for
                        TempHTM = TempHTM & "<td><div id=""simg""><a href=""" & site_root & "/" & site_html & "/" & getclasspath(rs("classid")) & "/" & rs("filename") & site_extname & """><img height=""" & jpeg_height & """ src=""" & site_root & "/" & site_upload & "/" & site_simg & "/" & rs("bimg") & """ width=""" & jpeg_width & """ alt=""" & rs("title") & """ /></a></div></td>" & chr(10)
                        if l = rs.pagesize then
                            TempHTM = TempHTM & "</tr>" & chr(10)
                        else
                            if cint(l mod scolumn) = 0 then
                                TempHTM = TempHTM & "</tr>" & chr(10)
                                TempHTM = TempHTM & "<tr>" & chr(10)
                            end if
                        end if
                        if checkfile("" & site_root & "/" & site_upload & "/" & site_bimg & "/" & rs("bimg") & "") = true then
                            set obox = server.createobject("persits.jpeg")
                                obox.open server.mappath("" & site_root & "/" & site_upload & "/" & site_bimg & "/" & rs("bimg") & "")
                                obox.width = jpeg_width
                                obox.height = jpeg_height
                                obox.save server.mappath("" & site_root & "/" & site_upload & "/" & site_simg & "/" & rs("bimg") & "")
                            set obox = nothing
                        end if
                        rs.movenext
                    next
                    rs.close:set rs = nothing
                    TempHTM = TempHTM & "</table>" & chr(10)
                    classshow = TempHTM & pagestr
                else
                    set rs = server.createobject("adodb.recordset")
                    if order = "desc" then
                        sql = "select classid,title,bimg,filename,addtime from NCMS_news where classid in(" & classid & allchildclass(classid) & ") and isimg=1 and created=1 and pagetype=0 order by id desc"
                    elseif order = "asc" then
                        sql = "select classid,title,bimg,filename,addtime from NCMS_news where classid in(" & classid & allchildclass(classid) & ") and isimg=1 and created=1 and pagetype=0 order by id asc"
                    else
                        response.write("标签[news:list]参数[order]错误!")
                        response.end()
                    end if
                    rs.cursorlocation = 3
                    rs.open sql,conn,1,3
                    if rs.eof then
                        rs.close:set rs = nothing
                        TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
                        classshow = TempHTM
                        exit function
                    end if
                    rs.pagesize = n_listnum
                    rs.absolutepage = indexid
                    for l = 1 to rs.pagesize
                        if rs.eof then exit for
                        TempHTM = TempHTM & "<td><div id=""simg""><a href=""" & site_root & "/" & site_html & "/" & getclasspath(rs("classid")) & "/" & rs("filename") & site_extname & """><img height=""" & jpeg_height & """ src=""" & site_root & "/" & site_upload & "/" & site_bimg & "/" & rs("bimg") & """ width=""" & jpeg_width & """ alt=""" & rs("title") & """ /></a></div></td>" & chr(10)
                        if l = rs.pagesize then
                            TempHTM = TempHTM & "</tr>" & chr(10)
                        else
                            if cint(l mod scolumn) = 0 then
                                TempHTM = TempHTM & "</tr>" & chr(10)
                                TempHTM = TempHTM & "<tr>" & chr(10)
                            end if
                        end if
                        rs.movenext
                    next
                    rs.close:set rs = nothing
                    TempHTM = TempHTM & "</table>" & chr(10)
                    classshow = TempHTM & pagestr
                end if
            case else
                response.write("标签[news:list]参数[ty]错误!")
                response.end()
        end select
    end function
end class

class ncmsnewstag
    public id,ty,show,len,num,lih,imgw,imgh,tgt,hit
    public function newsshow(stype,scolumn)
        dim TempHTM,xsql,rs,databox,i,imgdot,obox
            TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
            TempHTM = TempHTM & "<tr>" & chr(10)
        if tgt = "" then
            tgt = "self"
        end if
        select case stype
            case "text"
                if show = "new" then
                    if id = 0 then
                        set rs = conn.execute("select top " & num & " classid,title,isimg,filename from NCMS_news where created=1 and pagetype=0 order by id desc")
                    else
                        set rs = conn.execute("select top " & num & " classid,title,isimg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and created=1 and pagetype=0 order by id desc")
                    end if
                elseif show = "elite" then
                    if id = 0 then
                        set rs = conn.execute("select top " & num & " classid,title,isimg,filename from NCMS_news where elite=1 and created=1 and pagetype=0 order by id desc")
                    else
                        set rs = conn.execute("select top " & num & " classid,title,isimg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and elite=1 and created=1 and pagetype=0 order by id desc")
                    end if
                elseif show = "hot" then
                    if id = 0 then
                        set rs = conn.execute("select top " & num & " classid,title,isimg,filename from NCMS_news where click>=" & hit & " and created=1 and pagetype=0 order by click desc")
                    else
                        set rs = conn.execute("select top " & num & " classid,title,isimg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and click>=" & hit & " and created=1 and pagetype=0 order by click desc")
                    end if
                else
                    response.write("标签[ncms:news]参数[show]错误!")
                    response.end()
                end if
                if rs.eof then
                    rs.close:set rs = nothing
                    TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
                    newsshow = TempHTM
                    exit function
                else
                    databox = rs.getrows()
                    rs.close:set rs = nothing
                    for i = 0 to ubound(databox,2)
                        if databox(2,i) = 1 and show = "new" then
                            imgdot = "[<font color=""red"" size=""2"">图</font>]"
                        else
                            imgdot = ""
                        end if
                        TempHTM = TempHTM & "<td height=""" & lih & """ align=""left"" valign=""middle"">·<a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(0,i)) & "/" & databox(3,i) & site_extname & """ title=""" & databox(1,i) & """ target=""_" & tgt & """>" & gottopic(databox(1,i),len) & imgdot & "</a></td>" & chr(10)
                        if i = ubound(databox,2) then
                            TempHTM = TempHTM & "</tr>" & chr(10)
                        else
                            if cint((i+1) mod scolumn) = 0 then
                                TempHTM = TempHTM & "</tr>" & chr(10)
                                TempHTM = TempHTM & "<tr>" & chr(10)
                            end if
                        end if
                    next
                    databox = ""
                    TempHTM = TempHTM & "</table>" & chr(10)
                    newsshow = TempHTM
                end if
            case "image"
                if IsObjInstalled("persits.jpeg") = true and jpeg_gate = 0 then
                    if show = "new" then
                        if id = 0 then
                            set rs = conn.execute("select top " & num & " classid,title,bimg,simg,filename from NCMS_news where isimg=1 and created=1 and pagetype=0 order by id desc")
                        else
                            set rs = conn.execute("select top " & num & " classid,title,bimg,simg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and isimg=1 and created=1 and pagetype=0 order by id desc")
                        end if
                    elseif show = "elite" then
                        if id = 0 then
                            set rs = conn.execute("select top " & num & " classid,title,bimg,simg,filename from NCMS_news where elite=1 and isimg=1 and created=1 and pagetype=0 order by id desc")
                        else
                            set rs = conn.execute("select top " & num & " classid,title,bimg,simg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and elite=1 and isimg=1 and created=1 and pagetype=0 order by id desc")
                        end if
                    elseif show = "hot" then
                        if id = 0 then
                            set rs = conn.execute("select top " & num & " classid,title,bimg,simg,filename from NCMS_news where click>=" & hit & " and isimg=1 and created=1 and pagetype=0 order by id desc")
                        else
                            set rs = conn.execute("select top " & num & " classid,title,bimg,simg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and click>=" & hit & " and isimg=1 and created=1 and pagetype=0 order by id desc")
                        end if
                    else
                        response.write("标签[ncms:news]参数[show]错误!")
                        response.end()
                    end if
                    if rs.eof then
                        rs.close:set rs = nothing
                        TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
                        newsshow = TempHTM
                        exit function
                    else
                        databox = rs.getrows()
                        rs.close:set rs = nothing
                        for i = 0 to ubound(databox,2)
                            TempHTM = TempHTM & "<td>" & chr(10)
                            TempHTM = TempHTM & "<div id=""simg""><a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(0,i)) & "/" & databox(4,i) & site_extname & """ target=""_" & tgt & """><img src=""" & site_root & "/" & site_upload & "/" & site_simg & "/" & databox(2,i) & """ alt=""" & databox(1,i) & """ /><br />" & gottopic(databox(1,i),len) & "</a></div>" & chr(10)
                            TempHTM = TempHTM & "</td>" & chr(10)
                            if i = ubound(databox,2) then
                                TempHTM = TempHTM & "</tr>" & chr(10)
                            else
                                if cint((i+1) mod scolumn) = 0 then
                                    TempHTM = TempHTM & "</tr>" & chr(10)
                                    TempHTM = TempHTM & "<tr>" & chr(10)
                                end if
                            end if
                            if checkfile("" & site_root & "/" & site_upload & "/" & site_bimg & "/" & databox(2,i) & "") = true then
                                set obox = server.createobject("persits.jpeg")
                                    obox.open server.mappath("" & site_root & "/" & site_upload & "/" & site_bimg & "/" & databox(2,i) & "")
                                if imgw = "" or imgh = "" then
                                    obox.width = jpeg_width
                                    obox.height = jpeg_height
                                else
                                    obox.width = imgw
                                    obox.height = imgh
                                end if
                                    obox.save server.mappath("" & site_root & "/" & site_upload & "/" & site_simg & "/" & databox(3,i) & "")
                                set obox = nothing
                            end if
                        next
                        databox = ""
                        TempHTM = TempHTM & "</tr>" & chr(10)
                        TempHTM = TempHTM & "</table>" & chr(10)
                        newsshow = TempHTM
                    end if
                else
                    if show = "new" then
                        if id = 0 then
                            set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where isimg=1 and created=1 and pagetype=0 order by id desc")
                        else
                            set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and isimg=1 and created=1 and pagetype=0 order by id desc")
                        end if
                    elseif show = "elite" then
                        if id = 0 then
                            set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where elite=1 and isimg=1 and created=1 and pagetype=0 order by id desc")
                        else
                            set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and elite=1 and isimg=1 and created=1 and pagetype=0 order by id desc")
                        end if
                    elseif show = "hot" then
                        if id = 0 then
                            set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where click>=" & hit & " and isimg=1 and created=1 and pagetype=0 order by id desc")
                        else
                            set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and click>=" & hit & " and isimg=1 and created=1 and pagetype=0 order by id desc")
                        end if
                    else
                        response.write("标签[ncms:news]参数[show]错误!")
                        response.end()
                    end if
                    if rs.eof then
                        rs.close:set rs = nothing
                        TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
                        newsshow = TempHTM
                        exit function
                    else
                        databox = rs.getrows()
                        rs.close:set rs = nothing
                        for i = 0 to ubound(databox,2)
                            TempHTM = TempHTM & "<td><div id=""simg""><a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(0,i)) & "/" & databox(3,i) & site_extname & """ target=""_" & tgt & """><img height=""" & jpeg_height & """ src=""" & site_root & "/" & site_upload & "/" & site_bimg & "/" & databox(2,i) & """ width=""" & jpeg_width & """ alt=""" & databox(1,i) & """ /></a></div></td>" & chr(10)
                            if i = ubound(databox,2) then
                                TempHTM = TempHTM & "</tr>" & chr(10)
                            else
                                if cint((i+1) mod scolumn) = 0 then
                                    TempHTM = TempHTM & "</tr>" & chr(10)
                                    TempHTM = TempHTM & "<tr>" & chr(10)
                                end if
                            end if
                        next
                        databox = ""
                        TempHTM = TempHTM & "</tr>" & chr(10)
                        TempHTM = TempHTM & "</table>" & chr(10)
                        newsshow = TempHTM
                    end if
                end if
            case else
                response.write("标签[ncms:news]参数[ty]错误!")
                response.end()
        end select
    end function
end class

class ncmsinfotag
    public len,num
    public function infoshow()
        dim TempHTM,rs,databox,i
            TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
            TempHTM = TempHTM & "<tr>" & chr(10)
        set rs = conn.execute("select top " & num & " content,addtime from NCMS_info order by addtime desc")
        if rs.eof then
            rs.close:set rs = nothing
            TempHTM = "<li><font color=""red"">暂时没有公告信息!</font></li>"
            infoshow = TempHTM
            exit function
        else
            databox = rs.getrows()
            rs.close:set rs = nothing
            for i = 0 to ubound(databox,2)
                TempHTM = TempHTM & "<td>" & gottopic(databox(0,i),len) & "(" & databox(1,i) & ")</td>" & chr(10)
            next
            databox = ""
            TempHTM = TempHTM & "</tr>" & chr(10)
            TempHTM = TempHTM & "</table>" & chr(10)
            infoshow = TempHTM
        end if
    end function
end class

class ncmsheadtag
    public ty,len,num,imgw,imgh,size
    public function headshow(stype)
        dim rs,databox,TempHTM,i,NcmsP,NcmsL,NcmsT,tempstr:tempstr = "|"
        select case stype
            case "text"
                TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
                set rs = conn.execute("select top " & num & " id,classid,title,content,filename from NCMS_news where head=1 and isimg=0 and created=1 and pagetype=0 order by id desc")
                if rs.eof then
                    rs.close:set rs = nothing
                    TempHTM = "<li><font color=""red"">暂时没有头条新闻!</font></li>"
                    headshow = TempHTM
                    exit function
                else
                    databox = rs.getrows()
                    rs.close:set rs = nothing
                    for i = 0 to ubound(databox,2)
                        TempHTM = TempHTM & "<tr><td><a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(1,i)) & "/" & databox(4,i) & site_extname & """ target=""_blank""><font size=""" & size & """><b>" & databox(2,i) & "</b></font></a></td></tr>" & chr(10)
                        TempHTM = TempHTM & "<tr><td>" & gottopic(LoseHtml(databox(3,i)),len) & "[<a href=""" & site_root & "/tools/comment.asp?newsid=" & databox(0,i) & "&newstitle=" & getnewstitle(databox(0,i)) & "#comment"" target=""_blank"" title=""评论""><font color=""red"" size=""2"">评论</font></a>]</td></tr>" & chr(10)
                    next
                    databox = ""
                    TempHTM = TempHTM & "</table>" & chr(10)
                    headshow = TempHTM
                end if
            case "image"
                set rs = conn.execute("select top " & num & " classid,title,bimg,filename from NCMS_news where head=1 and isimg=1 and created=1 and pagetype=0 order by id desc")
                if rs.eof then
                    rs.close:set rs = nothing
                    TempHTM = "<li><font color=""red"">暂时没有头条新闻!</font></li>"
                    headshow = TempHTM
                    exit function
                else
                    databox = rs.getrows()
                    rs.close:set rs = nothing
                    for i = 0 to ubound(databox,2)
                        NcmsP = NcmsP & "" & site_root & "/" & site_upload & "/" & site_bimg & "/" & databox(2,i) & tempstr & ""
                        NcmsL = NcmsL & "" & site_root & "/" & site_html & "/" & getclasspath(databox(0,i)) & "/" & databox(3,i) & site_extname & tempstr & ""
                        NcmsT = NcmsT & "" & gottopic(databox(1,i),len) & tempstr & ""
                    next
                    databox = ""
                    TempHTM = TempHTM & "" & chr(10) & "<script language=""JavaScript"" type=""text/javascript"">" & chr(10)
                    TempHTM = TempHTM & "<!--" & chr(10)
                    TempHTM = TempHTM & "var NcmsPW = " & imgw & "" & chr(10)
                    TempHTM = TempHTM & "var NcmsPH = " & imgh & "" & chr(10)
                    TempHTM = TempHTM & "var NcmsTH = 0" & chr(10)
                    TempHTM = TempHTM & "var NcmsAH = NcmsPH + NcmsTH" & chr(10)
                    TempHTM = TempHTM & "var NcmsP = '" & left(NcmsP,strlength(NcmsP) - 1) & "'" & chr(10)
                    TempHTM = TempHTM & "var NcmsL = '" & left(NcmsL,strlength(NcmsL) - 1) & "'" & chr(10)
                    TempHTM = TempHTM & "var NcmsT = '" & left(NcmsT,strlength(NcmsT) - 1) & "'" & chr(10)
                    TempHTM = TempHTM & "document.write('<object classid=""clsid:d27cdb6e-ae6d-11cf-96b8-444553540000"" codebase=""http://fpdownload.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0"" width=""'+NcmsPW+'"" height=""'+NcmsAH+'"">');" & chr(10)
                    TempHTM = TempHTM & "document.write('<param name=""allowScriptAccess"" value=""sameDomain"">');" & chr(10)
                    TempHTM = TempHTM & "document.write('<param name=""movie"" value=""" & site_root & "/images/ncms/head.swf"">');" & chr(10)
                    TempHTM = TempHTM & "document.write('<param name=""quality"" value=""high"">');" & chr(10)
                    TempHTM = TempHTM & "document.write('<param name=""bgcolor"" value=""#252f3c"">');" & chr(10)
                    TempHTM = TempHTM & "document.write('<param name=""menu"" value=""false"">');" & chr(10)
                    TempHTM = TempHTM & "document.write('<param name=""wmode"" value=""opaque"">');" & chr(10)
                    TempHTM = TempHTM & "document.write('<param name=""FlashVars"" value=""pics='+NcmsP+'&links='+NcmsL+'&texts='+NcmsT+'&borderwidth='+NcmsPW+'&borderheight='+NcmsPH+'&NcmsTHeight='+NcmsTH+'"">');" & chr(10)
                    TempHTM = TempHTM & "document.write('<embed src=""" & site_root & "/images/ncms/head.swf"" wmode=""opaque"" FlashVars=""pics='+NcmsP+'&links='+NcmsL+'&texts='+NcmsT+'&borderwidth='+NcmsPW+'&borderheight='+NcmsPH+'&NcmsTHeight='+NcmsTH+'"" menu=""false"" bgcolor=""#252f3c"" quality=""high"" width=""'+NcmsPW+'"" height=""'+NcmsAH+'"" allowScriptAccess=""sameDomain"" type=""application/x-shockwave-flash"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" />');" & chr(10)
                    TempHTM = TempHTM & "document.write('</object>');" & chr(10)
                    TempHTM = TempHTM & "//-->" & chr(10)
                    TempHTM = TempHTM & "</script>" & chr(10)
                    headshow = TempHTM
                end if
            case else
                response.write("标签[ncms:head]参数[ty]错误!")
                response.end()
        end select
    end function
end class

class ncmslinktag
    public num,ty
    public function linkshow(stype,scolumn)
        dim TempHTM,rs,databox,i
            TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
            TempHTM = TempHTM & "<tr>" & chr(10)
        select case stype
            case "text"
                set rs = conn.execute("select top " & num & " name,site from NCMS_link where kinds=0 order by orders asc")
                if rs.eof then
                    rs.close:set rs = nothing
                    TempHTM = "<li><font color=""red"">暂时没有文字连接!</font></li>"
                    linkshow = TempHTM
                    exit function
                else
                    databox = rs.getrows()
                    rs.close:set rs = nothing
                    for i = 0 to ubound(databox,2)
                        TempHTM = TempHTM & "<td><a href=""" & databox(1,i) & """ title=""" & databox(0,i) & """ target=""_blank"">" & databox(0,i) & "</a></td>" & chr(10)
                        if i = ubound(databox,2) then
                            TempHTM = TempHTM & "</tr>" & chr(10)
                        else
                            if cint((i+1) mod scolumn) = 0 then
                                TempHTM = TempHTM & "</tr>" & chr(10)
                                TempHTM = TempHTM & "<tr>" & chr(10)
                            end if
                        end if
                    next
                    databox = ""
                    TempHTM = TempHTM & "</table>" & chr(10)
                    linkshow = TempHTM
                end if
            case "image"
                set rs = conn.execute("select top " & num & " name,site,logo from NCMS_link where kinds=1 order by orders asc")
                if rs.eof then
                    rs.close:set rs = nothing
                    TempHTM = "<li><font color=""red"">暂时没有图片连接!</font></li>"
                    linkshow = TempHTM
                    exit function
                else
                    databox = rs.getrows()
                    rs.close:set rs = nothing
                    for i = 0 to ubound(databox,2)
                        TempHTM = TempHTM & "<td><a href=""" & databox(1,i) & """ target=""_blank""><img src=""" & databox(2,i) & """ alt=""" & databox(0,i) & """ /></a></td>" & chr(10)
                        if i = ubound(databox,2) then
                            TempHTM = TempHTM & "</tr>" & chr(10)
                        else
                            if cint((i+1) mod scolumn) = 0 then
                                TempHTM = TempHTM & "</tr>" & chr(10)
                                TempHTM = TempHTM & "<tr>" & chr(10)
                            end if
                        end if
                    next
                    databox = ""
                    TempHTM = TempHTM & "</table>" & chr(10)
                    linkshow = TempHTM
                end if
            case else
                response.write("标签[ncms:link]参数[ty]错误!")
                response.end()
        end select
    end function
end class

class ncmsmenutag
    public show
    public function menushow(stype)
        dim TempHTM,rs,databox,i,tempstr:tempstr = " | "
        select case stype
            case "center"
                TempHTM = "" & chr(10) & "<div id=""navbox"">" & chr(10)
                TempHTM = TempHTM & "<ul id=""nav"">" & chr(10)
                set rs = conn.execute("select id,cname,ename,isout,isurl,link from NCMS_class where parent=0 and kinds=1 order by orders asc")
                if rs.eof then
                    rs.close:set rs = nothing
                    TempHTM = ""
                    menushow = TempHTM
                    exit function
                else
                    databox = rs.getrows()
                    rs.close:set rs = nothing
                end if
                for i = 0 to ubound(databox,2)
                    if databox(4,i) = 0 then
                        TempHTM = TempHTM & "<li><a href=""" & site_root & "/" & site_html & "/" & databox(2,i) & "/index" & site_extname & """ title=""" & databox(1,i) & """>" & databox(1,i) & "</a>" & childmenushow(databox(0,i)) & "</li>" & chr(10)
                    elseif databox(3,i) = 1 then
                        if databox(4,i) = 0 then
                            TempHTM = TempHTM & "<li><a href=""" & site_root & "/" & site_html & "/" & databox(2,i) & "/" & databox(5,i) & """ title=""" & databox(1,i) & """>" & databox(1,i) & "</a>" & childmenushow(databox(0,i)) & "</li>" & chr(10)
                        elseif databox(4,i) = 1 then
                            TempHTM = TempHTM & "<li><a href=""" & databox(5,i) & """ title=""" & databox(1,i) & """>" & databox(1,i) & "</a></li>" & chr(10)
                        end if
                    end if
                next:databox = ""
                TempHTM = TempHTM & "</ul>" & chr(10)
                TempHTM = TempHTM & "</div>" & chr(10)
                menushow = TempHTM
            case "top"
                set rs = conn.execute("select id,cname,ename,isout,isurl,link from NCMS_class where parent=0 and kinds=2 order by orders asc")
                if rs.eof then
                    rs.close:set rs = nothing
                    TempHTM = ""
                    menushow = TempHTM
                    exit function
                else
                    databox = rs.getrows()
                    rs.close:set rs = nothing
                    for i = 0 to ubound(databox,2)
                        if i = ubound(databox,2) then tempstr = ""
                        if databox(3,i) = 0 then
                            TempHTM = TempHTM & "<a href=""" & site_root & "/" & site_html & "/" & databox(2,i) & "/index" & site_extname & """>" & databox(1,i) & "</a>" & tempstr & ""
                        elseif databox(3,i) = 1 then
                            if databox(4,i) = 0 then
                                TempHTM = TempHTM & "<a href=""" & site_root & "/" & site_html & "/" & databox(2,i) & "/" & databox(5,i) & """>" & databox(1,i) & "</a>" & tempstr & ""
                            elseif databox(4,i) = 1 then
                                TempHTM = TempHTM & "<a href=""" & databox(5,i) & """>" & databox(1,i) & "</a>" & tempstr & ""
                            end if
                        end if
                    next
                    menushow = TempHTM
                end if
            case "bottom"
                set rs = conn.execute("select id,cname,ename,isout,isurl,link from NCMS_class where parent=0 and kinds=3 order by orders asc")
                if rs.eof then
                    rs.close:set rs = nothing
                    TempHTM = ""
                    menushow = TempHTM
                    exit function
                else
                    databox = rs.getrows()
                    rs.close:set rs = nothing
                    for i = 0 to ubound(databox,2)
                        if i = ubound(databox,2) then tempstr = ""
                        if databox(3,i) = 0 then
                            TempHTM = TempHTM & "<a href=""" & site_root & "/" & site_html & "/" & databox(2,i) & "/"">" & databox(1,i) & "</a>" & tempstr & ""
                        elseif databox(3,i) = 1 then
                            if databox(4,i) = 0 then
                                TempHTM = TempHTM & "<a href=""" & site_root & "/" & site_html & "/" & databox(2,i) & "/" & databox(5,i) & """>" & databox(1,i) & "</a>" & tempstr & ""
                            elseif databox(4,i) = 1 then
                                TempHTM = TempHTM & "<a href=""" & databox(5,i) & """>" & databox(1,i) & "</a>" & tempstr & ""
                            end if
                        end if
                    next
                    menushow = TempHTM
                end if
            case else
                response.write("标签[ncms:menu]参数[show]错误!")
                response.end()
        end select
    end function
    private function childmenushow(id)
        dim TempHTM,rschild,box,j
            TempHTM = "" & chr(10) & "<ul>" & chr(10)
        set rschild = conn.execute("select id,cname,ename,isout,isurl,link from NCMS_class where parent=" & id & " and kinds=1 order by orders asc")
        if rschild.eof then
            rschild.close:set rschild = nothing
            TempHTM = ""
            childmenushow = TempHTM
            exit function
        else
            box = rschild.getrows()
            rschild.close:set rschild = nothing
        end if
        for j = 0 to ubound(box,2)
            if box(3,j) = 0 then
                TempHTM = TempHTM & "<li><a href=""" & site_root & "/" & site_html & "/" & box(2,j) & "/"" title=""" & box(1,j) & """>" & box(1,j) & "</a></li>" & chr(10)
            elseif box(3,j) = 1 then
                if box(4,j) = 0 then
                    TempHTM = TempHTM & "<li><a href=""" & site_root & "/" & site_html & "/" & box(2,j) & "/" & box(5,j) & """ title=""" & box(1,j) & """>" & box(1,j) & "</a></li>" & chr(10)
                elseif box(4,j) = 1 then
                    TempHTM = TempHTM & "<li><a href=""" & box(5,j) & """ title=""" & box(1,j) & """>" & box(1,j) & "</a></li>" & chr(10)
                end if
            end if
        next:box = ""
        TempHTM = TempHTM & "</ul>" & chr(10)
        childmenushow = TempHTM
    end function
end class

class ncmsrelatetag
    public len,num,lih
    public function relateshow(scolumn,classid,newsid,keywords)
        if keywords = "" or isnull(keywords) then
            relateshow = "<li><font color=""red"">暂时没有相关新闻!</font></li>"
            exit function
        end if
        dim arr,i,TempSql
            arr = split(keywords,",",3,1)
        for i = 0 to ubound(arr)
            if TempSql <> "" then
                TempSql = TempSql & "or title like '%" & arr(i) & "%' or keywords like '%" & arr(i) & "%'"
            else
                TempSql = TempSql & "title like '%" & arr(i) & "%' or keywords like '%" & arr(i) & "%'"
            end if
        next
        if TempSql <> "" then
            TempSql = "where (" & TempSql & ") and classid=" & classid & " and id <> " & newsid & " order by id desc"
        end if
        dim TempHTM:TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
            TempHTM = TempHTM & "<tr>" & chr(10)
        dim rs,databox,j
        set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news " & TempSql)
        if rs.eof then
            rs.close:set rs = nothing
            TempHTM = "<li><font color=""red"">暂时没有相关新闻!</font></li>"
            relateshow = TempHTM
        else
            databox = rs.getrows()
            rs.close:set rs = nothing
            for j = 0 to ubound(databox,2)
                TempHTM = TempHTM & "<td height=""" & lih & """ align=""left"" valign=""middle"">·<a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(0,j)) & "/" & databox(2,j) & site_extname & """ title=""" & databox(1,j) & """ target=""_blank"">" & gottopic(databox(1,j),len) & "</a></td>" & chr(10)
                if j = ubound(databox,2) then
                    TempHTM = TempHTM & "</tr>" & chr(10)
                else
                    if cint((j+1) mod scolumn) = 0 then
                        TempHTM = TempHTM & "</tr>" & chr(10)
                        TempHTM = TempHTM & "<tr>" & chr(10)
                    end if
                end if
            next
            TempHTM = TempHTM & "</table>" & chr(10)
            relateshow = TempHTM
        end if
    end function
end class

class ncmspagetag
    public show
    public function pageshow(stype,classid,newsid)
        dim TempHTM,rs,databox
            TempHTM = "" & chr(10) & "<div id=""page"">"
        select case stype
            case "last"
                set rs = conn.execute("select top 1 id,classid,title,filename from NCMS_news where classid=" & classid & " and id > " & newsid & "")
                if rs.eof or rs.bof then
                    rs.close:set rs = nothing
                    TempHTM = TempHTM & "上一篇:<font color=""red"">没有上一篇</font>"
                    TempHTM = TempHTM & "</div>" & chr(10)
                    pageshow = TempHTM
                    exit function
                else
                    databox = rs.getrows()
                    rs.close:set rs = nothing
                    TempHTM = TempHTM & "上一篇:<a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(1,0)) & "/" & databox(3,0) & site_extname & """>" & databox(2,0) & "</a>"
                    TempHTM = TempHTM & "</div>" & chr(10)
                    databox = ""
                    pageshow = TempHTM
                end if
            case "next"
                set rs = conn.execute("select top 1 id,classid,title,filename from NCMS_news where classid=" & classid & " and id < " & newsid & " order by id desc")
                if rs.eof or rs.bof then
                    rs.close:set rs = nothing
                    TempHTM = TempHTM & "下一篇:<font color=""red"">没有下一篇</font>"
                    TempHTM = TempHTM & "</div>" & chr(10)
                    pageshow = TempHTM
                    exit function
                else
                    databox = rs.getrows()
                    rs.close:set rs = nothing
                    TempHTM = TempHTM & "下一篇:<a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(1,0)) & "/" & databox(3,0) & site_extname & """>" & databox(2,0) & "</a>"
                    TempHTM = TempHTM & "</div>" & chr(10)
                    databox = ""
                    pageshow = TempHTM
                end if
            case else
                response.write("标签[news:page]参数[show]错误!")
                response.end()
        end select
    end function
end class

class X_ncmsnewstag
    public id,ty,show,len,num,lih,hit
    public function newsshow(stype,scolumn,strHtml)
        dim TempHTM,xsql,rs,databox,i
            TempHTM = "" & chr(10) & "<table cellpadding=""0"" cellspacing=""0"" width=""100%"" border=""0"">" & chr(10)
            TempHTM = TempHTM & "<tr>" & chr(10)
        select case stype
            case "text"
                if show = "new" then
                    if id = 0 then
                        set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where created=1 and pagetype=0 order by id desc")
                    else
                        set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where classid in(" & id & allchildclass(id) & ") and created=1 and pagetype=0 order by id desc")
                    end if
                elseif show = "elite" then
                    if id = 0 then
                        set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where elite=1 and created=1 and pagetype=0 order by id desc")
                    else
                        set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where classid in(" & id & allchildclass(id) & ") and elite=1 and created=1 and pagetype=0 order by id desc")
                    end if
                elseif show = "hot" then
                    if id = 0 then
                        set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where click>=" & hit & " and created=1 and pagetype=0 order by click desc")
                    else
                        set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where classid in(" & id & allchildclass(id) & ") and click>=" & hit & " and created=1 and pagetype=0 order by click desc")
                    end if
                else
                    response.write("标签[ncms:free]参数[show]错误!")
                    response.end()
                end if
            case "image"
                if show = "new" then
                    if id = 0 then
                        set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where isimg=1 and created=1 and pagetype=0 order by id desc")
                    else
                        set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where classid in(" & id & allchildclass(id) & ") and isimg=1 and created=1 and pagetype=0 order by id desc")
                    end if
                elseif show = "elite" then
                    if id = 0 then
                        set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where isimg=1 and elite=1 and created=1 and pagetype=0 order by id desc")
                    else
                        set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where classid in(" & id & allchildclass(id) & ") and isimg=1 and elite=1 and created=1 and pagetype=0 order by id desc")
                    end if
                elseif show = "hot" then
                    if id = 0 then
                        set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where isimg=1 and click>=" & hit & " and created=1 and pagetype=0 order by click desc")
                    else
                        set rs = conn.execute("select top " & num & " id,classid,title,content,click,isimg,bimg,simg,filename,addtime from NCMS_news where classid in(" & id & allchildclass(id) & ") and isimg=1 and click>=" & hit & " and created=1 and pagetype=0 order by click desc")
                    end if
                else
                    response.write("标签[ncms:free]参数[show]错误!")
                    response.end()
                end if
            case else
                response.write("标签[ncms:free]参数[ty]错误!")
                response.end()
        end select
        if rs.eof then
            rs.close:set rs = nothing
            TempHTM = "<li><font color=""red"">暂时没有新闻!</font></li>"
            newsshow = TempHTM
            exit function
        else
            databox = rs.getrows()
            rs.close:set rs = nothing
            for i = 0 to ubound(databox,2)
                TempHTM = TempHTM & "<td height=""" & lih & """ align=""left"" valign=""middle"">" & strHtml & "</td>" & chr(10)
                if i = ubound(databox,2) then
                    TempHTM = TempHTM & "</tr>" & chr(10)
                else
                    if cint((i+1) mod scolumn) = 0 then
                        TempHTM = TempHTM & "</tr>" & chr(10)
                        TempHTM = TempHTM & "<tr>" & chr(10)
                    end if
                end if
                dim charclass,PatrnStr
                set charclass = new stringclass
                PatrnStr = "\{\$classname\$\}"
                TempHTM = charclass.replacestr(PatrnStr,TempHTM,"<a href=""" & site_root & "/" & site_html & "/" & getclasspath(databox(1,i)) & "/index" & site_extname & """ target=""_blank"">" & getclassname(databox(1,i)) & "</a>")
                PatrnStr = "\{\$title\$\}"
                TempHTM = charclass.replacestr(PatrnStr,TempHTM,gottopic(LoseHtml(databox(2,i)),len))
                PatrnStr = "\{\$content\$\}"
                TempHTM = charclass.replacestr(PatrnStr,TempHTM,gottopic(LoseHtml(databox(3,i)),len))
                PatrnStr = "\{\$click\$\}"
                TempHTM = charclass.replacestr(PatrnStr,TempHTM,databox(4,i))
                PatrnStr = "\{\$filepath\$\}"
                TempHTM = charclass.replacestr(PatrnStr,TempHTM,"" & site_root & "/" & site_html & "/" & getclasspath(databox(1,i)) & "/" & databox(8,i) & site_extname & "")
                PatrnStr = "\{\$addtime\$\}"
                TempHTM = charclass.replacestr(PatrnStr,TempHTM,formattagdate(databox(9,i),datestyle))
                PatrnStr = "\{\$imgpath\$\}"
                if IsObjInstalled("persits.jpeg") = true and jpeg_gate = 0 then
                    TempHTM = charclass.replacestr(PatrnStr,TempHTM,"" & site_root & "/" & site_upload & "/" & site_simg & "/" & databox(7,i) & "")
                else
                    TempHTM = charclass.replacestr(PatrnStr,TempHTM,"" & site_root & "/" & site_upload & "/" & site_bimg & "/" & databox(6,i) & "")
                end if
                PatrnStr = "\{\$comment\$\}"
                TempHTM = charclass.replacestr(PatrnStr,TempHTM,"[<a href=""" & site_root & "/tools/comment.asp?newsid=" & databox(0,i) & "&newstitle=" & getnewstitle(databox(0,i)) & "#comment"" target=""_blank"" title=""评论""><font color=""red"" size=""2"">评论</font></a>]")
            next
            databox = ""
            TempHTM = TempHTM & "</table>" & chr(10)
            newsshow = TempHTM
        end if
    end function
end class

function guide(id)
    dim TempHTM
    if id = "" or len(id) = 0 or not isnumeric(id) then
        TempHTM = "当前位置 : <a href=""" & site_root & "/index" & site_extname & """>首页</a> >>"
    else
        dim rs
        set rs = conn.execute("select top 1 id,parent,cname,ename from NCMS_class where id=" & id)
        if not rs.eof then
            TempHTM = TempHTM & guide(rs("parent"))
            TempHTM = TempHTM & "<a href=""" & site_root & "/" & site_html & "/" & rs("ename") & "/index" & site_extname & """>" & rs("cname") & "</a> >> "
        end if
        rs.close:set rs = nothing
        if id = 0 then
            TempHTM = TempHTM & "当前位置 : <a href=""" & site_root & "/index" & site_extname & """>首页</a> >> "
        end if
    end if
    guide = TempHTM
end function

function createindex()
    dim Temp:Temp = ""
        Temp = processcustomtag(loadtempletfile("../templet/" & site_dtemp & ""))
        Temp = X_processcustomtag(Temp)
    dim charclass
    set charclass = new stringclass
    dim PatrnStr
        PatrnStr = "<title>.*?</title>"
        Temp = charclass.replacestr(PatrnStr,Temp,"<title>" & site_name & "</title>")
        PatrnStr = "\{\$guide\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,guide(""))
        PatrnStr = "\{\$keywords\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,site_keywords)
        PatrnStr = "\{\$search\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,search())
        PatrnStr = "\{\$description\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,site_description)
        PatrnStr = "\{\$copyright\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,site_copyright)
        PatrnStr = "\{\$root\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,site_root)
    dim sPATH:sPATH = "" & site_root & "/index" & site_extname & ""
    dim objstream
    set objstream = server.createobject("adodb.stream")
    with objstream
        .open
        .charset = "" & chrset & ""
        .position = objstream.size
        .writetext = Temp
        .savetofile server.mappath(sPATH),2
        .close
    end with
    set objstream = nothing
    if err.number <> 0 then
        err.clear
        createindex = false
    else
        createindex = true
    end if
end function

function createnewsclass(id)
    dim arrcont:arrcont = getcurclasscount(id)
    dim i,j
    for i = 0 to arrcont - 1
        dim Temp:Temp = ""
            Temp = processcustomtag(loadtempletfile("../templet/" & getclassall(id,1) & ""))
            Temp = X_processcustomtag(Temp)
        dim charclass
        set charclass = new stringclass
        dim PatrnStr
            PatrnStr = "<title>.*?</title>"
            Temp = charclass.replacestr(PatrnStr,Temp,"<title>" & charclass.getstr(getclassname(id)) & " - " & site_name & "</title>")
            PatrnStr = "\{\$guide\$\}"
            Temp = charclass.replacestr(PatrnStr,Temp,guide(id))
            PatrnStr = "\{\$keywords\$\}"
            Temp = charclass.replacestr(PatrnStr,Temp,site_keywords)
            PatrnStr = "\{\$search\$\}"
            Temp = charclass.replacestr(PatrnStr,Temp,search())
            PatrnStr = "\{\$description\$\}"
            Temp = charclass.replacestr(PatrnStr,Temp,site_description)
            PatrnStr = "\{\$copyright\$\}"
            Temp = charclass.replacestr(PatrnStr,Temp,site_copyright)
            PatrnStr = "\{\$root\$\}"
            Temp = charclass.replacestr(PatrnStr,Temp,site_root)
        dim sPATH,cPATH:cPATH = "" & site_root & "/" & site_html & "/" & getclasspath(id) & "/"
        createdir(server.mappath(cPATH))
        dim PageHTM:PageHTM = ""
        if i = 0 then
            sPATH = "" & cPATH & "index" & site_extname & ""
        else
            sPATH = "" & cPATH & "index" & site_extname & ""
            sPATH = left(sPATH,(len(sPATH)-len(site_extname))) & "_" & i + 1 & site_extname
        end if
        if arrcont >= 2 then
            if i = 0 then
                PageHTM = PageHTM & "【首页】-"
                PageHTM = PageHTM & "【上页】"
            end if
            if i > 1 then
                PageHTM = PageHTM & "【<a href=""index" & site_extname & """>首页</a>】-"
                PageHTM = PageHTM & "【<a href=""index" & "_" & i & site_extname & """>上页</a>】"
            end if
            if i = 1 Then
                PageHTM = PageHTM & "【<a href=""index" & site_extname & """>首页</a>】-"
                PageHTM = PageHTM & "【<a href=""index" & site_extname & """>上页</a>】"
            end if
            PageHTM = PageHTM & "-【第<font color=""red"">" & i + 1 & "</font>页】/【共<font color=""red"">" & arrcont & "</font>页】-"
            if i < arrcont - 1 then
                PageHTM = PageHTM & "【<a href=""index" & "_" & i + 2 & site_extname & """>下页</a>】-"
                PageHTM = PageHTM & "【<a href=""index" & "_" & arrcont & site_extname & """>尾页</a>】- "
            end if
            if i = arrcont - 1 then
                PageHTM = PageHTM & "【下页】-"
                PageHTM = PageHTM & "【尾页】- "
            end if
            PageHTM = PageHTM & "<select name=""page"" onchange=""self.location.href=this.options[this.selectedIndex].value"">"
            PageHTM = PageHTM & "<option selected>页/码</option>"
            PageHTM = PageHTM & "<option value=""index" & site_extname & """>第1页</option>"
            for j = 1 to arrcont - 1
                PageHTM = PageHTM & "<option value=""index" & "_" & j + 1 & site_extname & """>第" & j + 1 & "页</option>"
            next
            PageHTM = PageHTM & "</select>"
        end if
            PatrnStr = "{news:[^<>]+?\/}"
            Temp = charclass.classcustomtag(PatrnStr,Temp,id,i + 1,"<p align=""center"">" & PageHTM & "</p>" & chr(10) & "")
        dim objstream
        set objstream = server.createobject("adodb.stream")
        with objstream
            .open
            .charset = "" & chrset & ""
            .position = objstream.size
            .writetext = Temp
            .savetofile server.mappath(sPATH),2
            .close
        end with
    next
    set objstream = nothing
    if err.number <> 0 then
        err.clear
        createnewsclass = false
    else
        createnewsclass = true
    end if
end function

function createnewsfile(id)
    dim rs,sql
    set rs = server.createobject("adodb.recordset")
    sql = "select id,classid,title,content,author,source,keywords,bimg,simg,filename,pagetype,addtime from NCMS_news where id=" & id
    rs.open sql,conn,1,1
    dim databox:databox = rs.getrows()
    rs.close:set rs = nothing
    dim Temp:Temp = ""
    if databox(10,0) = 0 then
        Temp = processcustomtag(loadtempletfile("../templet/" & getclassall(databox(1,0),2) & ""))
        Temp = X_processcustomtag(Temp)
    else
        Temp = processcustomtag(loadtempletfile("../templet/" & site_stemp & ""))
        Temp = X_processcustomtag(Temp)
    end if
    dim charclass
    set charclass = new stringclass
    dim PatrnStr,AdvCont
        PatrnStr = "<title>.*?</title>"
        Temp = charclass.replacestr(PatrnStr,Temp,"<title>" & charclass.getstr(databox(2,0)) & " - " & site_name & "</title>")
        PatrnStr = "{news:[^<>]+?\/}"
        Temp = charclass.newscustomtag(PatrnStr,Temp,databox(1,0),databox(0,0),databox(6,0))
        PatrnStr = "\{\$id\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,databox(0,0))
        PatrnStr = "\{\$classid\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,databox(1,0))
        PatrnStr = "\{\$title\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,databox(2,0))
        PatrnStr = "\{\$author\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,databox(4,0))
        PatrnStr = "\{\$source\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,databox(5,0))
        PatrnStr = "\{\$keywords\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,databox(6,0))
        PatrnStr = "\{\$click\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,click(databox(0,0)))
        PatrnStr = "\{\$addtime\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,databox(11,0))
        PatrnStr = "\{\$guide\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,guide(databox(1,0)))
        PatrnStr = "\{\$search\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,search())
        PatrnStr = "\{\$fontselect\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,fontselect())
        PatrnStr = "\{\$toolbar\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,toolbar(databox(0,0)))
        PatrnStr = "\{\$copyurl\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,copyurl())
        PatrnStr = "\{\$description\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,site_description)
        PatrnStr = "\{\$copyright\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,site_copyright)
        PatrnStr = "\{\$root\$\}"
        Temp = charclass.replacestr(PatrnStr,Temp,site_root)
        PatrnStr = "\{\$advarea\$\}"
        AdvCont = databox(3,0)
        AdvCont = charclass.replacestr(PatrnStr,AdvCont,advshow(site_advcode))
    dim tempArr,n,sPATH,ePATH,cPATH:cPATH = "" & site_root & "/" & site_html & "/" & getclasspath(databox(1,0)) & "/"
    if instr(databox(9,0),"/") = 0 then
        createdir(server.mappath(cPATH))
    else
        tempArr = split(databox(9,0),"/")
        for n = 0 to ubound(tempArr)
            ePATH = replace(databox(9,0),tempArr(n),"")
        next
        createdir(server.mappath(cPATH & ePATH))
    end if
    dim TTemp:TTemp = Temp
    dim arrcont:arrcont = split(AdvCont,"{$split$}",-1,1)
    dim PageHTM:PageHTM = ""
    dim i,j,k:k = ubound(arrcont)
    for i = 0 to k
        if i = 0 then
            sPATH = "" & cPATH & databox(9,0) & site_extname & ""
        else
            sPATH = "" & cPATH & databox(9,0) & site_extname & ""
            sPATH = left(sPATH,(len(sPATH)-len(site_extname))) & "_" & i + 1 & site_extname
        end if
        if sPATH = "" then
            createnewsfile = false
            exit function
        end if
        if k >= 1 then
            PageHTM = "<p align=""center"">【本新闻共<font color=""red"">" & k + 1 & "</font>页】-"
            if i = 0 then
                PageHTM = PageHTM & "【首页】-"
                PageHTM = PageHTM & "【上页】-"
            end if
            if i > 1 then
                PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & site_extname & """>首页</a>】-"
                PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & "_" & i & site_extname & """>上页</a>】-"
            end if
            if i = 1 Then
                PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & site_extname & """>首页</a>】-"
                PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & site_extname & """>上页</a>】-"
            end if
            if i < k then
                PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & "_" & i + 2 & site_extname & """>下页</a>】-"
                PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & "_" & k + 1 & site_extname & """>尾页</a>】-"
            end if
            if i = k then
                PageHTM = PageHTM & "【下页】-"
                PageHTM = PageHTM & "【尾页】-"
            end if
            PageHTM = PageHTM & "【当前在第<font color=""red"">" & i + 1 & "</font>页】</p>"
        else
            PageHTM = ""
        end if
        PatrnStr = "\{\$content\$\}"
        Temp = charclass.replacestr(PatrnStr,TTemp,"" & chr(10) & "<div id=""content"">" & chr(10) & arrcont(i) & PageHTM & chr(10) & "</div>" & chr(10))
        dim objstream
        set objstream = server.createobject("adodb.stream")
        with objstream
            .open
            .charset = "" & chrset & ""
            .position = objstream.size
            .writetext = X_processcustomtag(Temp)
            .savetofile server.mappath(sPATH),2
            .close
        end with
        set objstream = nothing
    next
    if err.number <> 0 then
        err.clear
        createnewsfile = false
    else
        conn.execute("update NCMS_news set created=1 where id=" & databox(0,0))
        createnewsfile = true
        databox = ""
    end if
end function

function createnewsjs(show,id,len,num,lih,col,filename)
    dim TempHTM,xsql,rs,databox,i
        TempHTM = "document.writeln('<table cellpadding=\""0\"" cellspacing=\""0\"" width=\""100%\"" border=\""0\"">');"
        TempHTM = TempHTM & "document.writeln('<tr>');"
    select case show
        case "new"
            if id = 0 then
                set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where created=1 and pagetype=0 order by id desc")
            else
                set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and created=1 and pagetype=0 order by id desc")
            end if
        case "elite"
            if id = 0 then
                set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where elite=1 and created=1 and pagetype=0 order by id desc")
            else
                set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and elite=1 and created=1 and pagetype=0 order by id desc")
            end if
        case "hot"
            if id = 0 then
                set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where click>=100 and created=1 and pagetype=0 order by click desc")
            else
                set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and click>=100 and created=1 and pagetype=0 order by click desc")
            end if
        case else
            response.write("[新闻类型]参数错误!")
            response.end()
    end select
    if rs.eof then
        rs.close:set rs = nothing
        TempHTM = "document.writeln('<li><font color=\""red\"">暂时没有新闻!<\/font><\/li>');"
    else
        databox = rs.getrows()
        rs.close:set rs = nothing
        for i = 0 to ubound(databox,2)
            TempHTM = TempHTM & "document.writeln('<td height=\""" & lih & "\"" align=\""left\"" valign=\""middle\"">·<a href=\""" & site_root & "/" & site_html & "/" & getclasspath(databox(0,i)) & "/" & databox(2,i) & site_extname & "\"" title=\""" & databox(1,i) & "\"" target=\""_blank\"">" & gottopic(databox(1,i),len) & "<\/a><\/td>');"
            if i = ubound(databox,2) then
                TempHTM = TempHTM & "document.writeln('<\/tr>');"
            else
                if cint((i+1) mod col) = 0 then
                    TempHTM = TempHTM & "document.writeln('<\/tr>');"
                    TempHTM = TempHTM & "document.writeln('<tr>');"
                end if
            end if
        next
        databox = ""
        TempHTM = TempHTM & "document.writeln('<\/table>');"
    end if
    if checkfolder("" & site_root & "/jss/") = false then
        createdir(server.mappath("" & site_root & "/jss/"))
    end if
    if checkfile("" & site_root & "/jss/" & filename & ".js") = true then
        call alertbox("文件已存在!请更换文件名!",2)
    end if
    dim objstream
    set objstream = server.createobject("adodb.stream")
    with objstream
        .open
        .charset = "" & chrset & ""
        .position = objstream.size
        .writetext = TempHTM
        .savetofile server.mappath("" & site_root & "/jss/" & filename & ".js"),2
        .close
    end with
    set objstream = nothing
    if err.number <> 0 then
        err.clear
        createnewsjs = false
    else
        createnewsjs = true
    end if
end function

function getnewstitle(id)
    dim rs,tempstr
    set rs = conn.execute("select title from NCMS_news where id=" & id)
    if not rs.eof then
        tempstr = server.urlencode(rs("title"))
    end if
    rs.close:set rs = nothing
    getnewstitle = tempstr
end function

function getclasspath(id)
    dim rs,tempstr
    set rs = conn.execute("select ename from NCMS_class where id=" & id)
    if not rs.eof then
        tempstr = rs("ename")
    end if
    rs.close:set rs = nothing
    getclasspath = tempstr
end function

function getclassid(id)
    dim rs,tempstr
    set rs = conn.execute("select classid from NCMS_news where id=" & id)
    if not rs.eof then
        tempstr = rs("classid")
    end if
    rs.close:set rs = nothing
    getclassid = tempstr
end function

function getclassname(id)
    dim rs,tempstr
    set rs = conn.execute("select cname from NCMS_class where id= " & id)
    if not rs.eof then
        tempstr = rs("cname")
    end if
    rs.close:set rs = nothing
    getclassname = tempstr
end function

function allchildclass(id)
    dim rs
    set rs = conn.execute("select id from NCMS_class where parent=" & id)
    while not rs.eof
        allchildclass = allchildclass & "," & rs("id")
        allchildclass = allchildclass & allchildclass(rs("id"))
    rs.movenext
    wend
    rs.close:set rs = nothing
end function

function getclassall(id,stype)
    dim rs,tempstr
    select case stype
        case "1"
            set rs = conn.execute("select ctemp from NCMS_class where id=" & id)
            if not rs.eof then
                tempstr = rs("ctemp")
            end if
            rs.close:set rs = nothing
            getclassall = tempstr
        case "2"
            set rs = conn.execute("select ntemp from NCMS_class where id=" & id)
            if not rs.eof then
                tempstr = rs("ntemp")
            end if
            rs.close:set rs = nothing
            getclassall = tempstr
        case "3"
            set rs = conn.execute("select fname from NCMS_class where id=" & id)
            if not rs.eof then
                tempstr = rs("fname")
            end if
            rs.close:set rs = nothing
            getclassall = tempstr
        case else
            response.write("获取栏目属性失败!")
            response.end()
    end select
end function

function advshow(advcode)
    if advcode = "" then
        advshow = ""
        exit function
    else
        dim advarr
            advarr = split(advcode,"|||")
        if ubound(advarr) = 0 then
            advshow = "" & chr(10) & "<table style=""padding:0px;width:250px;height:250px"" cellspacing=""0"" cellpadding=""0"" align=""left"" border=""0"">" & chr(10)
            advshow = advshow & "<tr>" & chr(10)
            advshow = advshow & "<td>" & advcode & "</td>" & chr(10)
            advshow = advshow & "</tr>" & chr(10)
            advshow = advshow & "</table>" & chr(10)
        else
            dim n:randomize
                n = int((ubound(advarr) + 1) * rnd)
            advshow = "" & chr(10) & "<table style=""padding:0px;width:250px;height:250px"" cellspacing=""0"" cellpadding=""0"" align=""left"" border=""0"">" & chr(10)
            advshow = advshow & "<tr>" & chr(10)
            advshow = advshow & "<td>" & advarr(n) & "</td>" & chr(10)
            advshow = advshow & "</tr>" & chr(10)
            advshow = advshow & "</table>" & chr(10)
        end if
    end if
end function

function click(id)
    click = "<script language=""javascript"" type=""text/javascript"" src=""" & site_root & "/tools/click.asp?id=" & id & """></script>"
end function

function fontselect()
    fontselect = "" & chr(10) & "<div id=""fontselect"">" & chr(10)
    fontselect = fontselect & "<ul>" & chr(10)
    fontselect = fontselect & "<li id=""explain"">字体大小</li>" & chr(10)
    fontselect = fontselect & "<li><a href=""javascript:doZoom(12)"">小</a></li>" & chr(10)
    fontselect = fontselect & "<li><a href=""javascript:doZoom(14)"">中</a></li>" & chr(10)
    fontselect = fontselect & "<li><a href=""javascript:doZoom(16)"">大</a></li>" & chr(10)
    fontselect = fontselect & "</ul>" & chr(10)
    fontselect = fontselect & "</div>" & chr(10)
end function

function toolbar(id)
    toolbar = "" & chr(10) & "<div id=""toolbar"">" & chr(10)
    toolbar = toolbar & "<ul>" & chr(10)
    toolbar = toolbar & "<li id=""explain"">浏览工具</li>" & chr(10)
    toolbar = toolbar & "<li><a href=""" & site_root & "/tools/comment.asp?newsid=" & id & "&newstitle=" & getnewstitle(id) & "#comment"" target=""_blank"" title=""新闻评论"">新闻评论</a><li>" & chr(10)
    toolbar = toolbar & "<li><a href=""javascript:window.print()"" title=""打印本文"">打印本文</a><li>" & chr(10)
    toolbar = toolbar & "<li><a href=""javascript:window.close()"" title=""关闭本页"">关闭本页</a><li>" & chr(10)
    toolbar = toolbar & "<li><a href=""javascript:scroll(0,0)"" title=""返回页首"">返回页首</a><li>" & chr(10)
    toolbar = toolbar & "</ul>" & chr(10)
    toolbar = toolbar & "</div>" & chr(10)
end function

function copyurl()
    copyurl = "" & chr(10) & "<div id=""copyurl"">" & chr(10)
    copyurl = copyurl & "<script language=""javascript"" type=""text/javascript"">document.write('<input name=""url"" type=""text"" value=""' + window.location.href + '"" readonly=""true"" /><input name=""btn"" type=""button"" value=""复制本页地址与好友分享"" onclick=""copyurl();"" />');</script>" & chr(10)
    copyurl = copyurl & "</div>" & chr(10)
end function

function search()
    search = "" & chr(10) & "<div id=""search"">" & chr(10)
    search = search & "<form name=""form"" action=""" & site_root & "/tools/search.asp"" method=""get"">" & chr(10)
    search = search & "<input name=""kw"" type=""text"" value="""" />" & chr(10)
    search = search & "<select name=""tn"">" & chr(10)
    search = search & "<option value=""1"">标题</option>" & chr(10)
    search = search & "<option value=""2"">作者</option>" & chr(10)
    search = search & "<option value=""3"">内容</option>" & chr(10)
    search = search & "</select>" & chr(10)
    search = search & "<input name=""do"" type=""hidden"" value=""ok"" />" & chr(10)
    search = search & "<input name=""search"" type=""submit"" value=""搜索"" />" & chr(10)
    search = search & "</form>" & chr(10)
    search = search & "</div>" & chr(10)
end function

function rannumkey(digits)
    dim chararray(10)
        chararray(0) = "0"
        chararray(1) = "1"
        chararray(2) = "2"
        chararray(3) = "3"
        chararray(4) = "4"
        chararray(5) = "5"
        chararray(6) = "6"
        chararray(7) = "7"
        chararray(8) = "8"
        chararray(9) = "9"
    randomize
    do while len(output) < digits
        dim num:num = cstr(chararray(int((10-0+1) * rnd + 0)))
        dim output:output = output + num
    loop
    rannumkey = output
end function

function makefntype(datestr,types,classid)
    select case types
        case "1"
            makefntype = year(datestr) & "/" & month(datestr) & "-" & day(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年/月-日/随机数
        case "2"
            makefntype = year(datestr) & "/" & month(datestr) & "/" & day(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年/月/日/随机数
        case "3"
            makefntype = year(datestr) & "-" & month(datestr) & "-" & day(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年-月-日/随机数
        case "4"
            makefntype = year(datestr) & "-" & month(datestr) & "/" & day(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年-月/日/随机数
        case "5"
            makefntype = year(datestr) & "/" & month(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年/月/随机数
        case "6"
            makefntype = year(datestr) & "-" & month(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年-月/随机数
        case "7"
            makefntype = year(datestr) & month(datestr) & day(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年月日/随机数
        case "8"
            makefntype = year(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年/随机数
        case "9"
            makefntype = year(datestr) & month(datestr) & day(datestr) & rannumkey(3) '年月日随机数
        case "10"
            makefntype = getclassall(classid,3) & rannumkey(16) '16位随机数
        case "11"
            makefntype = getclassall(classid,3) & md5(datestr & rannumkey(3),16) '16位md5加密字符
        case "12"
            makefntype = getclassall(classid,3) & year(datestr) & month(datestr) & day(datestr) & hour(datestr) & minute(datestr) & second(datestr) & rannumkey(3) '年月日时分秒随机数
        case else
            makefntype = getclassall(classid,3) & year(datestr) & month(datestr) & day(datestr) & hour(datestr) & minute(datestr) & second(datestr) & rannumkey(3) '年月日时分秒随机数
    end select
end function

function dateformat(datestr,types)
    dim datestring
    if isdate(datestr) = false then
        datestring = ""
    end if
    select case types
        case "1" 
            datestring = year(datestr) & "-" & month(datestr) & "-" & day(datestr)
        case "2"
            datestring = year(datestr) & "." & month(datestr) & "." & day(datestr)
        case "3"
            datestring = month(datestr) & "-" & day(datestr) & "-" & year(datestr)
        case "4"
            datestring = month(datestr) & "." & day(datestr) & "." & year(datestr)
        case "5"
            datestring = year(datestr) & month(datestr) & day(datestr)
        case "6"
            datestring = hour(datestr) & minute(datestr) & second(datestr)
        case "7"
            datestring = year(datestr) & "年" & month(datestr) & "月" & day(datestr) & "日"
        case else
            datestring = datestr
    end select
    dateformat = datestring
end function

function formattagdate(mdate,temp)
    if not isdate(mdate) or temp = "" then
        formattagdate = temp
        exit function
    end if
    dim myear:myear = year(mdate)
    dim mmonth:mmonth = month(mdate)
    dim mday:mday = day(mdate)
    dim mhour:mhour = hour(mdate)
    dim mmin:mmin = minute(mdate)
    dim msec:msec = second(mdate)
    temp = replace(temp,"{Y}",year(mdate))
    temp = replace(temp,"{y}",right(year(mdate),2))
    temp = replace(temp,"{M}",month(mdate))
    temp = replace(temp,"{m}",right("00" & month(mdate),2))
    temp = replace(temp,"{D}",day(mdate))
    temp = replace(temp,"{d}",right("00" & day(mdate),2))
    formattagdate = temp
end function

function strlength(str)
    on error resume next
    dim winnt_chinese
        winnt_chinese = (len("中国") = 2)
    if winnt_chinese then
        dim l, t, c
        dim i
        l = len(str)
        t = l
        for i = 1 to l
            c = asc(mid(str,i,1))
            if c < 0 then c = c + 65536
            if c > 255 then
                t = t + 1
            end if
        next
        strlength = t
    else
        strlength = len(str)
    end if
    if err.number <> 0 then err.clear
end function

function gottopic(byval str,byval strlen)
    if str = "" or str = null then
        gottopic = ""
        exit function
    end if
    dim l,t,c,i,tstr
    str = replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<")
    l = len(str)
    t = 0
    tstr = str
    strlen = clng(strlen)
    for i = 1 to l
        c = abs(asc(mid(str,i,1)))
        if c > 255 then
             t = t + 2
        else
            t = t + 1
        end if
        if t >= strlen then
            tstr = left(str,i)
            exit for
        end if
    next
    if tstr <> str then
        tstr = tstr & "..."
    end if
    gottopic = replace(replace(replace(replace(tstr," "," "),chr(34),"""),">",">"),"<","<")
end function

function insertchr(num)
    dim str1:str1 = "├"
    dim str2:str2 = ""
    dim iii
    for iii = 2 to num
        str2 = str2 & "│ "
    next
    insertchr = str2&str1
end function

class classlist
    private class_id
    private class_table
    private class_parentid
    private class_name

    public property let id(str)
        class_id = str
    end property

    public property let table(str)
        class_table = str
    end property

    public property let parentid(str)
        class_parentid = str
    end property

    public property let name(str)
        class_name = str
    end property

    dim list()
    dim i,n
    private sub class_initialize()
        i = 0:n = 0
    end sub

    public function classarry(thisid,id)
        dim rsclass,classsql
        if id > 0 then
            classsql = "select * from " & class_table & " where " & class_parentid & "=" & thisid
        else
            classsql = "select * from " & class_table & " where " & class_id & "=" & thisid
        end if
        set rsclass = conn.execute(classsql)
        n = n + 1
        do while not rsclass.eof
            list(0,i) = rsclass(class_id)
            list(1,i) = rsclass(class_name)
            list(2,i) = n
            i = i + 1
            thisid = classarry(rsclass(class_id),1)
            rsclass.movenext
        loop
        n = n - 1
        rsclass.close
    end function

    public function arrylist()
        dim rsclass
        set rsclass = conn.execute("select count(" & class_id & ") from " & class_table)
        dim lenght
            lenght = rsclass(0)
        rsclass.close
        redim list(2,lenght)
        dim rspclass
        set rspclass = conn.execute("select " & class_id & " from " & class_table & " where " & class_parentid & "=0")
        do while not rspclass.eof
            call classarry(rspclass(class_id),0)
            rspclass.movenext
        loop
        rspclass.close
        arrylist = list
    end function
end class

class imginfo
    dim aso
    private sub class_initialize
        set aso = createobject("adodb.stream")
        aso.mode = 3
        aso.type = 1
        aso.open
    end sub

    private sub class_terminate
        err.clear
        set aso = nothing
    end sub

    private function bin2str(bin)
        dim i,str,clow
        for i = 1 to lenb(bin)
            clow = midb(bin,i,1)
            if ascb(clow) < 128 then
                str = str & chr(ascb(clow))
            else
                i = i + 1
                if i <= lenb(bin) then
                    str = str & chr(ascw(midb(bin,i,1)&clow))
                end if
            end if
        next
        bin2str = str
    end function

    private function num2str(num,base,lens)
        dim ret
            ret = ""
        while(num>=base)
            ret = (num mod base) & ret
            num = (num - num mod base)/base
        wend
        num2str = right(string(lens,"0") & num & ret,lens)
    end function

    private function str2num(str,base)
        dim ret
            ret = 0
        for i = 1 to len(str)
            ret = ret *base + cint(mid(str,i,1))
        next
        str2num = ret
    end function

    private function binval(bin)
        dim ret
            ret = 0
        dim i
        for i = lenb(bin) to 1 step -1
            ret = ret*256 + ascb(midb(bin,i,1))
        next
        binval = ret
    end function

    private function binval2(bin)
        dim ret
            ret = 0
        Dim i
        for i = 1 to lenb(bin)
            ret = ret*256 + ascb(midb(bin,i,1))
        next
        binval2 = ret
    end function

    private function getimagesize(filespec)
        dim ret(3)
            aso.loadfromfile(filespec)
        dim bflag
            bflag = aso.read(3)
        select case hex(binval(bflag))
            case "4E5089":
                aso.read(15)
                ret(0) = "PNG"
                ret(1) = binval2(aso.read(2))
                aso.read(2)
                ret(2) = binval2(aso.read(2))
            case "464947": 
                aso.read(3)
                ret(0) = "GIF"
                ret(1) = binval(aso.read(2))
                ret(2) = binval(aso.read(2))
            case "535746":
                aso.read(5)
                bindata = aso.read(1)
                sconv = num2str(ascb(bindata),2,8)
                nbits = str2num(left(sconv,5),2)
                sconv = mid(sconv,6)
                while(len(sconv)<nbits*4)
                    bindata = aso.read(1)
                    sconv = sconv & num2str(ascb(bindata),2,8)
                wend
                ret(0) = "SWF"
                ret(1) = int(abs(str2num(mid(sconv,1*nbits+1,nbits),2)-str2num(mid(sconv,0*nbits+1,nbits),2))/20)
                ret(2) = int(abs(str2num(mid(sconv,3*nbits+1,nbits),2)-str2num(mid(sconv,2*nbits+1,nbits),2))/20)
            case "FFD8FF":
                do
                dim p1
                do:p1 = binval(aso.read(1)):loop while p1 = 255 and not aso.eos
                if p1 > 191 and p1 < 196 then exit do else aso.read(binval2(aso.read(2))-2) 
                do:p1 = binval(aso.read(1)):loop while p1 < 255 and not aso.eos
                loop while true
                aso.read(3)
                ret(0) = "JPG"
                ret(2) = binval2(aso.read(2))
                ret(1) = binval2(aso.read(2))
            case else:
                if left(bin2str(bflag),2) = "BM" then
                    aso.read(15)
                    ret(0) = "BMP"
                    ret(1) = binval(aso.read(4))
                    ret(2) = binval(aso.read(4))
                else
                    ret(0) = ""
                end if
            end select
            ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &""""
            getimagesize = ret
    end function

    public function imgW(pic_path)
        dim imgfso
        set imgfso = server.createobject("scripting.filesystemobject")
        if (imgfso.fileexists(pic_path)) then
            dim imgfs,ext
            set imgfs = imgfso.getfile(pic_path)
            ext = imgfso.getextensionname(pic_path)
            select case ext
                case "gif","bmp","jpg","png":
                    dim arr
                        arr = getimagesize(imgfs.path)
                    imgW = arr(1)
            end select
            set imgfs = nothing
        else
            imgW = 0
        end if
        set imgfso = nothing
    end function

    public function imgH(pic_path)
        dim imgfso
        set imgfso = server.createobject("scripting.filesystemobject")
        if (imgfso.fileexists(pic_path)) then
            dim imgfs,ext
            set imgfs = imgfso.getfile(pic_path)
            ext = imgfso.getextensionname(pic_path)
            select case ext
                case "gif","bmp","jpg","png":
                    dim arr
                        arr = getimagesize(imgfs.path)
                    imgH = arr(2)
            end select
            set imgfs = nothing
        else
            imgH = 0
        end if
        set imgfso = nothing
    end function
end class

function gfv(str)
    gfv = request.form(str)
end function

function guv(str)
    guv = request.querystring(str)
end function

function alertbox(str,kindnum)
    select case kindnum
        case "1"
            response.write("<script>alert(""" & str & """);</script>")
            response.end()
        case "2"
            response.write("<script>alert(""" & str & """);window.history.back();</script>")
            response.end()
        case "3"
            response.write("<script>alert(""" & str & """);window.close();</script>")
            response.end()
    end select
end function

sub WRITE_LINE(str)
    response.write ltrim(str)
end sub

sub LOADING_BUFFER_INI
    response.expires = 0
    response.expiresabsolute = now() - 1
    response.addheader "pragma","no-cache"
    response.addheader "cache-control","private"
    response.cachecontrol = "no-cache"
end sub

sub LOADING_ADMIN_HEAD
    WRITE_LINE "<html><head><title></title>"
    WRITE_LINE "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
    WRITE_LINE "<meta http-equiv=""Content-Language"" content=""gb2312"">"
    WRITE_LINE "<link href=""../images/ncms/css.css"" rel=""stylesheet"" type=""text/css""></head>"
    WRITE_LINE "<body leftmargin=""1"" topmargin=""10"" scroll=""auto"">"
end sub

sub LOADING_ADMIN_FOOT
    if isobject("conn") then
        conn.close:set conn = nothing
    elseif isobject("commentconn") then
        commentconn.close:set commentconn = nothing
    elseif isobject("collectconn") then
        collectconn.close:set collectconn = nothing
    end if
    WRITE_LINE "<table align=""center"" width=""100%"" cellpadding=""2"" cellspacing=""1"" border=""0"">"
    WRITE_LINE "<tr>"
    WRITE_LINE "<td align=""middle"" valign=""middle"">"
    WRITE_LINE "<table bgcolor=""#c0c0c0"" align=""center"" width=""98%"" cellpadding=""2"" cellspacing=""1"">"
    WRITE_LINE "<tr>"
    WRITE_LINE "<td bgcolor=""#f0f0f0"" height=""50""><div align=""center""><font face=""verdana,arial,helvetica,sans-serif"" size=""1""><b>©2006 - 2008 CopyRight NCMS All Rights Reserved.Version:" & Version & " <a href=""http://www.50z.cn/"" target=""_blank"">BBS</a></b></font></div></td>"
    WRITE_LINE "</tr>"
    WRITE_LINE "</table>"
    WRITE_LINE "</td>"
    WRITE_LINE "</tr>"
    WRITE_LINE "</table>"
    WRITE_LINE "</body></html>"
end sub

'===============================================================================================
'楚河|汉界 来个小广告:如果您发现本程序BUG或不足之处或有好的改进方法,请联系我:QQ574634!万分感谢!
'===============================================================================================

Function IsValidEmail(Str)
    IsValidEmail = False
    Dim RegEx,Match
    Set RegEx = New RegExp
        RegEx.Pattern = "^\w+((-\w+)|(\.\w+))*\@[A-Za-z0-9]+((\.|-)[A-Za-z0-9]+)*\.[A-Za-z0-9]+$"
        RegEx.IgnoreCase = True
    Set Match = RegEx.Execute(Str)
    If Match.Count Then IsValidEmail = True
End Function

Function ChkNum(Byval Num)
    Dim tNum:tNum = ""
    If Num = "" Or Not IsNumeric(Num) Then
        Response.Write("<script>alert(""参数类型错误!"");history.back();</script>")
        Response.End()
    ElseIf len(Num) > 8 Then
        Response.Write("<script>alert(""参数超出范围!"");history.back();</script>")
        Response.End()
    Else
        tNum = clng(left(Num,8))
    End If
    ChkNum = tNum
End Function

Function ChkStr(ByVal Str)
    Dim TempStr
        TempStr = Replace(Replace(Str,"'",""),Chr(39),"")
    Dim RegEx
    Set RegEx = New RegExp
        RegEx.IGnoreCase = True
        RegEx.Pattern = "<|>|(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|url|eval|\t"
    If RegEx.Test(LCase(TempStr)) Then
        TempStr = ""
    End If
    Set RegEx = Nothing
    ChkStr = TempStr
End Function

Function FuckJP(ByVal Str)
    If IsNull(Str) Or IsEmpty(Str) Then Exit Function
    Dim F,I
        F = Array("ゴ","ガ","ギ","グ","ゲ","ザ","ジ","ズ","ヅ","デ","ド","ポ","ベ","プ","ビ","パ","ヴ","ボ","ペ","ブ","ピ","バ","ヂ","ダ","ゾ","ゼ")
     FuckJP = Str
     For I = 0 To 25
         FuckJP = Replace(FuckJP,F(I),"")
     Next
End Function

Function ChkInput(Str)
    Dim RegEx
    Set RegEx = New RegExp
        RegEx.IgnoreCase = True
        RegEx.Pattern = "<|>|(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|url|eval|\t"
    If RegEx.Test(LCase(Str)) Then
        Response.Write("处理 URL 时服务器出错,请与系统管理员联系。")
        Response.End()
    End If
    Set RegEx = Nothing
    ChkInput = Str
End Function

Function ChkPost()
    Dim From_Url:From_Url = CStr(Request.ServerVariables("HTTP_REFERER"))
    Dim Serv_Url:Serv_Url = CStr(Request.ServerVariables("SERVER_NAME"))
    If Mid(From_Url,8,Len(Serv_Url)) <> Serv_Url Then
        Response.Write("处理 URL 时服务器出错,请与系统管理员联系。")
        Response.End()
    End If
End Function

Function GetIP()
    Dim StrIP_List,StrIP,IP_Ary
        StrIP_List = Replace(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),"'","")
    If InStr(StrIP_List,",") <> 0 Then
        IP_Ary = Split(StrIP_List,",")
        StrIP = IP_Ary(0)
    Else
        StrIP = StrIP_List
    End If
    If StrIP = Empty Then StrIP = Replace(Request.ServerVariables("REMOTE_ADDR"),"'","")
    GetIP = StrIP
End Function

Function Highlight(byVal strContent,byRef arrayWords)
    Dim intCounter,strTemp,intPos,intTagLength,intKeyWordLength,bUpDate
    If Len(arrayWords) < 1 Then Highlight = strContent:Exit Function
    For intPos = 1 To Len(strContent)
        bUpDate = False
        If Mid(strContent,intPos,1) = "<" Then
            On Error Resume Next
            intTagLength = (InStr(intPos,strContent,">",1) - intPos)
            If Err.Number <> 0 Then
                Highlight = strContent
                Err.Clear
            End If
            strTemp = strTemp & Mid(strContent,intPos,intTagLength)
            intPos = intPos + intTagLength
        End If
        If arrayWords <> "" Then
            intKeyWordLength = Len(arrayWords)
            If LCase(Mid(strContent,intPos,intKeyWordLength)) = LCase(arrayWords) Then
                strTemp = strTemp & "<strong style=""color:#ff0000;background:#fff000;"">" & Mid(strContent,intPos,intKeyWordLength) & "</strong>"
                intPos = intPos + intKeyWordLength - 1
                bUpDate = True
            End If
        End If
        If bUpDate = False Then
            strTemp = strTemp & Mid(strContent,intPos,1)
        End If
    Next
    Highlight = strTemp
End Function

Function SendToNcms(Str1,Str2,Str3,Str4)
    On Error Resume Next
    WRITE_LINE "<script>setTimeout(""document.form.submit()"",0);</script>"
    WRITE_LINE "<form name=""form"" action=""http://ncms.cn/users/receive.asp"" method=""post"">"
    WRITE_LINE "<input name=""k1"" type=""hidden"" value=""" & Str1 & """>"
    WRITE_LINE "<input name=""k2"" type=""hidden"" value=""" & Str2 & """>"
    WRITE_LINE "<input name=""k3"" type=""hidden"" value=""" & Str3 & """>"
    WRITE_LINE "<input name=""k4"" type=""hidden"" value=""" & Str4 & """>"
    WRITE_LINE "<input name=""kx"" type=""hidden"" value=""203674122566320014"">"
    WRITE_LINE "</form>"
End Function

Function IsObjInstalled(strClassString)
    On Error Resume Next
    IsObjInstalled = False
    Err = 0
    Dim xTestObj
    Set xTestObj = Server.CreateObject(strClassString)
    If 0 = Err Then IsObjInstalled = True
    Set xTestObj = Nothing
    Err = 0
End Function

Function GetVer(ClassStr)
    On Error Resume Next
    GetVer = ""
    Err = 0
    Dim xTestObj
    Set xTestObj = Server.CreateObject(ClassStr)
    If 0 = Err Then GetVer = xTestObj.Version
    Set xTestObj = Nothing
    Err = 0
End Function

Function ReplaceRemoteUrl(sHTML,sSavePath,sExt)
    Dim s_Content:s_Content = sHTML
    If IsObjInstalled("Microsoft.XMLHTTP") = False Then
        ReplaceRemoteUrl = s_Content
        Exit Function
    End If
    If sSavePath = "" Then sSavePath = "" & site_root & "/" & site_upload & "/" & site_bimg & "/"
    If sExt = "" Then sExt = "jpg|gif|png|bmp|swf"
    Dim RegEx,RemoteFile,RemoteFileurl,SaveFileName,OutPutPath,SaveFileType,RanNum,NewFileName
    Set RegEx = New RegExp
    RegEx.IgnoreCase = True
    RegEx.Global = True
    RegEx.Pattern = "(http://(.+?)\.(" & sExt & "))"
    Set RemoteFile = RegEx.Execute(s_Content)
    For Each RemoteFileurl In RemoteFile
        SaveFileType = Mid(RemoteFileurl,InstrRev(RemoteFileurl,".") + 1)
        Randomize
        RanNum = Int(900 * Rnd) + 100
        NewFileName = Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & RanNum & "." & SaveFileType
        SaveFileName = sSavePath & NewFileName
        OutPutPath = "" & site_root & "/tools/loadimg.asp?FileName=" & NewFileName & ""
        Call SaveRemoteFile(SaveFileName,RemoteFileurl)
        s_Content = Replace(s_Content,RemoteFileurl,OutPutPath)
    Next
    ReplaceRemoteUrl = NewFileName & "|" & s_Content
End Function

Sub SaveRemoteFile(s_LocalFileName,s_RemoteFileUrl)
    Dim Ads,Retrieval,GetRemoteData
    On Error Resume Next
    Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
    With Retrieval
        .Open "Get",s_RemoteFileUrl,False,"",""
        .Send
            GetRemoteData = .ResponseBody
    End With
    Set Retrieval = Nothing
    Set Ads = Server.CreateObject("ADODB.Stream")
        Ads.Type = 1
        Ads.Open
        Ads.Write GetRemoteData
        Ads.SaveToFile Server.Mappath(s_LocalFileName),2
        Ads.Cancel()
        Ads.Close()
    Set Ads = Nothing
End Sub

Class Cls_vbsPage
    Private oConn
    Private iPagesize
    Private sPageName
    Private sDbType
    Private iRecType
    Private sJsUrl
    Private sField
    Private sTable
    Private sCondition
    Private sOrderBy
    Private sPkey
    Private iRecCount

    Private Sub Class_Initialize
        iPageSize=10
        sPageName="Page"
        sDbType="AC"
        iRecType=0
        sJsUrl=""
        sField=" * "
    End Sub

    Public Property Set Conn(ByRef Value)
        Set oConn=Value
    End Property

    Public Property Let PageSize(ByVal intPageSize)
        iPageSize=CheckNum(intPageSize,0,0,iPageSize,0) 
    End Property

    Public Property Let PageName(ByVal strPageName)
        sPageName=IIf(Len(strPageName)<1,sPageName,strPageName)
    End Property

    Public Property Let DbType(ByVal strDbType)
        sDbType=UCase(IIf(Len(strDbType)<1,sDbType,strDbType))
    End Property

    Public Property Let RecType(ByVal intRecType)
        iRecType=CheckNum(intRecType,0,0,iRecType,0) 
    End Property

    Public Property Let JsUrl(ByVal strJsUrl)
        sJsUrl=strJsUrl
    End Property

    Public Property Let Pkey(ByVal strPkey)
        sPkey=strPkey
    End Property

    Public Property Let Field(ByVal strField)
        sField=IIf(Len(strField)<1,sField,strField)
    End Property

    Public Property Let Table(ByVal strTable)
        sTable=strTable
    End Property

    Public Property Let Condition(ByVal strCondition)
        Dim s
        s=strCondition
        sCondition=IIf(Len(s)>2," WHERE "&s,"")
    End Property

    Public Property Let OrderBy(ByVal strOrderBy)
        Dim s
        s=strOrderBy
        sOrderBy=IIf(Len(s)>4," ORDER BY "&s,"")
    End Property

    Public Property Get RecCount()
        If iRecType>0 Then
            i=iRecType
        Elseif iRecType=0 Then
            i=CheckNum(Request.Cookies("ShowoPage")(sPageName),1,0,0,0)
            Dim s
            s=Trim(Request.Cookies("ShowoPage")("sCond"))
            IF i=0 OR sCondition<>s Then
                i=oConn.Execute("SELECT COUNT("&sPkey&") FROM "&sTable&" "&sCondition,0,1)(0)
                Response.Cookies("ShowoPage")(sPageName)=i
                Response.Cookies("ShowoPage")("sCond")=sCondition
            End If
        Else
            i=oConn.Execute("SELECT COUNT("&sPkey&") FROM "&sTable&" "&sCondition,0,1)(0)
        End If
        iRecCount=i
        RecCount=i
    End Property

    Public Property Get ResultSet()
        Dim s
        s=Null
        i=iRecCount
        If i>0 Then
            Dim iPageCount,iPageCurr
            iPageCount=Abs(Int(-Abs(i/iPageSize)))
            iPageCurr=CheckNum(Request.QueryString(sPageName),1,1,1,iPageCount)
            Select Case sDbType
                Case "MSSQL"
                    Set Rs=server.CreateObject("Adodb.RecordSet")
                    Set Cm=Server.CreateObject("Adodb.Command")
                    Cm.CommandType=4
                    Cm.ActiveConnection=oConn
                    Cm.CommandText="sp_Util_Page"
                    Cm.parameters(1)=i
                    Cm.parameters(2)=iPageCurr
                    Cm.parameters(3)=iPageSize
                    Cm.parameters(4)=sPkey
                    Cm.parameters(5)=sField
                    Cm.parameters(6)=sTable
                    Cm.parameters(7)=Replace(sCondition," WHERE ","")
                    Cm.parameters(8)=Replace(sOrderBy," ORDER BY ","")
                    Rs.CursorLocation=3
                    Rs.LockType=1
                    Rs.Open Cm
                Case "MYSQL"
                    ResultSet_Sql="SELECT "&sField&" FROM "&sTable&" "&sCondition&" "&sOrderBy&" LIMIT "&(iPageCurr-1)*iPageSize&","&iPageSize
                    Set Rs=oConn.Execute(ResultSet_Sql)
                Case Else
                    Dim Rs,ResultSet_Sql
                    Set Rs = Server.CreateObject ("Adodb.RecordSet")
                    ResultSet_Sql="SELECT "&sField&" FROM "&sTable&" "&sCondition&" "&sOrderBy
                    Rs.Open ResultSet_Sql,oConn,1,1,&H0001
                    Rs.AbsolutePosition=(iPageCurr-1)*iPageSize+1
            End Select
            s=Rs.GetRows(iPageSize)
            Rs.close
            Set Rs=Nothing
        End If
        ResultSet=s
    End Property

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

    Private Function CheckNum(ByVal strStr,ByVal blnMin,ByVal blnMax,ByVal intMin,ByVal intMax)
        Dim i,s,iMi,iMa
        s=Left(Trim(""&strStr),32):iMi=intMin:iMa=intMax
        If IsNumeric(s) Then
            i=CDbl(s)
            i=IIf(blnMin=1 And i<iMi,iMi,i)
            i=IIf(blnMax=1 And i>iMa,iMa,i)
        Else
            i=iMi
        End If
        CheckNum=i
    End Function

    Private Function IIf(ByVal blnBool,ByVal strStr1,ByVal strStr2)
        Dim s
        If blnBool Then
            s=strStr1
        Else
            s=strStr2
        End If
        IIf=s
    End Function

    Public Sub ShowPage()
    %>
        <script language="javascript" type="text/javascript" src="<%=sJsUrl%>/page.js"></script>
        <script language="javascript" type="text/javascript">
            var s = new Cls_jsPage(<%=iRecCount%>,<%=iPageSize%>,3,"s");
            s.setPageSE("<%=sPageName%>=","");
            s.setPageInput("<%=sPageName%>");
            s.setUrl("");
            s.setPageFrist("首页","<<");
            s.setPagePrev("上页","<");
            s.setPageNext("下页",">");
            s.setPageLast("尾页",">>");
            s.setPageText("[{$PageNum}]","第{$PageNum}页");
            s.setPageTextF(" {$PageTextF} "," {$PageTextF} ");
            s.setPageSelect("{$PageNum}","第{$PageNum}页");
            s.setPageCss("","","");
            s.setHtml("共{$RecCount}记录 页次{$Page}/{$PageCount} 每页{$PageSize}条 {$PageFrist} {$PagePrev} {$PageText} {$PageNext} {$PageLast} {$PageInput} {$PageSelect}");
            s.Write();
        </script>
    <%
    End Sub
End Class

Function GetHttpPage(HttpUrl)
    On Error Resume Next
    If IsNull(HttpUrl) = True Or Len(HttpUrl) < 18 Or HttpUrl = "$False$" Then
        GetHttpPage = "$False$"
        Exit Function
    End If
    Dim Http
    Set Http = Server.CreateObject("Microsoft.XMLHTTP")
        Http.Open "GET",HttpUrl,False
        Http.Send()
    If Http.Readystate <> 4 Then
        Set Http = Nothing
        GetHttpPage = "$False$"
        Exit function
    End If
    GetHTTPPage = BytesToBstr(Http.ResponseBody,"GB2312")
    Set Http = Nothing
    If Err.Number <> 0 Then
        Err.Clear
        Exit Function
    End If
End Function

Function BytesToBstr(Body,Cset)
    Dim ObjStream
    Set ObjStream = Server.CreateObject("ADODB.Stream")
        ObjStream.Type = 1
        ObjStream.Mode = 3
        ObjStream.Open
        ObjStream.Write Body
        ObjStream.Position = 0
        ObjStream.Type = 2
        ObjStream.Charset = Cset
        BytesToBstr = ObjStream.ReadText 
        ObjStream.Close
    Set ObjStream = Nothing
End Function

Function GetAllLinkTags(ContStr)
    Dim RegEx,Match,Matches,TempStr
    Set RegEx = New RegExp
        RegEx.Pattern = "<a .*?>.*?</a>"
        RegEx.IGnoreCase = True
        RegEx.Global = True
    Set Matches = RegEx.Execute(ContStr)
    For Each Match In Matches
        TempStr = TempStr & Match.Value & "|||"
    Next
    Set Matches = Nothing
    Set RegEx = Nothing
    GetAllLinkTags = TempStr
End Function

Function GetOtherContent(Str,StartStr,LastStr)
    On Error Resume Next
    Dim RegEx,SearchStr,Matches,Matche
    Str = Replace(Replace(Str,Chr(13),""),Chr(10),"")
    StartStr = Replace(Replace(StartStr,Chr(13),""),Chr(10),"")
    LastStr = Replace(Replace(LastStr,Chr(13),""),Chr(10),"")
    SearchStr = StartStr & ".*" & LastStr
    Set RegEx = New RegExp
        RegEx.IgnoreCase = True
        RegEx.Global = True
        RegEx.Pattern = SearchStr
    Set Matches = RegEx.Execute(Str)
    For Each Matche In Matches
        If Matche <> "" Then
            GetOtherContent = Matche
            RegEx.Pattern = StartStr
            GetOtherContent = RegEx.Replace(GetOtherContent,"")
            RegEx.Pattern = LastStr & ".*|\n"
            GetOtherContent = RegEx.Replace(GetOtherContent,"")
        Else
            GetOtherContent = ""
        End If
        If Err.Number <> 0 Then
            Err.Clear
            GetOtherContent = ""
        End If
        Exit For
    Next
End Function

Function FormatUrl(NewsLinkStr,ObjUrl)
    Dim URLSearchLoc
    If Left(LCase(NewsLinkStr),7) <> "http://" Then
        Dim CheckURLStr,TempCollectObjUrl,CheckObjUrl
            NewsLinkStr = Replace(Replace(Replace(NewsLinkStr,"'",""),"""","")," ","")
            TempCollectObjUrl = Left(ObjUrl,InStrRev(ObjUrl,"/"))
            CheckObjUrl = NewsLinkStr
            CheckURLStr = Left(NewsLinkStr,3)
        If Left(NewsLinkStr,1) = "/" Then
            URLSearchLoc = InStr(ObjUrl,"//") + 2
            FormatUrl = Left(ObjUrl,InStr(URLSearchLoc,ObjUrl,"/") - 1)
            FormatUrl = FormatUrl & NewsLinkStr
        ElseIf CheckURLStr = "../" Then
            Do While Not CheckURLStr <> "../"
                CheckObjUrl = Mid(CheckObjUrl,4)
                If Right(TempCollectObjUrl,1) = "/" Then TempCollectObjUrl = Left(TempCollectObjUrl,Len(TempCollectObjUrl) - 1)
                TempCollectObjUrl = Left(TempCollectObjUrl,InStrRev(TempCollectObjUrl,"/"))
                CheckURLStr = Left(CheckObjUrl,3)
            Loop
            FormatUrl = TempCollectObjUrl & CheckObjUrl
        Else
            FormatUrl = TempCollectObjUrl & NewsLinkStr
        End If
    Else
        FormatUrl = NewsLinkStr
    End If
End Function

Function ReplaceContentStr(ContentStr)
    Dim TempContentStr
        TempContentStr = ContentStr
    If RuleDataBox(14,0) = 1 Then
        TempContentStr = LoseHtml(TempContentStr)
    Else
        TempContentStr = LoseNoteTag(TempContentStr)
        If RuleDataBox(15,0) = 1 Then TempContentStr = LoseStyleTag(TempContentStr)
        If RuleDataBox(16,0) = 1 Then TempContentStr = LoseDivTag(TempContentStr)
        If RuleDataBox(17,0) = 1 Then TempContentStr = LoseATag(TempContentStr)
        If RuleDataBox(18,0) = 1 Then TempContentStr = LoseFontTag(TempContentStr)
        If RuleDataBox(19,0) = 1 Then TempContentStr = LoseSpanTag(TempContentStr)
        If RuleDataBox(20,0) = 1 Then TempContentStr = LoseObjectTag(TempContentStr)
        If RuleDataBox(21,0) = 1 Then TempContentStr = LoseIFrameTag(TempContentStr)
        If RuleDataBox(22,0) = 1 Then TempContentStr = LoseScriptTag(TempContentStr)
        If RuleDataBox(23,0) = 1 Then TempContentStr = LoseClassTag(TempContentStr)
        TempContentStr = LoseTableTag(TempContentStr)
        TempContentStr = LoseTDTag(TempContentStr)
        TempContentStr = LoseTRTag(TempContentStr)
    End If
    ReplaceContentStr = TempContentStr
End Function

Function CNReplaceContentStr(ContentStr)
    Dim TempContentStr
        TempContentStr = ContentStr
    If CNRuleDataBox(14,0) = 1 Then
        TempContentStr = LoseHtml(TempContentStr)
    Else
        TempContentStr = LoseNoteTag(TempContentStr)
        If CNRuleDataBox(15,0) = 1 Then TempContentStr = LoseStyleTag(TempContentStr)
        If CNRuleDataBox(16,0) = 1 Then TempContentStr = LoseDivTag(TempContentStr)
        If CNRuleDataBox(17,0) = 1 Then TempContentStr = LoseATag(TempContentStr)
        If CNRuleDataBox(18,0) = 1 Then TempContentStr = LoseFontTag(TempContentStr)
        If CNRuleDataBox(19,0) = 1 Then TempContentStr = LoseSpanTag(TempContentStr)
        If CNRuleDataBox(20,0) = 1 Then TempContentStr = LoseObjectTag(TempContentStr)
        If CNRuleDataBox(21,0) = 1 Then TempContentStr = LoseIFrameTag(TempContentStr)
        If CNRuleDataBox(22,0) = 1 Then TempContentStr = LoseScriptTag(TempContentStr)
        If CNRuleDataBox(23,0) = 1 Then TempContentStr = LoseClassTag(TempContentStr)
        TempContentStr = LoseTableTag(TempContentStr)
        TempContentStr = LoseTDTag(TempContentStr)
        TempContentStr = LoseTRTag(TempContentStr)
    End If
    CNReplaceContentStr = TempContentStr
End Function

Function LoseHtml(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "<\/*[^<>]*>"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    Set RegEx = Nothing
    LoseHtml = ClsTempLoseStr
End function

Function LoseClassTag(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "(class=){1,}(""|\'){0,1}\S+(""|\'|>|\s){0,1}"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    LoseClassTag = ClsTempLoseStr
    Set RegEx = Nothing
End Function

Function LoseScriptTag(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "(<script){1,}[^<>]*>[^\0]*(<\/script>){1,}"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    LoseScriptTag = ClsTempLoseStr
    Set RegEx = Nothing
End Function

Function LoseIFrameTag(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "(<iframe){1,}[^<>]*>[^\0]*(<\/iframe>){1,}"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    LoseIFrameTag = ClsTempLoseStr
    Set RegEx = Nothing
End Function

Function LoseObjectTag(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "(<object){1,}[^<>]*>[^\0]*(<\/object>){1,}"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    LoseObjectTag = ClsTempLoseStr
    Set RegEx = Nothing
End Function

Function LoseSpanTag(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "<(\/){0,1}span[^<>]*>"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    LoseSpanTag = ClsTempLoseStr
    Set RegEx = Nothing
End Function

Function LoseFontTag(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "<(\/){0,1}font[^<>]*>"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    LoseFontTag = ClsTempLoseStr
    Set RegEx = Nothing
End Function

Function LoseATag(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "<(\/){0,1}a[^<>]*>"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    LoseATag = ClsTempLoseStr
    Set RegEx = Nothing
End Function

Function LoseDivTag(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "<(\/){0,1}div[^<>]*>"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    LoseDivTag = ClsTempLoseStr
    Set RegEx = Nothing
End Function

Function LoseStyleTag(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "(<style){1,}[^<>]*>[^\0]*(<\/style>){1,}"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    LoseStyleTag = ClsTempLoseStr
    Set RegEx = Nothing
End Function

Function LoseNoteTag(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "<!--\/*[^<>]*-->"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    LoseNoteTag = ClsTempLoseStr
    Set RegEx = Nothing
End Function

Function LoseTableTag(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "<(\/){0,1}table[^<>]*>"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    LoseTableTag = ClsTempLoseStr
    Set RegEx = Nothing
End Function

Function LoseTDTag(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "<(\/){0,1}td[^<>]*>"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    LoseTDTag = ClsTempLoseStr
    Set RegEx = Nothing
End Function

Function LoseTRTag(ContentStr)
    Dim ClsTempLoseStr,RegEx
        ClsTempLoseStr = Cstr(ContentStr)
    Set RegEx = New RegExp
        RegEx.Pattern = "<(\/){0,1}tr[^<>]*>"
        RegEx.IgnoreCase = True
        RegEx.Global = True
    ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr,"")
    LoseTRTag = ClsTempLoseStr
    Set RegEx = Nothing
End Function
%>

加载全部内容

相关教程
猜你喜欢
用户评论