godaddy windows IIS7 免费空间上安装asp采集时候出现500错误

7kbb

如题，谢谢
Microsoft VBScript runtime error '800a004c'

Path not found

D:\HOSTING\6091394\HTML\ADMIN\../inc/CommonFun.asp, line 410  
（下面程序代码的410行是：set objFolder=objFso.GetFolder(filePath)）
程序是这样的
<%
'******************************************************************************************
' Software name: Max(马克斯) Content Management System
' Version:3.0
' Web: http://www.maxcms.net
' Author: 石头(maxcms2008@qq.com),yuet,长明,酒瓶
' Copyright (C) 2005-2009 马克斯官方 版权所有
' 法律申明：MaxCMS程序所有代码100%原创、未引入任何网上代码,对一切抄袭行为、坚决严肃追究法律责任
'******************************************************************************************
Sub alertMsg(str,url)
        dim urlstr
        if url<>"" then urlstr="location.href='"&url&"';"
        if not isNul(str) then str ="alert('"&str&"');"
        echo("<script>"&str&urlstr&"</script>")
End Sub

Sub echoMsgAndGo(str,timenum)
        echo str&",稍后将自动返回<script language=""javascript"">setTimeout(""goLastPage()"","&timenum*1000&");function goLastPage(){history.go(-1);}</script>&nbsp;&nbsp;<a href='/' target='_self'>进入网站首页</a>"&" Powered By "&siteName
End Sub

Sub selectMsg(str,url1,url2)
        echo("<script>if(confirm('"&str&"')){location.href='"&url1&"'}else{location.href='"&url2&"'}</script>")
End Sub

Sub last
        die "<script>history.go(-1)</script>"
End Sub

Sub echo(str)
        response.write(str)
        response.Flush()
End Sub

Function rCookie(cookieName)
        rCookie=request.cookies(cookieName)
End Function

Sub wCookie(cookieName,cookieValue)
        response.cookies(cookieName)=cookieValue
End Sub

Sub wCookieInTime(cookieName,cookieValue,dateType,dateNum)
        Response.Cookies(cookieName).Expires=DateAdd(dateType,dateNum,now())
        response.cookies(cookieName)=cookieValue
End Sub

Function isNul(str)
        if isnull(str) or str=""  then isNul=true else isNul=false
End Function

Function isNum(str)
        if not isNul(str) then   isNum=isnumeric(str) else isNum=false
End Function

Function isUrl(str)
        if not isNul(str) then
                if left(str,7)="http://" then isUrl=true else isUrl=false
        else
                isUrl=false
        end if
End Function

Function getFileFormat(str)
        dim ext:str=trim(""&str):ext=""
        if str<>"" then
                if instr(" "&str,"?")>0 then:str=mid(str,1,instr(str,"?")-1):end if
                if instrRev(str,".")>0 then:ext=mid(str,instrRev(str,".")):end if
        end if
        getFileFormat=ext
End Function

Sub die(str)
        if not isNul(str) then
                echo str
        end if         
        response.End()
End Sub

Sub echoErr(byval str,byval id, byval des)
        dim errstr,cssstr
        cssstr="<style>body{text-align:center}#msg{background-color:white;border:1px solid #1B76B7;margin:0 auto;width:400px;text-align:left}.msgtitle{padding:3px 3px;color:white;font-weight:700;line-height:21px;height:25px;font-size:12px;border-bottom:1px solid #1B76B7; text-indent:3px; background-color:#1B76B7}#msgbody{font-size:12px;padding:40px 8px 50px;line-height:25px}#msgbottom{text-align:center;height:20px;line-height:20px;font-size:12px;background-color:#1b76b7;color:#FFFFFF}</style>"
        errstr=cssstr&"<div id='msg'><div class='msgtitle'>提示：***【"&str&"】***</div><div id='msgbody'>错误号：<b>"&id&"</b><br>错误描述：<b>"&des&"</b></div><div id='msgbottom'>Powered By "&siteName&"</div></div>"
        cssstr=""
        die(errstr)
End Sub

Function getForm(element,ftype)
        Select case ftype
                case "get"
                        getForm=trim(request.QueryString(element))
                case "post"
                        getForm=trim(request.Form(element))
                case "both"
                        if isNul(request.QueryString(element)) then getForm=trim(request.Form(element)) else getForm=trim(request.QueryString(element))
        End Select
End Function

Function isInstallObj(objname)
        dim isInstall,obj
        On Error Resume Next
        set obj=server.CreateObject(objname)
        if Err then
                isInstallObj=false : err.clear
        else
                isInstallObj=true:set obj=nothing
        end if
End Function

Function loadFile(ByVal filePath)
    dim errid,errdes
    On Error Resume Next
    With objStream
        .Type=2
        .Mode=3
        .Open
        .Charset="gbk"
        .LoadFromFile Server.MapPath(filePath)
        If Err Then  errid=err.number:errdes=err.description:Err.Clear:echoErr err_loadfile,errid,errdes
        .Position=0
        loadFile=.ReadText
        .Close
    End With
End Function

Function loadFileOnCache(Byval fileFlag,Byval filePath)
        dim cacheName
        cacheName=fileFlag&filePath
        if cacheStart=1 then
                if (cacheObj.chkCache(cacheName)) then  loadFileOnCache=cacheObj.getCache(cacheName) else loadFileOnCache=loadFile(filePath):cacheObj.setCache cacheName,loadFileOnCache
        else
                loadFileOnCache=loadFile(filePath)
        end if
End Function

Sub setStartTime()
        starttime=timer()
End Sub

Sub echoRunTime()
        endtime=timer()      
        echo pageRunStr(0)&FormatNumber((endtime-starttime),4,-1)&pageRunStr(1)&conn.queryCount&pageRunStr(2)
End Sub

Function getRunTime()
        endtime=timer()
        getRunTime=pageRunStr(0)&FormatNumber((endtime-starttime),4,-1)&pageRunStr(1)&conn.queryCount&pageRunStr(2)
End Function

Function getKeywordsList(key,span)
        dim keyWordsArray,i,keyWordsStr,keystr
        keystr=replaceStr(key,"，",",")
        if instr(keystr,",")>0 then keyWordsArray=split(keystr,",") else keyWordsArray=split(keystr," ")
        for i=0 to ubound(keyWordsArray)
                keyWordsStr=keyWordsStr&"<a href='/"&sitePath&"search.asp?searchword="& keyWordsArray(i)&"'>"&keyWordsArray(i)&"</a>"&span
        next
        getKeywordsList=keyWordsStr
End Function

Function getDataCount(countType)
        dim whereStr
        whereStr=" where year(m_addtime)="&Year(date)&" and month(m_addtime)="&month(date)&" and day(m_addtime)="&day(date)
        select case countType
                case "all"
                        getDataCount=conn.db("select count(*) from {pre}data","execute")(0)
                case "day"
                        getDataCount=conn.db("select count(*) from {pre}data "&whereStr,"execute")(0)
        end select       
End Function

Function replaceStr(Byval str,Byval finStr,Byval repStr)
        on error resume next
        if isNull(repStr) then repStr=""
        replaceStr=replace(str,finStr,repStr)
        if err then replaceStr="" : err.clear
End Function

Function getArrayElementID(Byval parray,Byval itemid,Byval compareValue)
        dim i
        for  i=0 to ubound(parray,2)
                if trim(parray(itemid,i))=trim(compareValue) then
                        getArrayElementID=i
                        Exit Function
                end if
        next
End Function

Function trimOuter(Byval str)
        dim vstr : vstr=str
        if left(vstr,1)=chr(32) then vstr=right(vstr,len(vstr)-1)
        if right(vstr,1)=chr(32) then  vstr=left(vstr,len(vstr)-1)
        trimOuter=vstr
End Function

Function trimOuterStr(Byval str,Byval flag)
        dim vstr,m : vstr=str : m=len(flag)
        if left(vstr,m)=flag then vstr=right(vstr,len(vstr)-m)
        if right(vstr,m)=flag then  vstr=left(vstr,len(vstr)-m)
        trimOuterStr=vstr
End Function

Function getPageSize(Byval str,Byval ptype)
        dim regObj,matchChannel,matchesChannel,sizeValue
        set regObj=New RegExp
        regObj.Pattern="\{maxcms:"&ptype&"list[\s\S]*size=([\d]+)[\s\S]*\}"       
        set matchesChannel=regObj.Execute(str)
        for each matchChannel in matchesChannel
                sizeValue=matchChannel.SubMatches(0) : if isNul(sizeValue) then sizeValue=10
                set regObj=nothing
                set matchesChannel=nothing
                getPageSize=sizeValue
                Exit Function
        next
End Function

Function getPageSizeOnCache(Byval templatePath,Byval Flag,Byval Flag2)
                dim cacheName,pSize
                cacheName=Flag&"_pagesize_"&Flag2
                if cacheStart=1 then
                        if cacheObj.chkCache(cacheName) then pSize=cacheObj.getCache(cacheName) else pSize=getPageSize(loadFile(templatePath),Flag) : cacheObj.setCache cacheName,pSize
                else
                        pSize=getPageSize(loadFile(templatePath),Flag)
                end if
                getPageSizeOnCache=pSize
End Function

Function filterStr(Byval str,Byval filtertype)
        if isNul(str) then  filterStr="" : Exit Function
        dim regObj, outstr,rulestr : set regObj=New Regexp
        regObj.IgnoreCase=true : regObj.Global=true
        Select case filtertype
                case "html"       
                        rulestr="(<[a-zA-Z].*?>)|(<[\/][a-zA-Z].*?>)"
                case "jsiframe"
                        rulestr="(<(script|iframe).*?>)|(<[\/](script|iframe).*?>)"
        end Select
        regObj.Pattern=rulestr
        outstr=regObj.Replace(str, "")
        set regObj=Nothing : filterStr=outstr
End Function

Function getAgent()
        getAgent=request.ServerVariables("HTTP_USER_AGENT")
End Function

Function getRefer()
        getRefer=request.ServerVariables("HTTP_REFERER")
End Function

Function getServername()
        getServername=request.ServerVariables("server_name")
End Function

Function isOutSubmit()
        dim server1, server2
        server1=getRefer
        server2=getServername
        if Mid(server1, 8, len(server2)) <> server2 then
                isOutSubmit=true
        else
                isOutSubmit=false
        end if
End Function

Function getIp()
        dim forwardFor
        forwardFor=request.servervariables("Http_X_Forwarded_For")
        if forwardFor="" then
                getIp=request.servervariables("Remote_Addr")
        else
                getIp=forwardFor
        end if
        getIp=replace(getIp, chr(39), "")
End Function

Function createTextFile(Byval content,Byval fileDir,Byval code)
        dim fileobj,fileCode : fileDir=replace(fileDir, "\", "/")
        if isNul(code) then fileCode="gbk" else fileCode=code
        call createfolder(fileDir,"filedir")
        on error resume next:err.clear
        set fileobj=objFso.CreateTextFile(server.mappath(fileDir),True)
        fileobj.Write(content)
        set fileobj=nothing
        if Err or not isNul(code) then
                err.clear
                With objStream
                        .Charset=fileCode:.Type=2:.Mode=3:.Open:.Position=0
                        .WriteText content:.SaveToFile Server.MapPath(fileDir), 2
                        .Close
                End With
        end if       
        if Err Then  createTextFile=false : errid=err.number:errdes=err.description:Err.Clear : echoErr err_writefile,errid,errdes else createTextFile=true
End Function

Function createStreamFile(Byval stream,Byval fileDir)
        dim errid,errdes
        fileDir=replace(fileDir, "\", "/")
        call createfolder(fileDir,"filedir")
        on error resume next
        With objStream
                .Type =1
                .Mode=3  
                .Open
                .write stream
                .SaveToFile server.mappath(fileDir),2
                .close
        End With
        if Err Then  error.clear:createStreamFile=false else createStreamFile=true
End  Function

Function createFolder(Byval dir,Byval dirType)
        dim subPathArray,lenSubPathArray, pathDeep, i
        on error resume next
        dir=replace(dir, "\", "/")
        dir=replace(server.mappath(dir), server.mappath("/"), "")
        subPathArray=split(dir, "\")
        pathDeep=pathDeep&server.mappath("/")
        select case dirType
                case "filedir"
                         lenSubPathArray=ubound(subPathArray) - 1
                case "folderdir"
                        lenSubPathArray=ubound(subPathArray)
        end select
        for i=1 to  lenSubPathArray
                pathDeep=pathDeep&"\"&subPathArray(i)
                if not objFso.FolderExists(pathDeep) then objFso.CreateFolder pathDeep
        next
        if Err Then  createFolder=false : errid=err.number:errdes=err.description:Err.Clear : echoErr err_createFolder,errid,errdes else createFolder=true
End Function

Function isExistFile(Byval fileDir)
        on error resume next
        If (objFso.FileExists(server.MapPath(fileDir))) Then  isExistFile=True  Else  isExistFile=False
        if err then err.clear:isExistFile=False
End Function

Function isExistFolder(Byval folderDir)
        on error resume next
        If objFso.FolderExists(server.MapPath(folderDir)) Then  isExistFolder=True Else isExistFolder=False
        if err then err.clear:isExistFolder=False
End Function

Function delFolder(Byval folderDir)
        on error resume next
        If isExistFolder(folderDir)=True Then  
                objFso.DeleteFolder(server.mappath(folderDir))
                if Err Then  delFolder=false : errid=err.number : errdes=err.description:Err.Clear : echoErr err_delFolder,errid,errdes else delFolder=true
        else
                delFolder=false : die(err_notExistFolder)
        end if
End Function

Function delFile(Byval fileDir)
        on error resume next
        If isExistFile(fileDir)=True Then objFso.DeleteFile(server.mappath(fileDir))
        if  Err Then  delFile=false : errid=err.number : errdes=err.description:Err.Clear : echoErr err_delFile,errid,errdes else delFile=true
End Function

add.c

看到这个路径没 "D:\HOSTING\6091394\HTML\ADMIN\../inc/CommonFun.asp"
修改为绝对路径 ,不要用../这样的

7kbb

Function initializeAllObjects()
        dim errid,errdes
        on error resume next
        if not isobject(objFso) then set objFso=server.createobject(FSO_OBJ_NAME)
        If Err Then errid=err.number:errdes=err.description:Err.Clear:echoErr err_fsoobj,errid,errdes
        if not isobject(objStream) then Set objStream=Server.CreateObject(STREAM_OBJ_NAME)
        If Err Then errid=err.number:errdes=err.description:Err.Clear:echoErr err_stmobj,errid,errdes
End Function

Function terminateAllObjects()
        on error resume next
        if conn.isConnect then conn.close
        if isobject(conn) then : set conn=nothing
        if isobject(objFso) then set objFso=nothing
        if isobject(objStream) then set objStream=nothing
        if isobject(cacheObj) then set cacheObj=nothing
        if isobject(mainClassObj) then set mainClassObj=nothing
        if isObject(gXmlHttpObj) then SET gXmlHttpObj=Nothing
End Function

Function moveFolder(oldFolder,newFolder)
        dim voldFolder,vnewFolder
        voldFolder=oldFolder
        vnewFolder=newFolder
        on error resume next
        if voldFolder <> vnewFolder then
                voldFolder=server.mappath(oldFolder)
                vnewFolder=server.mappath(newFolder)
                if not objFso.FolderExists(vnewFolder) then createFolder newFolder,"folderdir"
                if  objFso.FolderExists(voldFolder)  then  objFso.CopyFolder voldFolder,vnewFolder : objFso.DeleteFolder(voldFolder)
                if Err Then  moveFolder=false : errid=err.number : errdes=err.description:Err.Clear : echoErr err_moveFolder,errid,errdes else moveFolder=true
        end if
End Function

Function moveFile(ByVal src,ByVal target,Byval operType)
        dim srcPath,targetPath
        srcPath=Server.MapPath(src)
        targetPath=Server.MapPath(target)
        if isExistFile(src) then
                objFso.Copyfile srcPath,targetPath
                if operType="del" then  delFile src
                moveFile=true
        else
                moveFile=false
        end if
End Function

Function getFolderList(Byval cDir)
        dim filePath,objFolder,objSubFolder,objSubFolders,i
        i=0
        redim  folderList(0)
        filePath=server.mapPath(cDir)
        set objFolder=objFso.GetFolder(filePath)
        set objSubFolders=objFolder.Subfolders
        for each objSubFolder in objSubFolders
                ReDim Preserve folderList(i)
                With objSubFolder
                        folderList(i)=.name&",文件夹,"&.size/1000&"k,"&.DateLastModified&","&cDir&"/"&.name
                End With
                i=i + 1
        next
        set objFolder=nothing
        set objSubFolders=nothing
        getFolderList=folderList
End Function

Function getFileList(Byval cDir)
        dim filePath,objFolder,objFile,objFiles,i
        i=0
        redim  fileList(0)
        filePath=server.mapPath(cDir)
        set objFolder=objFso.GetFolder(filePath)
        set objFiles=objFolder.Files
        for each objFile in objFiles
                ReDim Preserve fileList(i)
                With objFile
                        fileList(i)=.name&","&Mid(.name, InStrRev(.name, ".") + 1)&","&.size/1000&"k,"&.DateLastModified&","&cDir&"/"&.name
                End With
                i=i + 1
        next
        set objFiles=nothing
        set objFolder=nothing
        getFileList=fileList
End Function


Function urldecode(ByVal sUrl)
        Dim i,c,ts,b,lc,t,n:ts="":b=false:lc=""
        for i=1 to len(sUrl)
                c=mid(sUrl,i,1)
                if c="+" then
                        ts=ts & " "
                elseif c="%" then
                        t=mid(sUrl,i+1,2):n=cint("&H" & t)
                        if b then
                                b=false:ts=ts & chr(cint("&H" & lc & t))
                        else
                                if abs(n)<=127 then
                                        ts=ts & chr(n)
                                else
                                        b=true:lc=t
                                end if
                        end if
                        i=i+2
                else
                        ts=ts & c
                end if
        next
        urldecode=ts
End Function

Function urlencode(ByVal sUrl)
        if InStr(" "&sUrl,"?")>0 then
                dim ts,i,l,s:ts=Split(Mid(sUrl,InStr(sUrl,"?")+1),"&"):l=UBound(ts)
                for i=0 to l
                        if InStr(" "&ts(i),"=")>0 then
                                s=Split(ts(i),"=")
                                if s(1)<>"" then
                                        if InStr(" "&s(1),"%") then:s(1)=urldecode(s(1)):end if
                                        s(1)=Server.urlencode(s(1)):ts(i)=Join(s,"=")
                                end if
                        end if
                next
                urlencode=Mid(sUrl,1,InStr(sUrl,"?"))&Join(ts,"&")
        else
                urlencode=sUrl
        end if
End Function

dim gXmlHttpVer
Function getXmlHttpVer()
        dim i,xmlHttpVersions,xmlHttpVersion
        getXmlHttpVer=false
        xmlHttpVersions=Array("Microsoft.XMLHTTP", "MSXML2.XMLHTTP", "MSXML2.XMLHTTP.3.0","MSXML2.XMLHTTP.4.0","MSXML2.XMLHTTP.5.0")
        for i=0 to ubound(xmlHttpVersions)
                xmlHttpVersion=xmlHttpVersions(i)
                if isInstallObj(xmlHttpVersion) then getXmlHttpVer=xmlHttpVersion:gXmlHttpVer=xmlHttpVersion: Exit Function
        next
End Function

Function tryXmlHttp()
        dim i,ah:ah=array("MSXML2.ServerXMLHTTP.5.0","MSXML2.ServerXMLHTTP","MSXML2.ServerXMLHTTP.2.0","MSXML2.ServerXMLHTTP.3.0","MSXML2.ServerXMLHTTP.4.0","MSXML2.ServerXMLHTTP.6.0","Microsoft.XMLHTTP", "MSXML2.XMLHTTP", "MSXML2.XMLHTTP.3.0","MSXML2.XMLHTTP.4.0","MSXML2.XMLHTTP.5.0")
        On Error Resume Next
        for i=0 to UBound(ah)
                SET tryXmlHttp=Server.CreateObject(ah(i))
                if err.number=0 then:gXmlHttpVer=ah(i):tryXmlHttp.setTimeouts 2000,20000,20000,180000:err.clear:Exit Function:else:err.clear:end if
        next
End Function

dim gXmlHttpObj
Function getRemoteContent(Byval url,Byval returnType)
        if not isObject(gXmlHttpObj) then:set gXmlHttpObj=tryXmlHttp():end if
        url=urlencode(url):gXmlHttpObj.open "GET",url,False
        On error resume next
        gXmlHttpObj.send()
        if err.number = -2147012894 then
                dim des
                select case gXmlHttpObj.readyState
                        Case 1:des="解析域名或连接远程服务器"
                        Case 2:des="发送请求"
                        Case 3:des="接收数据"
                        Case else:des="未知阶段"
                end select
                die gXmlHttpVer&"组件<br />在请求 “"&url&"”时<br />发生" + des + " 超时错误,请重试.如果问题还没解决，请联系你的服务商"
        else
                select case returnType
                        case "text"
                                getRemoteContent=gXmlHttpObj.responseText
                        case "body"
                                getRemoteContent=gXmlHttpObj.responseBody
                end select
        end if
End Function

'Function getRemoteContent(Byval url,Byval returnType)
'        if not isObject(gXmlHttpObj) then:set gXmlHttpObj=tryXmlHttp():end if
'        gXmlHttpObj.open "GET",url,False
'        gXmlHttpObj.send()
'        select case returnType
'                case "text"
'                        getRemoteContent=gXmlHttpObj.responseText
'                case "body"
'                        getRemoteContent=gXmlHttpObj.responseBody
'        end select
'End Function

Function bytesToStr(Byval responseBody,Byval strCharSet)
        with objStream
                .Type=1
                .Mode =3
                .Open
                .Write responseBody
                .Position=0
                .Type=2
                .Charset=strCharSet
                bytesToStr=objstream.ReadText
                objstream.Close
        End With
End Function

Function computeStrLen(Byval str)
        dim strlen,charCount,i
        str=trim(str)   
        charCount=len(str)   
        strlen=0   
        for i=1 to charCount   
                if asc(mid(str,i,1)) < 0 or asc(mid(str,i,1)) >255 then   
                        strlen=strlen + 2
                else   
                        strlen=strlen + 1
                end if
        next
        computeStrLen=strlen
End Function

Function getStrByLen(Byval str, Byval strlen)
        dim vStrlen,charCount,i
        str=trim(str)
        if isNul(str) then Exit Function   
        charCount=len(str)  
        vStrlen=0   
        for i=1 to charCount   
                if asc(mid(str,i,1)) < 0 or asc(mid(str,i,1)) >255 then   
                        vStrlen=vStrlen + 2
                else   
                        vStrlen=vStrlen + 1
                end if
                if vStrlen >= strlen then  getStrByLen=left(str,i) : Exit Function
        next
        getStrByLen=left(str,charCount)
End Function

Function encodeHtml(Byval str)
        IF len(str)=0 OR Trim(str)="" then exit function
                str=replace(str,"<","&lt;")
                str=replace(str,">","&gt;")
                str=replace(str,CHR(34),"&quot;")
                str=replace(str,CHR(39),"&apos;")
                encodeHtml=str
End Function

Function decodeHtml(Byval str)
        IF len(str)=0 OR Trim(str)="" or isNull(str) then exit function
                str=replace(str,"&lt;","<")
                str=replace(str,"&gt;",">")
                str=replace(str,"&quot;",CHR(34))
                str=replace(str,"&apos;",CHR(39))
                decodeHtml=str
End Function

Function codeTextarea(Byval str,Byval enType)
        select case enType
                case "en"
                        codeTextarea=replace(replace(str,chr(10),""),chr(13),"<br>")
                case "de"
                        codeTextarea=replace(str,"<br>",chr(13)&chr(10))
        end select
End Function

Function timeToStr(Byval t)
        t=Replace(Replace(Replace(Replace(t,"-",""),":","")," ",""),"/","") : timeToStr=t
End Function

Function makePageNumber(Byval currentPage,Byval pageListLen,Byval totalPages,Byval linkType)
        currentPage=clng(currentPage)
        dim beforePages,pagenumber,page
        dim beginPage,endPage,strPageNumber
        if pageListLen mod 2=0 then beforePages=pagelistLen / 2 else beforePages=clng(pagelistLen / 2) - 1
        if  currentPage < 1  then currentPage=1 else if currentPage > totalPages then currentPage=totalPages
        if pageListLen > totalPages then pageListLen=totalPages
        if currentPage - beforePages < 1 then
                beginPage=1 : endPage=pageListLen
        elseif currentPage - beforePages + pageListLen > totalPages  then
                beginPage=totalPages - pageListLen + 1 : endPage=totalPages
        else
                beginPage=currentPage - beforePages : endPage=currentPage - beforePages + pageListLen - 1
        end if       
        for pagenumber=beginPage  to  endPage
                if pagenumber=1 then page="" else page=pagenumber

                if clng(pagenumber)=clng(currentPage) then
                        if linkType="search" or linkType="channel"  or linkType="newspagelist"  or linkType="topicpage" then
                                strPageNumber=strPageNumber&"<em>"&pagenumber&"</em>"
                        else
                                strPageNumber=strPageNumber&"<span><font color=red>"&pagenumber&"</font></span>"
                        end if
                else
                        select case linkType
                                case "channel"
                                        strPageNumber=strPageNumber&"<a href='"&getChannelPagesLink(currentTypeId,pagenumber)&"'>"&pagenumber&"</a>"
                                case "search"
                                        strPageNumber=strPageNumber&"<a href='?page="&pagenumber&"&searchword="&searchword&"&searchtype="&searchType&"'>"&pagenumber&"</a>"
                                case "videolist"  
                                           strPageNumber=strPageNumber&"<a href='?page="&pagenumber&"&order="&order&"&type="&vtype&"&keyword="&keyword&"&m_state="&m_state&"&m_commend="&m_commend&"&repeat="&repeat&"&topic="&pTopic&"&playfrom="&playfrom&"'>"&pagenumber&"</a>"
                                  case "adslist","selflabellist","templist"
                                        strPageNumber=strPageNumber&"<a href='?page="&pagenumber&"'>"&pagenumber&"</a>"
                                case "newslist"
                                        strPageNumber=strPageNumber&"<a href='?page="&pagenumber&"&where="&where&"&action="&action&"'>"&pagenumber&"</a>"
                                case "topicpage"
                                        strPageNumber=strPageNumber&"<a href='"&getTopicPageLink(currrent_topic_id,pagenumber)&"'>"&pagenumber&"</a>"
                                case "newspagelist"
                                        strPageNumber=strPageNumber&"<a href='"&getNewsChannelLink(pagenumber)&"'>"&pagenumber&"</a>"
                        end select
                end if       
        next
        makePageNumber=strPageNumber
End Function

7kbb

Function pageNumberLinkInfo(Byval currentPage,Byval pageListLen,Byval totalPages,Byval linkType,Byval totalRecords)
        dim pageNumber,pagesStr,i,pageNumberInfo,firstPageLink,lastPagelink,nextPagelink,finalPageLink
        pageNumber=makePageNumber(currentPage,pageListLen,totalPages,linkType)
        select case  linkType
                case "search"
                        if currentPage=1 then
                                firstPageLink="<em class='nolink'>首页</em>" : lastPagelink="<em class='nolink'>上一页</em>"
                        else
                                firstPageLink="<a  href='?page=1&searchword="&searchword&"&searchtype="&searchType&"'>首页</a>" : lastPagelink="<a  href='?page="&currentPage-1&"&searchword="&searchword&"&searchtype="&searchType&"'>上一页</a>"
                        end if
                        if currentPage=totalPages then
                                nextPagelink="<em class='nolink'>下一页</em>" : finalPageLink="<em class='nolink'>尾页</em>"
                        else
                                nextPagelink="<a  href='?page="&currentPage+1&"&searchword="&searchword&"&searchtype="&searchType&"'>下一页</a>" : finalPageLink="<a  href='search.asp?page="&totalPages&"&searchword="&searchword&"&searchtype="&searchType&"'>尾页</a>"
                        end if
                        pagesStr="<span><input type='input' name='page' size=4  /><input type='button' value='跳转' onclick=""goSearchPage("&totalPages&",'page','"&searchType&"','"&searchword&"')"" class='btn' /></span>"
                        pageNumberInfo="<span>共"&totalRecords&"条数据 页次:"&currentPage&"/"&totalPages&"页</span>"&firstPageLink&lastPagelink&pageNumber&""&nextPagelink&""&finalPagelink&pagesStr
                case "channel"
                        if currentPage=1 then  
                                getChannelPagesLink currentTypeId,currentPage-1
                                firstPageLink="<em class='nolink'>首页</em>" : lastPagelink="<em class='nolink'>上一页</em>"
                        else
                                firstPageLink="<a  href='"&getChannelPagesLink(currentTypeId,1)&"'>首页</a>" : lastPagelink="<a  href='"&getChannelPagesLink(currentTypeId,currentPage-1)&"'>上一页</a>"
                        end if
                        if currentPage=totalPages then
                                nextPagelink="<em class='nolink'>下一页</em>" : finalPageLink="<em class='nolink'>尾页</em>"
                        else
                                nextPagelink="<a  href='"&getChannelPagesLink(currentTypeId,currentPage+1)&"'>下一页</a>" : finalPageLink="<a  href='"&getChannelPagesLink(currentTypeId,totalPages)&"'>尾页</a>"
                        end if
                        pagesStr="<span><input type='input' name='page' size=4  /><input type='button' value='跳转' onclick=""getPageGoUrl("&totalPages&",'page',"&pageUrlStyle&",'"&channelPageName2&fileSuffix&"')"" class='btn' /></span>"
                        pageNumberInfo="<span>共"&totalRecords&"条数据 页次:"&currentPage&"/"&totalPages&"页</span>"&firstPageLink&lastPagelink&pageNumber&""&nextPagelink&""&finalPagelink&pagesStr
                case "topicpage"
                        if currentPage=1 then  
                                getTopicPageLink currrent_topic_id,currentPage-1
                                firstPageLink="<em class='nolink'>首页</em>" : lastPagelink="<em class='nolink'>上一页</em>"
                        else
                                firstPageLink="<a  href='"&getTopicPageLink(currrent_topic_id,1)&"'>首页</a>" : lastPagelink="<a  href='"&getTopicPageLink(currrent_topic_id,currentPage-1)&"'>上一页</a>"
                        end if
                        if currentPage=totalPages then
                                nextPagelink="<em class='nolink'>下一页</em>" : finalPageLink="<em class='nolink'>尾页</em>"
                        else
                                nextPagelink="<a  href='"&getTopicPageLink(currrent_topic_id,currentPage+1)&"'>下一页</a>" : finalPageLink="<a  href='"&getTopicPageLink(currrent_topic_id,totalPages)&"'>尾页</a>"
                        end if
                        pagesStr="<span><input type='input' name='page' size=4  /><input type='button' value='跳转' onclick=""getPageGoUrl("&totalPages&",'page',"&pageUrlStyle&",'"&channelPageName2&fileSuffix&"')"" class='btn' /></span>"
                        pageNumberInfo="<span>共"&totalRecords&"条数据 页次:"&currentPage&"/"&totalPages&"页</span>"&firstPageLink&lastPagelink&pageNumber&""&nextPagelink&""&finalPagelink&pagesStr
                case "newspagelist"
                        if currentPage=1 then  
                                getNewsChannelLink currentPage-1
                                firstPageLink="<em class='nolink'>首页</em>" : lastPagelink="<em class='nolink'>上一页</em>"
                        else
                                firstPageLink="<a  href='"&getNewsChannelLink(1)&"'>首页</a>" : lastPagelink="<a  href='"&getNewsChannelLink(currentPage-1)&"'>上一页</a>"
                        end if
                        if clng(currentPage)=clng(totalPages) then
                                nextPagelink="<em class='nolink'>下一页</em>" : finalPageLink="<em class='nolink'>尾页</em>"
                        else
                                nextPagelink="<a  href='"&getNewsChannelLink(currentPage+1)&"'>下一页</a>" : finalPageLink="<a  href='"&getNewsChannelLink(totalPages)&"'>尾页</a>"
                        end if
                        pagesStr="<span><input type='input' name='page' size=4  /><input type='button' value='跳转' onclick=""getPageGoUrl("&totalPages&",'page',4,'"&channelPageName2&fileSuffix&"')"" class='btn' /></span>"
                        pageNumberInfo="<span>共"&totalRecords&"条数据 页次:"&currentPage&"/"&totalPages&"页</span>"&firstPageLink&lastPagelink&pageNumber&""&nextPagelink&""&finalPagelink&pagesStr
        end select
        pageNumberLinkInfo=pageNumberInfo
End Function

Function getTopicPageLink(Byval topicId,Byval page)
        dim linkStr,topicPath,tempStr,topicname
        if runMode="dynamic" then
                if clng(page)=1 then tempStr=""  else tempStr="-"&page
                linkStr="/"&sitePath&topicDirName&"/?"&topicId&tempStr&fileSuffix
                pageUrlStyle=1
        elseif runMode="static" then
                topicname=conn.db("select m_enname from {pre}topic where m_id="&topicId,"array")(0,0)
                if clng(page)=1 then tempStr=""  else tempStr="-"&page
                linkStr="/"&sitePath&topicDirName&"/"&topicname&tempStr&fileSuffix
                pageUrlStyle=6
        elseif runMode="forgedStatic" then
                if clng(page)=1 then tempStr=""  else tempStr="-"&page
                linkStr="/"&sitePath&topicDirName4&"/"&topicId&tempStr&fileSuffix
                pageUrlStyle=5
        end if
        getTopicPageLink=linkStr
End Function

Function getChannelPagesLink(Byval typeId,Byval page)
        dim linkStr,typePath,tempStr
        if runMode="dynamic" then
                if clng(page)=1 then tempStr=""  else tempStr="-"&page
                linkStr="/"&sitePath&channelDirName1&"/?"&typeId&tempStr&fileSuffix
                pageUrlStyle=1
        elseif runMode="static" and makeMode="dir1" then
                pageUrlStyle=2
                typePath=getTypePathOnCache(typeId)
                if clng(page)=1 then page=""
                linkStr="/"&sitePath&typePath&channelPageName2&page&fileSuffix
        elseif runMode="static" and makeMode="dir2" then
                pageUrlStyle=3
                if clng(page)=1 then tempStr=""  else tempStr="_"&page
                linkStr="/"&sitePath&channelDirName3&"/"&channelPageName3&typeId&tempStr&fileSuffix
        elseif runMode="forgedStatic" then
                pageUrlStyle=5
                if clng(page)=1 then tempStr=""  else tempStr="-"&page
                linkStr="/"&sitePath&channelDirName4&"/"&channelPageName4&typeId&tempStr&fileSuffix
        end if
        getChannelPagesLink=linkStr
End Function

Function getTypeLink(Byval typeId)
        dim linkStr,typePath,fileName
        if runMode="dynamic" then  
                linkStr="/"&sitePath&channelDirName1&"/?"&typeId&fileSuffix
        elseif runMode="static" and makeMode="dir1"   then
                fileName=channelPageName2&fileSuffix
                typePath=getTypePathOnCache(typeId)
                linkStr="/"&sitePath&typePath
        elseif runMode="static" and makeMode="dir2" then
                linkStr="/"&sitePath&channelDirName3&"/"&channelPageName3&typeId&fileSuffix
        elseif runMode="forgedStatic" then
                linkStr="/"&sitePath&channelDirName4&"/"&channelPageName4&typeId&fileSuffix
        end if
        getTypeLink=linkStr
End Function

Function getNewsContentLink(Byval newsId,Byval newsDate)
        dim linkStr
        if runMode="dynamic" then  
                linkStr="/"&sitePath&newsDirName&"/?"&newsId&fileSuffix
        elseif runMode="static" then
                linkStr="/"&sitePath&newsDirName&"/"&getNewsFolder(newsDate)&"/"&newsId&fileSuffix
        elseif runMode="forgedStatic" then
                linkStr="/"&sitePath&newsDirName&"/"&newsId&fileSuffix
        end if
        getNewsContentLink=linkStr
End Function

Function getNewsChannelLink(Byval page)
        dim linkstr
        if runMode="dynamic" then  
                if page=1  then  
                        linkStr="/"&sitePath&newsDirName&"/?"&newsPageListName&fileSuffix
                else
                        linkStr="/"&sitePath&newsDirName&"/?"&newsPageListName&"-"&page&fileSuffix
                end if
        elseif runMode="static" then
                if page=1 then  
                        linkStr="/"&sitePath&newsDirName&"/index"&fileSuffix
                else
                        linkStr="/"&sitePath&newsDirName&"/index_"&page&fileSuffix
                end if
        elseif runMode="forgedStatic" then
                if page=1 then  
                        linkStr="/"&sitePath&newsDirName&"/"&newsPageListName&fileSuffix
                else
                        linkStr="/"&sitePath&newsdirname&"/"&newsPageListName&"-"&page&fileSuffix
                end if
        end if
        getNewsChannelLink=linkStr        
End Function

Function getContentLink(Byval typeId,Byval videoId,Byval linkType)
        dim linkStr,typePath
        if runMode="dynamic" then  
                linkStr="/"&sitePath&contentDirName1&"/?"&videoId&fileSuffix
        elseif runMode="static" and makeMode="dir1"   then
                typePath=getTypePathOnCache(typeId)
                if md5Content=1 then videoId=md5(videoId,16)
                if isNul(linkType) then linkStr="/"&sitePath&typePath&videoId&"/"&contentPageName2&fileSuffix else linkStr="/"&sitePath&typePath&videoId&"/"
        elseif runMode="static" and makeMode="dir2" then
                if md5Content=1 then
                        videoId=md5(videoId,16)
                        linkStr="/"&sitePath&contentDirName3&"/"&videoId&fileSuffix
                else
                        linkStr="/"&sitePath&contentDirName3&"/"&contentPageName3&videoId&fileSuffix
                end if
        elseif runMode="forgedStatic" then
                linkStr="/"&sitePath&contentDirName4&"/"&contentPageName4&videoId&fileSuffix
        end if
        getContentLink=linkStr
End Function

Function getPlayLink(Byval typeId,Byval videoId)
        dim linkStr,typePath
        if runMode="static" and ismakeplay=0 then getPlayLink="/"&sitePath&playDirName1&"/?"&videoId:Exit Function
        if runMode="dynamic" then  
                linkStr="/"&sitePath&playDirName1&"/?"&videoId
        elseif runMode="static" and makeMode="dir1"   then
                typePath=getTypePathOnCache(typeId)
                if md5Content=1 then  videoId=md5(videoId,16)
                linkStr="/"&sitePath&typePath&videoId&"/"&playPageName2&fileSuffix
        elseif runMode="static" and makeMode="dir2" then
                if md5Content=1 then  videoId=md5(videoId,16):linkStr="/"&sitePath&playDirName3&"/"&videoId&fileSuffix else linkStr="/"&sitePath&playDirName3&"/"&playPageName3&videoId&fileSuffix
        elseif runMode="forgedStatic"  then
                linkStr="/"&sitePath&playDirName4&"/"&videoId
        end if
        getPlayLink=linkStr
End Function

Function getPlayLink2(typeId,vId)
        dim contactStr,behindStr
        if runMode="dynamic" or ismakeplay=0   then  
                contactStr="":behindStr=fileSuffix
        elseif runMode="static"  then
                contactStr="?"&vId:behindStr=""
        elseif  runMode="forgedStatic"  then
                contactStr="":behindStr=fileSuffix
        end if
        getPlayLink2=getPlayLink(typeId,vId)&contactStr&"-0-0"&behindStr
End Function

Function getPlayerParas()
        Dim paras:paras=Split(replaceStr(request.QueryString,fileSuffix,""),"-")
        if UBound(paras)>1 then
                getPlayerParas=array(paras(1),paras(2))
        else
                getPlayerParas=array(-1,-1)
        end if
End Function

Function getPlayUrlList(Byval ifrom,Byval url,Byval typeId,Byval vId,Byval typestr,ByVal starget)
        dim urlArray,singleUrlArray,urlCount,i,urlStr,contactStr,behindStr,style,paras,target:paras=getPlayerParas()
        if runMode="dynamic" or ismakeplay=0 then
                contactStr="":behindStr=fileSuffix
        elseif runMode="static" then
                contactStr="?"&vId:behindStr=""
        elseif  runMode="forgedStatic"  then
                contactStr="":behindStr=fileSuffix
        end if
        if isNul(url) then
                getPlayUrlList="" : Exit Function
        else
                if ""&starget<>"" then
                        target=" target="""&starget&""""
                else
                        target=" target=""_blank"""
                end if
                urlArray=split(url,"#")
                urlCount=ubound(urlArray)
                urlStr="<ul>"
                for i=0 to urlCount
                        if not isNul(urlArray(i)) then
                                singleUrlArray=split(urlArray(i),"$")
                                if ubound(singleUrlArray)<2 then singleUrlArray=Array("","","")
                                if ""&paras(0)=""&ifrom AND ""&i=""&paras(1) then style=" style=""color:red""" else style=""
                                select case typestr
                                        case "play"
                                                if isAlertWin=1 then
                                                        urlStr=urlStr&"<li><a title='"&singleUrlArray(0)&"' href=""javascriptpenWin('"&getPlayLink(typeId,vId)&contactStr&"-"&ifrom&"-"&i&behindStr&"',"&(alertWinW+10)&","&(alertWinH+55)&",250,100,1)"""&style&">"&singleUrlArray(0)&"</a></li>"
                                                else
                                                        urlStr=urlStr&"<li><a title='"&singleUrlArray(0)&"' href='"&getPlayLink(typeId,vId)&contactStr&"-"&ifrom&"-"&i&behindStr&"'"&style&target&">"&singleUrlArray(0)&"</a></li>"
                                                end if
                                        case "down"
                                                urlStr=urlStr&"<li><a href='"&singleUrlArray(1)&"'"&style&target&">"&singleUrlArray(0)&"</a></li>"
                                end select
                        end if
                next
        end if
        getPlayUrlList=urlStr&"</ul>"
End Function

Function getIndexLink()
        if runMode="dynamic" then  
                getIndexLink="/"&sitePath
        elseif runMode="static" and makeMode="dir1"   then
                getIndexLink="/"&sitePath
        elseif runMode="static" and makeMode="dir2" then
                getIndexLink="/"&sitePath
        elseif runMode="forgedStatic" then
                getIndexLink="/"&sitePath&"index"&fileSuffix
        end if
End Function

Function getTopicIndexLink()
        if runMode="dynamic" then
                getTopicIndexLink="/"&sitePath&topicDirName&"/"
        elseif runMode="static" then
                getTopicIndexLink="/"&sitePath&topicDirName&"/index"&fileSuffix
        elseif runMode="forgedStatic" then
                getTopicIndexLink="/"&sitePath&topicDirName4&"/index"&fileSuffix
        end if
End Function

'Function getTypePath(id)
'        dim m_upid,rsObj,typePath
'        set rsObj=conn.db("select m_enname,m_upid from {pre}type where m_id="&id,"records1")
'        if clng(rsObj("m_upid"))=0 then
'                getTypePath=rsObj("m_enname")&"/":Exit Function
'        else
'                typePath =getTypePath(rsObj("m_upid"))&rsObj("m_enname")&"/"
'                getTypePath=typePath
'        end if
'        rsObj.close
'        set rsObj=nothing
'End Function

Function getTypePath(ByVal id)
        Dim i,j,k,l,TL:TL=getTypeLists():j=getTypeindex("m_id"):k=getTypeindex("m_upid"):l=getTypeindex("m_enname"):getTypePath=""
        for i=0 to UBound(TL,2)
                if ""&TL(j,i)=""&id then
                        if clng(TL(k,i))=0 then
                                getTypePath=TL(l,i)&"/":Exit Function
                        else
                                getTypePath=getTypePath(TL(k,i))&TL(l,i)&"/"
                        end if
                end if
        next
End Function

Dim gTypePathCache
Function getTypePathOnCache(id)
        dim cacheName,pathStr:cacheName="str_get_curtype_dir_type"&id
        if not isArray(gTypePathCache) then ReDim gTypePathCache(1)
        if gTypePathCache(0)<>id then
                if cacheStart=1 then
                        if cacheObj.chkCache(cacheName) then pathStr=cacheObj.getCache(cacheName) else pathStr=getTypePath(id):cacheObj.setCache cacheName,pathStr end if
                else
                        pathStr=getTypePath(id)
                end if
                gTypePathCache(0)=id:gTypePathCache(1)=pathStr
        end if
        getTypePathOnCache=gTypePathCache(1)
End Function

'Function getTypeText(id)
'        dim m_upid,rsObj,typeText,indexStr
'        indexStr="<a href='"&getIndexLink()&"' >首页</a>&nbsp;&nbsp;&raquo;&nbsp;&nbsp;"
'        set rsObj=conn.db("select m_id,m_name,m_enname,m_upid from {pre}type where m_id="&id,"records1")
'        if rsObj("m_upid")=0 then
'                getTypeText=indexStr&"<a href='"&getTypeLink(rsObj("m_id"))&"' >"&rsObj("m_name")&"</a>":Exit Function
'        else
'                typeText =getTypeText(rsObj("m_upid"))&"&nbsp;&nbsp;&raquo;&nbsp;&nbsp;"&"<a href='"&getTypeLink(rsObj("m_id"))&"' >"&rsObj("m_name")&"</a>"
'                getTypeText=typeText
'        end if
'        rsObj.close
'        set rsObj=nothing
'End Function

7kbb

Function getTypeText(id)
        Dim i,j,k,l,TL:TL=getTypeLists():j=getTypeindex("m_id"):k=getTypeindex("m_upid"):l=getTypeindex("m_name"):getTypeText=""
        for i=0 to UBound(TL,2)
                if ""&TL(j,i)=""&id then
                        if clng(TL(k,i))=0 then
                                getTypeText="<a href='"&getIndexLink()&"' >首页</a>&nbsp;&nbsp;&raquo;&nbsp;&nbsp;<a href='"&getTypeLink(TL(j,i))&"' >"&TL(l,i)&"</a>":Exit Function
                        else
                                getTypeText=getTypeText(TL(k,i))&"&nbsp;&nbsp;&raquo;&nbsp;&nbsp;<a href='"&getTypeLink(TL(j,i))&"'>"&TL(l,i)&"</a>"
                        end if
                end if
        next
End Function

dim gTypeTextOnCache
Function getTypeTextOnCache(id)
        dim cacheName,typeText:cacheName="str_get_curtype_location_type"&id
        if not isArray(gTypeTextOnCache) then ReDim gTypeTextOnCache(1)
        if gTypeTextOnCache(0)<>id then
                if cacheStart=1 then
                        if cacheObj.chkCache(cacheName)  then typeText=cacheObj.getCache(cacheName) else typeText=getTypeText(id):cacheObj.setCache cacheName,typeText end if
                else
                        typeText=getTypeText(id)
                end if
                gTypeTextOnCache(0)=id:gTypeTextOnCache(1)=typeText
        end if
        getTypeTextOnCache=gTypeTextOnCache(1)
End Function

'Function getTypeId(id)
'        dim m_upid,rsObj,typeid,i
'        set rsObj=conn.db("select m_id,m_upid from {pre}type where m_upid="&id,"records1")
'        if rsObj.eof then
'                getTypeId=id : Exit Function
'        else
'                for i=1 to rsObj.recordcount
'                        typeid =typeid&","&getTypeId(rsObj("m_id"))
'                        rsObj.movenext
'                next
'                getTypeId=id&typeid
'        end if
'        rsObj.close
'        set rsObj=nothing
'End Function

Function getTypeId(ByVal id)
        dim i,j,k,TL,ret:TL=getTypeLists():j=getTypeIndex("m_upid"):k=getTypeIndex("m_id"):ret=""
        if Clng(id)>0 then:ret=id
        for i=0 to UBound(TL,2)
                if ""&TL(j,i)=""&id then
                        if ret="" then
                                ret=getTypeId(TL(k,i))
                        else
                                ret=ret&","&getTypeId(TL(k,i))
                        end if
                end if
        next
        getTypeId=ret
End Function

Function getTypeIdOnCache(Byval id)
        dim cacheName,typeid
        cacheName="str_get_subtypes_type"&id
        if cacheStart=1 then
                if cacheObj.chkCache(cacheName) then  typeid=cacheObj.getCache(cacheName) else typeid=getTypeId(id):cacheObj.setCache cacheName,typeid
        else
                typeid=getTypeId(id)
        end if
        getTypeIdOnCache=typeid
End Function

'Function getAllMenuList(id)
'        dim listStr,typeArray,smallTypeArray,m,i
'        typeArray=conn.db("select  m_name,m_id from {pre}type where m_upid="&id&" order by m_sort asc","array")
'        if not isArray(typeArray) then
'                getAllMenuList="" : Exit Function
'        else
'                listStr="<ul>"
'                for i=0 to ubound(typeArray,2)
'                        listStr=listStr&"<li>"&"<a href='"&getTypeLink(typeArray(1,i))&"' >"&typeArray(0,i)&"</a>"
'                        listStr=listStr&getAllMenuList(typeArray(1,i))
'                        listStr=listStr&"</li>"
'                next
'                listStr=listStr&"</ul>"
'        end if
'        getAllMenuList=listStr
'End Function

Function getAllMenuList(ByVal id)
        Dim i,j,k,l,TL,s:TL=getTypeLists():j=getTypeindex("m_upid"):k=getTypeindex("m_id"):l=getTypeindex("m_name"):getAllMenuList="":s=""
        for i=0 to UBound(TL,2)
                if ""&TL(j,i)=""&id then
                        s=s&"<li><a href='"&getTypeLink(TL(k,i))&"'>"&TL(l,i)&"</a>"&getAllMenuList(TL(k,i))&"</li>"
                end if
        next
        if s<>"" then:getAllMenuList="<ul>"&s&"</ul>":end if
End Function

Function getAllMenuListOnCache(id)
        dim cacheName,menuList
        cacheName="str_menu_list"&id
        if cacheStart=1 then
                if cacheObj.chkCache(cacheName) then menuList=cacheObj.getCache(cacheName) else menuList=getAllMenuList(id) : cacheObj.setCache cacheName,menuList
        else
                menuList=getAllMenuList(id)
        end if
        getAllMenuListOnCache=menuList
End Function

Dim gTypearray
Function getTypeListsArray()
        if Not isArray(gTypearray) then
                Dim Rows:Rows=conn.db("SELECT m_id,m_name,m_enname,m_sort,m_upid,m_hide,m_template,m_unionid,-1 AS m_count FROM {pre}type ORDER BY m_sort ASC","array")
                if isArray(Rows) then
                        gTypearray=Rows
                else
                        Redim gTypearray(8,-1)
                end if
        end if
        getTypeListsArray=gTypearray
End Function

Function getTypeLists()
        Dim cacheName:cacheName="array_Type_Lists_all"
        if cacheStart=1 AND not isArray(gTypearray) then
                if cacheObj.chkCache(cacheName) then gTypearray=cacheObj.getCache(cacheName) else cacheObj.setCache cacheName,getTypeListsArray()
        end if
        getTypeLists=getTypeListsArray()
End Function

Function getNumPerType(ByVal id)
        dim ids,num,i,j,l,Bool:j=getTypeIndex("m_id"):l=getTypeIndex("m_count"):num=0:Bool=false
        if not isArray(gTypearray) then:getTypeLists():end if
        ids = " ,"&Replace(getTypeIdOnCache(id)," ","")&","
        for i=0 to UBound(gTypearray,2)
                if InStr(ids,","&trim(gTypearray(j,i))&",")>0 then
                        gTypearray(l,i)=Clng(gTypearray(l,i))
                        if gTypearray(l,i)=-1 then:gTypearray(l,i)=conn.db("select count(*) from {pre}data where m_type="&gTypearray(j,i),"execute")(0):end if
                        num=num+Clng(gTypearray(l,i)):Bool=true
                end if
        next
        if Bool=true then
                if cacheStart=1 then
                        cacheObj.setCache "array_Type_Lists_all",gTypearray
                end if
        end if
        getNumPerType = num
End Function

Function getTypeindex(ByVal sName)
        dim i
        SELECT Case sName
                Case "m_id":i=0
                Case "m_name":i=1
                Case "m_enname":i=2
                Case "m_sort":i=3
                Case "m_upid":i=4
                Case "m_hide":i=5
                Case "m_template":i=6
                Case "m_unionid":i=7
                Case "m_count":i=8
        End SELECT
        getTypeindex=i
End Function

Dim gHideTypeIDS:gHideTypeIDS=empty
Function getHideTypeIDS()
        if gHideTypeIDS=empty then
                Dim i,j,k,ret,TS:TS=getTypeLists():j=getTypeIndex("m_hide"):k=getTypeIndex("m_id"):ret=""
                for i=0 to UBound(TS,2)
                        if ""&TS(j,i)="1" then
                                if ret="" then
                                        ret=TS(k,i)
                                else
                                        ret=ret&","&TS(k,i)
                                end if
                        end if
                next
                gHideTypeIDS=ret
        end if
        getHideTypeIDS=gHideTypeIDS
End Function

7kbb

dim span : span=""
Sub makeTypeOption(topId,separateStr)
        Dim i,j,k,m,TL:TL=getTypeLists():j=getTypeindex("m_id"):k=getTypeindex("m_upid"):m=getTypeindex("m_name")
        for i=0 to UBound(TL,2)
                if ""&TL(k,i)=""&topId then
                        if topId<>0 then span=span&separateStr
                        echo "<option value='"&TL(j,i)&"'>"&span&"&nbsp;|—"&TL(m,i)&"</option>"
                        makeTypeOption TL(j,i),separateStr
                end if
        next
        if not isNul(span) then span=left(span,len(span)-len(separateStr))
End Sub

'yuet 2009-10-10 18:30 优化递归查询,下面旧函不用了
'Sub makeTypeOption(topId,separateStr)
'        dim sqlStr,rsObj
'        sqlStr= "select m_id,m_name from {pre}type where m_upid="&topId&" order by m_sort asc"
'        set rsObj=conn.db(sqlStr,"records1")
'        do while not rsObj.eof
'                if topId<>0 then span=span&separateStr
'                echo "<option value='"&rsObj("m_id")&"'>"&span&"&nbsp;|—"&rsObj("m_name")&"</option>"
'                makeTypeOption rsObj("m_id"),separateStr
'                rsObj.movenext
'        loop
'        if not isNul(span) then span=left(span,len(span)-len(separateStr))
'        rsObj.close
'        set rsObj=nothing
'End Sub

Sub makeTypeSelect(selectName)
        echo "<select name='"&selectName&"'>"
        echo "<option value=''>请选择视频分类</option>"
        makeTypeOption 0,"&nbsp;|&nbsp;&nbsp;"
        echo "</select>"
End Sub

Function makeTopicSelect(selectName,arrayObj,strSelect,topicId)
                dim i,str,selectedStr
                str="<select id='"&selectName&"'  name='"&selectName&"' >"
                if not isNul(strSelect) then  str=str&"<option value=''>"&strSelect&"</option>"
                if isArray(arrayObj) then
                        for  i=0 to ubound(arrayObj,2)
                                if not isNul(topicId) then
                                        if clng(arrayObj(0,i))=clng(topicId) then   selectedStr="selected" else  selectedStr=""
                                end if
                                str=str &"<option value='"&arrayObj(0,i)&"' "&selectedStr&">"&arrayObj(1,i)&"</option>"
                        next
                end if
                str=str&"</select>"
                makeTopicSelect=str
End Function

Function makeTopicOptions(arrayObj,strSelect)
        dim i,str
        if not isNul(str) then  str=str&"<option value='-1'>"&strSelect&"</option>"
        if isArray(arrayObj) then
                for  i=0 to ubound(arrayObj,2)
                        str=str&"<option value='"&arrayObj(0,i)&"'>"&arrayObj(1,i)&"</option>"
                next
        end if
        makeTopicOptions=str
End Function

Function arrayToDictionay(Byval arrayObj)
        dim dictionaryObj : set dictionaryObj=server.CreateObject(DICTIONARY_OBJ_NAME)
        dim dicKey,dicValue,i
        if isArray(arrayObj) then
                for i=0 to ubound(arrayObj,2)
                        dicKey= arrayObj(0,i) : dicValue= arrayObj(1,i)
                        if not dictionaryObj.Exists(dicKey) then dictionaryObj.add dicKey,dicValue  else  dictionaryObj(dicKey)=dicValue
                next
        end if
        set arrayToDictionay=dictionaryObj
End Function

'Function typeArrayToDictionay(Byval arrayObj)
'        dim dictionaryObj : set dictionaryObj=server.CreateObject(DICTIONARY_OBJ_NAME)
'        dim dicKey,dicValue,i
'        if isArray(arrayObj) then
'                for i=0 to ubound(arrayObj,2)
'                        dicKey= arrayObj(0,i) : dicValue= arrayObj(1,i)&","&arrayObj(2,i)&","&arrayObj(3,i)
'                        if not dictionaryObj.Exists(dicKey) then dictionaryObj.add dicKey,dicValue  else  dictionaryObj(dicKey)=dicValue
'                next
'        end if
'        set typeArrayToDictionay=dictionaryObj
'End Function

Function typeArrayToDictionay()
        dim dictionaryObj,TS : set dictionaryObj=server.CreateObject(DICTIONARY_OBJ_NAME):TS=getTypeLists()
        dim dicKey,dicValue,i,j,k,l,m:j=getTypeIndex("m_id"):k=getTypeIndex("m_name"):l=getTypeIndex("m_enname"):m=getTypeIndex("m_upid")
        if isArray(TS) then
                for i=0 to ubound(TS,2)
                        dicKey= TS(j,i) : dicValue= TS(k,i)&","&TS(l,i)&","&TS(m,i)
                        if not dictionaryObj.Exists(dicKey) then dictionaryObj.add dicKey,dicValue  else  dictionaryObj(dicKey)=dicValue
                next
        end if
        set typeArrayToDictionay=dictionaryObj
End Function

'Function getTypeNameTemplateArrayOnCache(m_id)
'        dim cacheName,typeArray,elementId
'        cacheName="array_type_id_name_template_upid"
'        if cacheStart=1 then
'                if cacheObj.chkCache(cacheName) then  typeArray=cacheObj.getCache(cacheName) else typeArray=conn.db("select m_id,m_name,m_template,m_upid from {pre}type order by m_sort asc","array") : cacheObj.setCache cacheName,typeArray
'        else
'                typeArray=conn.db("select m_id,m_name,m_template,m_upid from {pre}type order by m_sort asc","array")
'        end if
'        elementId=getArrayElementID(typeArray,0,m_id)
'        getTypeNameTemplateArrayOnCache=typeArray(1,elementId)&","&typeArray(2,elementId)&","&typeArray(3,elementId)
'End Function

Function getTypeNameTemplateArray(m_id)
        dim typeArray,i,j,ret:j=getTypeIndex("m_id"):ret="":typeArray=getTypeLists()
        for i=0 to UBound(typeArray,2)
                if ""&typeArray(j,i)=""&m_id then
                        ret=typeArray(getTypeIndex("m_name"),i)&","&typeArray(getTypeIndex("m_template"),i)&","&typeArray(getTypeIndex("m_upid"),i):exit for
                end if
        next
        getTypeNameTemplateArray=ret
End Function

Function getTypeNameTemplateArrayOnCache(m_id)
        dim cacheName,ret:cacheName="array_type_id_name_template_upid"&m_id
        if cacheStart=1 then
                if cacheObj.chkCache(cacheName) then ret=cacheObj.getCache(cacheName) else ret=getTypeNameTemplateArray(m_id) : cacheObj.setCache cacheName,ret
        else
                ret=getTypeNameTemplateArray(m_id)
        end if
        getTypeNameTemplateArrayOnCache=ret
End Function

Sub echoSaveStr(ptype)
        dim cssstr
        cssstr="<style>body{text-align:center}#msg{background-color:white;border:1px solid #1B76B7;margin:0 auto;width:400px;text-align:left}.msgtitle{padding:3px 3px;color:white;font-weight:700;line-height:21px;height:25px;font-size:12px;border-bottom:1px solid #1B76B7; text-indent:3px; background-color:#1B76B7}#msgbody{font-size:12px;padding:40px 8px 50px;line-height:25px}#msgbottom{text-align:center;height:20px;line-height:20px;font-size:12px;background-color:#1b76b7;color:#FFFFFF}</style>"
        select case ptype
                case "safe"
                        die cssstr&"<div id='msg'><div class='msgtitle'>【警告】非法提交：</div><div id='msgbody'>你提交的数据有非法字符，你的IP【<b>"&getIp&"</b>】已被记录,操作时间:"&now()&"</div><div id='msgbottom'>Powered By "&siteName&"</div></div>"
                case "null"
                        die cssstr&"<div id='msg'><div class='msgtitle'>【警告】参数错误：</div><div id='msgbody'><b>错误描述</b>：参数为空或不正确</div><div id='msgbottom'>Powered By "&siteName&"</div></div>"
        end Select
        cssstr=""
End Sub

Function preventSqlin(content,vtype)
        dim sqlStr,sqlArray,i,speStr
        sqlStr="<|>|%|%27|'|''|;|*|and|exec|dbcc|alter|drop|insert|select|update|delete|count|master|truncate|char|declare|where|set|declare|mid|chr"
        if isNul(content) then Exit Function
        sqlArray=split(sqlStr,"|")
        for i=lbound(sqlArray) to ubound(sqlArray)
                if instr(lcase(content),sqlArray(i))<>0 then
                        if vtype="filter" then
                                select case sqlArray(i)
                                        case "<":speStr="&lt;"
                                        case ">":speStr="&gt;"
                                        case "'","""":speStr="&quot;"
                                        case ";":speStr="；"
                                        case else:speStr=""
                                end select
                                content=replace(content,sqlArray(i),speStr,1,-1,1)
                        else
                                echoSaveStr "safe" : Exit Function
                        end if
                end if
        next
        preventSqlin=content
End Function

Function replaceCurrentTypeId(str)
        str=replaceStr(str,"{maxcms:currenttypeid}",currentTypeId)
        replaceCurrentTypeId=str
End Function

Sub checkRunMode
        if runMode<>"static" then  die "<div style='width:50%;margin-top:50px;background:#66CCCC;font-size:13px;'><br><font color='red'>网站运行模式非静态，不允许生成</font><br><br></div>"
End Sub

Sub isCurrentDay(timeStr)
        if isNul(timeStr) then echo "":Exit Sub
        dim timeStr2 : timeStr2=date
        if instr(timeStr,timeStr2)>0 then  echo "<span style='color:red;font-size:10px'>"&timeStr&"</span>" else echo "<span style='font-size:10px'>"&timeStr&"</span>"
End Sub

Function getFromStr(playurl)
        if isNul(playurl) then getFromStr="" : Exit Function
        dim playurlArray,playurlLen,i,span1,span2,urlstr : span1="$$$" : span2="$$"
        playurlArray=split(playurl,span1) : playurlLen=ubound(playurlArray)
        for i=0 to playurlLen
                if i=playurlLen then urlstr=urlstr&split(playurlArray(i),span2)(0) else urlstr=urlstr&split(playurlArray(i),span2)(0)&","
        next
        getFromStr=urlstr
End Function

Function getPlayurlArray(playurl)
        dim span1 : span1="$$$"
        if isNul(playurl) then playurl=""
        getPlayurlArray=split(playurl,span1)
End Function

Function filterDirty(content)
        dim dirtyStr,dirtyStrArray,i : dirtyStr="%u80E1%u9526%u6D9B%2C%u6E29%u5BB6%u5B9D%2C%u5C3B%2C%u5C4C%2C%u64CD%u4F60%2C%u5E72%u6B7B%u4F60%2C%u8D31%u4EBA%2C%u72D7%u5A18%2C%u5A4A%u5B50%2C%u8868%u5B50%2C%u9760%u4F60%2C%u53C9%u4F60%2C%u53C9%u6B7B%2C%u63D2%u4F60%2C%u63D2%u6B7B%2C%u5E72%u4F60%2C%u5E72%u6B7B%2C%u65E5%u4F60%2C%u65E5%u6B7B%2C%u9E21%u5DF4%2C%u777E%u4E38%2C%u5305%u76AE%2C%u9F9F%u5934%2C%u5C44%2C%u8D51%2C%u59A3%2C%u808F%2C%u5976%u5B50%2C%u5976%u5934%2C%u9634%u6BDB%2C%u9634%u9053%2C%u9634%u830E%2C%u53EB%u5E8A%2C%u5F3A%u5978%2C%u7231%u6DB2%2C%u6027%u9AD8%u6F6E%2C%u505A%u7231%2C%u6027%u4EA4%2C%u53E3%u4EA4%2C%u809B%u4EA4"
        dirtyStrArray=split(unescape(dirtyStr),",")
        for i=0 to ubound(dirtyStrArray)
                content=replace(content,dirtyStrArray(i),"***",1,-1,1)
        next
        filterDirty=content
End Function

Sub writeFontWaterPrint(saveImgPath,location)
        dim jpegObj,strWidth,strHeight,picPath : strWidth=len(waterMarkFont)*5 : strHeight=3
        on error resume next
        set jpegObj=Server.CreateObject(JPEG_OBJ_NAME)
        picPath=Server.MapPath(saveImgPath)
        with jpegObj
                .Interpolation=2 : .Open picPath : .Canvas.Font.BkMode=true : .Canvas.Font.BkColor=&HFF3300 : .Canvas.Font.Color=&Hffffff : .Canvas.Font.Family="Tahoma" : .Canvas.Font.Size=14 : .Canvas.Font.Bold=true
                select case location
                        case "lefttop" : jpegObj.Canvas.Print 5 , strHeight, waterMarkFont
                        case "righttop" : jpegObj.Canvas.Print jpegObj.width-strWidth, strHeight, waterMarkFont
                        case "leftbottom" : jpegObj.Canvas.Print 5 , jpegObj.height-20, waterMarkFont
                        case "rightbottom" : jpegObj.Canvas.Print jpegObj.width-strWidth, jpegObj.height-20, waterMarkFont
                        case "middle" : jpegObj.Canvas.Print (jpegObj.width-strWidth)/2, (jpegObj.height-strHeight)/2, waterMarkFont
                end select
                .Canvas.Pen.Color=&Heeeeee : .Canvas.Pen.Width=1 : .Canvas.Brush.Solid=False : .Canvas.Bar 0, 0, jpegObj.Width, jpegObj.Height : .Save picPath
        end with
        set jpegObj=nothing : if err then err.clear
End Sub

Function regexFind(Byval str,Byval pattern)
        if isNul(str) then : regexFind="" : Exit Function
        dim regObj,match,matches,findStr : set regObj=New RegExp
        regObj.Pattern=pattern : set matches=regObj.Execute(str)
        for each match in matches
                regexFind=match.SubMatches(0)
                set regObj=nothing : set matches=nothing : Exit Function
        next
End Function

Function getTimeSpan(sessionName)
        dim lastTime : lastTime=session(sessionName)
        if isNul(lastTime) then lastTime=0
        getTimeSpan=DateDiff("s",lasttime,now())
End Function

7kbb

Sub setSession(sessionName,sessionValue)
        session(sessionName)=sessionValue
End Sub

Function showFace(m_content)
        dim templateobj : set templateobj=mainClassObj.createObject("MainClass.template")
        m_content=templateobj.regExpReplace(m_content,"\[ps\d{1,})?\]","<img src=""/"&sitePath&"pic/faces/$1.gif"" border=0/>")
        set templateobj=nothing
        showFace=m_content
End Function

Function isExistStr(str,findstr)
        if isNul(str) or isNul(findstr) then isExistStr=false:Exit Function
        if instr(str,findstr)>0 then isExistStr=true else isExistStr=false
End Function

Sub parseLabelHaveLen(Byval str,Byval label)   
        dim bLabel,eLabel,strBegin,strLen,regObj,match,matches,strByLen
        set regObj=New RegExp:regObj.ignoreCase=true:regObj.Global=true:regObj.Pattern="\{playpage:"&label&"\s+len=(\d+)?\s*\}"
        if regObj.Test(templateObj.content) then
                set matches=regObj.Execute(templateObj.content)
                for each match in matches
                        strLen=match.SubMatches(0)
                        if label="actor" then strByLen=getKeywordsList(left(str,strLen),"&nbsp;&nbsp;") else strByLen=left(str,strLen)
                        if label="des" then strByLen=filterStr(codeTextarea(strByLen,"en"),"html")
                        templateObj.content=replaceStr(templateObj.content,match.value,strByLen)
                next
                set matches =nothing:set regObj=nothing
        else
                exit sub
        end if
        set regObj=nothing
End Sub

Function getFirstLetter(str)
        dim temNum,char : char=left(replace(trim(str)," ",""),1)
        on error resume next
        temNum=65536+asc(char)
        if err then  getFirstLetter="":err.clear:exit function
        IF (temNum>=45217 and temNum<=45252) Then
                getFirstLetter= "A"
        ElseIF(temNum>=45253 and temNum<=45760) Then
                getFirstLetter= "B"
        ElseIF(temNum>=45761 and temNum<=46317) Then
                getFirstLetter= "C"
        ElseIF(temNum>=46318 and temNum<=46825) Then
                getFirstLetter= "D"
        ElseIF(temNum>=46826 and temNum<=47009) Then
                getFirstLetter= "E"
        ElseIF(temNum>=47010 and temNum<=47296) Then
                getFirstLetter= "F"
        ElseIF(temNum>=47297 and temNum<=47613) Then
                getFirstLetter= "G"
        ElseIF(temNum>=47614 and temNum<=48118) Then
                getFirstLetter= "H"
        ElseIF(temNum>=48119 and temNum<=49061) Then
                getFirstLetter= "J"
        ElseIF(temNum>=49062 and temNum<=49323) Then
                getFirstLetter= "K"
        ElseIF(temNum>=49324 and temNum<=49895) Then
                getFirstLetter= "L"
        ElseIF(temNum>=49896 and temNum<=50370) Then
                getFirstLetter= "M"
        ElseIF(temNum>=50371 and temNum<=50613) Then
                getFirstLetter= "N"
        ElseIF(temNum>=50614 and temNum<=50621) Then
                getFirstLetter= "O"
        ElseIF(temNum>=50622 and temNum<=50905) Then
                getFirstLetter= ""
        ElseIF(temNum>=50906 and temNum<=51386) Then
                getFirstLetter= "Q"
        ElseIF(temNum>=51387 and temNum<=51445) Then
                getFirstLetter= "R"
        ElseIF(temNum>=51446 and temNum<=52217) Then
                getFirstLetter= "S"
        ElseIF(temNum>=52218 and temNum<=52697) Then
                getFirstLetter= "T"
        ElseIF(temNum>=52698 and temNum<=52979) Then
                getFirstLetter= "W"
        ElseIF(temNum>=52980 and temNum<=53688) Then
                getFirstLetter= "X"
        ElseIF(temNum>=53689 and temNum<=54480) Then
                getFirstLetter= "Y"
        ElseIF(temNum>=54481 and temNum<=62289) Then
                getFirstLetter= "Z"
        ElseIF(temNum=-2354+65536) Then
                getFirstLetter= "X"
        Else
                getFirstLetter=UCase(char)
        End if
End Function

Function replacedirtyWords(str)
        dim i
        dim mystr : mystr=str
        dim warray : warray=split(dirtyWords,",")
        for i=0 to ubound(warray)
                mystr=replace(mystr,warray(i),"*")
        next
        replacedirtyWords=mystr
End Function

Function getletterlist
        dim i,mystr
        for i=65 to 90
                mystr=mystr&"<a href='/"&sitepath&"search.asp?searchtype=4&searchword="&chr(i)&"'  >"&chr(i)&"</a>"
        next
        getletterlist=mystr
End Function

Function writeRole
        writeRole=false
        createTextFile "","role.asp",""
        if objFso.FileExists(server.mappath("role.asp")) then writeRole=true : delFile "role.asp"
End Function

Function getNewsFolder(vdate)
        if  isnul(vdate) then vdate=now
        if isdate(vdate)=false then vdate=now
        if month(vdate)<10 then getNewsFolder=year(vdate)&"0"&month(vdate) else getNewsFolder=year(vdate)&month(vdate)
End Function

Function getSubStrByFromAndEnd(str,startStr,endStr,operType)
        dim location1,location2
        select case operType
                case "start"
                        location1=instr(str,startStr)+len(startStr):location2=len(str)+1
                case "end"
                        location1=1:location2=instr(location1,str,endStr)
                case else
                        location1=instr(str,startStr)+len(startStr):location2=instr(location1,str,endStr)
        end select
        getSubStrByFromAndEnd=mid(str,location1,location2-location1)
End Function

Function getPlayerIntroArray(str)
        dim xmlobj,vNodes,i,j,l,xmlFile,xmlNode,tmp
        ReDim temp(2,0)
        if str="play" then
                xmlFile="/"&sitePath&"inc/playerKinds.xml":xmlNode="playerkinds/player"
        else  
                xmlFile="/"&sitePath&"inc/downKinds.xml":xmlNode="downkinds/source"
        end if
        set xmlobj = mainClassobj.createObject("MainClass.Xml")
        xmlobj.load xmlFile,"xmlfile"
        set vNodes=xmlobj.getNodes(xmlNode):l=vNodes.length-1
        for i=0 to l
                ReDim Preserve temp(2,i)
                temp(0,i)=xmlobj.getAttributesByNode(vNodes(i),"flag")
                temp(1,i)=vNodes(i).childNodes(0).text&"__maxcc__"&xmlobj.getAttributesByNode(vNodes(i),"open")
                temp(2,i)=xmlobj.getAttributesByNode(vNodes(i),"sort")
                if isNumeric(temp(2,i)) then:temp(2,i)=Clng(temp(2,i)):else:temp(2,i)=0:end if
        next
        set vNodes=nothing:set xmlobj=nothing
        for i=0 to l
                for j=i+1 to l
                        if temp(2,i) < temp(2,j) then
                                tmp=temp(0,j):temp(0,j)=temp(0,i):temp(0,i)=tmp
                                tmp=temp(1,j):temp(1,j)=temp(1,i):temp(1,i)=tmp
                                tmp=temp(2,j):temp(2,j)=temp(2,i):temp(2,i)=tmp
                        end if
                next
        next
        getPlayerIntroArray=temp
End Function

Dim gPlayerIntroArray(1)
Function getPlayerIntroArrayOnCache(str)
        Dim i:if str="play" then:i=0:else:i=1:end if
        if not isArray(gPlayerIntroArray(i)) then
                dim cacheName,playerArray:cacheName="array_"&str&"list"
                if cacheStart=1 then
                        if cacheObj.chkCache(cacheName) then:gPlayerIntroArray(i)=cacheObj.getCache(cacheName):else:gPlayerIntroArray(i)=getPlayerIntroArray(str):cacheObj.setCache cacheName,gPlayerIntroArray(i)
                else
                        gPlayerIntroArray(i)=getPlayerIntroArray(str)
                end if
        end if
        getPlayerIntroArrayOnCache=gPlayerIntroArray(i)
End Function

Function getPlayerIntroOnCache(str,flag)
        dim playerArray:playerArray=getPlayerIntroArrayOnCache(str)
        getPlayerIntroOnCache=playerArray(1,getArrayElementID(playerArray,0,flag))
End Function

Function getRndPlayerurlSpan(rndType)
        dim rndNumber,rndNumber2,rndArray
        select case rndType
                case 1
                        randomize():rndNumber=clng(10000*rnd)
                        randomize():rndNumber2=clng(3*rnd)
                        select case rndNumber2
                                case 0
                                        getRndPlayerurlSpan=rndNumber&"'+'"&replaceStr(replaceStr(replaceStr(cacheFlag,"C",""),"_",""),"2009","")&"'+'"&rndNumber
                                case 1
                                        getRndPlayerurlSpan=rndNumber&"'+'"&replaceStr(replaceStr(replaceStr(cacheFlag,"C",""),"_",""),"2009","")&rndNumber
                                case 2
                                        getRndPlayerurlSpan=rndNumber&replaceStr(replaceStr(replaceStr(cacheFlag,"C",""),"_",""),"2009","")&"'+'"&rndNumber
                                case 3
                                        getRndPlayerurlSpan=rndNumber&replaceStr(replaceStr(replaceStr(cacheFlag,"C",""),"_",""),"2009","")&rndNumber
                        end select
                case 2
                        randomize():rndNumber=clng(3*rnd)
                        rndArray=Array("un"&"esc"&"ape('%2524')+u"&"nesca"&"pe('%25')+unes"&"cape('24')","un"&"esc"&"ape('%25')+u"&"nesca"&"pe('24%25')+unes"&"cape('24')","u"&"nesca"&"pe('%2524')+un"&"esc"&"ape('%2524')","unes"&"cape('%2524%2524')")
                        getRndPlayerurlSpan=rndArray(rndNumber)
        end select
End Function

Function getTextsegments()
        Dim l,ret,xmlobj,Nodes,Node:ret=array():SET xmlobj=mainClassobj.createObject("MainClass.Xml"):l=0
        xmlobj.load "/"&sitePath&"inc/textsegment.xml","xmlfile"
        SET Nodes=xmlobj.getNodes("root/item")
        for each Node in Nodes
                ReDim Preserve ret(l)
                ret(l)=Node.text:l=l+1
        next
        set xmlobj = nothing:getTextsegments=ret
End Function

Function getTextsegmentsOnCache()
        dim cacheName,ret:cacheName="array_textsegmentlist"
        if cacheStart=1 then
                if cacheObj.chkCache(cacheName) then ret=cacheObj.getCache(cacheName) else ret=getTextsegments():cacheObj.setCache cacheName,ret
        else
                ret=getTextsegments()
        end if
        getTextsegmentsOnCache=ret
End Function

Function doPseudo(ByVal des,ByVal iId)
        dim iType,ts,l,pos:iType=iId MOD 3:ts=getTextsegmentsOnCache():l=UBound(ts)+1
        if l=0 OR des="" then
                doPseudo=des
        elseif iType=1 then
                doPseudo=ts(iId MOD l)&des
        elseif iType=2 then
                doPseudo=des&ts(iId MOD l)
        else
                pos=inStr(des,"<br>")
                if pos=0 then pos=inStr(des,"<br/>")
                if pos=0 then pos=inStr(des,"<br />")
                if pos=0 then pos=inStr(des,vbcrlf)
                if pos=0 then pos=inStr(des,"。")+1
                if pos>0 then
                        doPseudo=Mid(des,1,pos-1)&ts(iId MOD l)&Mid(des,pos)
                else
                        doPseudo=ts(iId MOD l)&des
                end if
        end if
End Function

Function ResetFromSort(ByVal sData)
        if sData="" then ResetFromSort="":exit function
        on error resume next
        dim i,j,dd,dl,ff:dd=getPlayurlArray(sData):dl=UBound(dd)
        if dl>0 then
                dim ay:ay=getPlayerIntroArrayOnCache("play")
                dim ul,ret:ul=UBound(ay,2):ReDim li(ul):ret=""
                for i=0 to dl
                        ff=Split(dd(i),"$$"):j=getArrayElementID(ay,0,ff(0))
                        if ""&li(j)<>"" then
                                li(j)=li(j)&"$$$"&dd(i)
                        else
                                li(j)=dd(i)
                        end if
                next
                for i=0 to ul
                        if li(i)<>"" then
                                if ret<>"" then:ret=ret&"$$$"&li(i):else:ret=li(i):end if
                        end if
                next
                ResetFromSort=ret
        else
                ResetFromSort=sData
        end if
End Function

function getIsFromSort()
        getIsFromSort=0n error resume next:getIsFromSort=Cint(IsFromSort)
End Function
%>

add.c

   你修改下路径, 如二楼

flythink

怎么改 我也不会改啊

suchyip

godaddy you免费免费空间吗？