<%
sub writeA(str)
	response.write(str)
end sub

sub writeF(str)
	response.write(str)
	response.Flush()
end sub

sub writeE(str)
	response.write(str)
	response.end()
end sub

sub redirect(str)
	response.redirect str
end sub

function head
	head = "<html><head><meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8""></head><body>"
end function

sub alert(str)
	writeE head & "<sc" & "ript type=""text/javascript"">alert('" & jsEncode(str) & "\t\t');history.go(-1);</sc" & "ript>"
end sub

sub alertUrl(str,url)
	writeF head & "<sc" & "ript type=""text/javascript"">alert('" & jsEncode(str) & "\t\t');location.href='" & url & "';</sc" & "ript>"
end sub

sub confirmMsg(msg,url1,url2)
	writeE head & "<script>if(confirm('"&msg&"')){location.href='"&url1&"'}else{location.href='"&url2&"'}</script>"
end sub

Sub showMsg(msg, url)
    If url = "" Then url = "history.go(-1)" Else url = "location='" & url & "'"
    writeE "<style>body{text-align:center}</style><script>function JumpUrl(){" & url & ";}document.write(""<div style='background-color:white;border:1px solid #1C93E5;margin:0 auto;width:400px;text-align:left;'><div style='padding:3px 3px;color:white;font-weight:700;line-height:21px;height:25px;font-size:12px;border-bottom:1px solid #1C93E5; text-indent:3px; background-color:#1C93E5;text-align:center'>系统提示信息</div><div style='font-size:12px;padding:40px 8px 50px;line-height:25px;text-align:center'>" & msg & "稍后自动返回...</div></div>"");setTimeout('JumpUrl()',1500);</script>"
End Sub

Sub errMsg(e, d)
    writeE "<style>body{text-align:center}</style><div style='background-color:white;border:1px solid #1C93E5;margin:0 auto;width:400px;text-align:left;'><div style='padding:3px 3px;color:white;font-weight:700;line-height:21px;height:25px;font-size:12px;border-bottom:1px solid #1C93E5; text-indent:3px; background-color:#1C93E5;text-align:center'>【"& e &"】</div><div style='font-size:12px;padding:40px 8px 50px;line-height:25px;text-align:center'>" & d & "</div></div>"
End Sub

function initObj()
	on error resume next
	Response.charset = "UTF-8"
	'Response.Addheader "Content-Type","text/html; charset=utf-8"
	session.CodePage = 65001
	appTime = timer()
	curvodtypeid=-1:curvodtypepid=-1:curvodtopicid=-1
	curarttypeid=-1:curarttypepid=-1:curarttopicid=-1
	appid=-1 : curviewtype=1
	
	set objdb = New AppDataBase
	if app_dbtype = "mssql" then
		objdb.ConnStr = "Provider=Sqloledb;Data Source=" & app_dbserver & ";Initial Catalog=" & app_dbname & ";User ID=" & app_dbuser & ";Password=" & app_dbpass & ";"
	elseif app_dbtype = "access" then
		objdb.ConnStr = "Provider=Microsoft.Jet.OLEdb.4.0;Data Source=" & server.mappath(app_installdir & app_dbpath)
	end if
	set objFile = New AppFile
	set objTemplate = New AppTemplate
	set objBase64 = New AppBase64
	on error goto 0
end function

function dispseObj()
	on error resume next
	if isObject(objdb) then set objdb=nothing
	if isObject(objFile) then set objFile=nothing
	if isObject(objTemplate) then set objTemplate=nothing
	if isObject(objXml) then set objXml=nothing
	if isObject(objBase64) then set objBase64 =nothing
	if isObject(objXmlHttp) then set objXmlHttp=nothing
	if isObject(objCiku) then objCiku.RemoveAll : set objCiku=Nothing
	on error goto 0
end function

function chkArray(byval arr1,byval arr2)
	chkArray = True
	if IsArray(arr1) And IsArray(arr2) Then
		if Ubound(arr1)<>Ubound(arr2) Then
			chkArray = False
		end if
	else
		chkArray = False
	end if
end function

function isN(byval str)
	if isnull(str) or str="" then isN=true else isN=false
end function

function isNum(byval str)
	if not isN(str) then isNum=isnumeric(str) else isNum=false
end function

function indexOf(byval str,byval strfind)
	if isN(str) or isN(strfind) then indexOf=false:exit function
	if instr(","&str,strfind)>0 then indexOf=true else indexOf=false
end function

function isIp(byval ipadd)
	dim uflag,oReg
	isIp=false
	set oReg=new RegExp
	oReg.IgnoreCase=true
	oReg.global=true
	oReg.Pattern="(\d{1,4}\.\d{1,4}\.\d{1,4}\.\d{1,4})|(\d{1,4}\.\d{1,4}\.\d{1,4}\.\d{1,4}\/\d{1,2})"
	if oReg.test(ipadd) then isIp=true
	set oReg=nothing
end function

function isObjInstalled(byval objstr)
	dim xTestObj
	on error resume next
	isObjInstalled = False
	err = 0
	set xTestObj = Server.CreateObject(objstr)
	if err.number=0 then isObjInstalled = True
	set xTestObj = Nothing
	err = 0
end function

function getRndNum(byval length)
	 dim strNewPass,whatsnext, upper, lower, intCounter
	 randomize
	 for intCounter = 1 To length
	   upper = 57:lower = 48:strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + lower))
	 next
	 getRndNum = strNewPass
end function

function rndNum(byval MaxNum,byval MinNum)
	Randomize
	rndNum = int((MaxNum-MinNum+1)*rnd+MinNum)
end function

function getRndStr(length)
	dim allowStr, i
	allowStr = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
	for i = 1 to length
		randomize() : getRndStr = getRndStr & Mid(allowStr, Int(Len(allowStr) * Rnd + 1), 1)
	next
end function

function be(byval mode,byval key)
	select case Lcase(mode)
		case "get"
			be=Trim(Request.QueryString(Key))
		case "post"
			be=Trim(Request.Form(Key))
		case else
			be=Trim(Request(Key))
	end select
end function

function chkSql(byval str,byval flag)
	dim checkStr,arr,i,re
	checkStr="<|>|%|%27|'|''|;|*|and|exec|dbcc|alter|drop|insert|select|update|delete|count|master|truncate|char|declare|where|set|declare|mid|chr"
	if isN(str) then Exit Function
	arr=split(checkStr,"|")
	for i=lbound(arr) to ubound(arr)
		if instr(lcase(str),arr(i))<>0 then
			if flag=false then
				select case arr(i)
					case "<":re="&lt;"
					case ">":re="&gt;"
					case "'","""":re="&quot;"
					case ";":re="；"
					case else:re=""
				end select
				str=replace(str,arr(i),re,1,-1,1)
			else
				errmsg "系统提示","数据中包含非法字符":Exit Function
			end if
		end if
	next
	chkSql=str
end function

function getIP()
	dim x, y
	x = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	y = Request.ServerVariables("REMOTE_ADDR")
	if(isN(x) or lCase(x)="unknown") then getIP=y else getIP=x
	if instr(getIP,".")=0 then getIP = "0.0.0.0"
end function

function getReferer()
	getReferer= Request.ServerVariables("HTTP_REFERER")
end function

function getUrl()
  dim ScriptAddress,Servername,qs,portstr
  if Request.ServerVariables("SERVER_PORT")<>"80" then portstr=":"&Request.ServerVariables("SERVER_PORT")
  ScriptAddress = CStr(Request.ServerVariables("SCRIPT_NAME")) 
  Servername = CStr(Request.ServerVariables("Server_Name"))& portstr
  qs=Request.QueryString
  if qs<>"" then  getUrl ="http://"& Servername & ScriptAddress &"?"&qs  else  getUrl ="http://"& Servername & ScriptAddress
end function

sub setCookie(byval cooName,byval cooValue)
	response.cookies(cooName) = cooValue
end sub

function getCookie(byval cooName)
	getCookie = request.cookies(cooName)
end function

function getTimeSpan(byval sessionName)
	dim lastTime : lastTime=session(sessionName)
	if isN(lastTime) then lastTime=0
	getTimeSpan=DateDiff("s",lasttime,now())
end function

function getRunTime()
	getRunTime  = "页面执行时间: "&FormatNumber((timer()-appTime), 8, -1)&"秒 &nbsp;" & objdb.iqueryCount & "次数据查询"
end function

function repSpecialChar(byval str)
	if isN(str) then str=""
	str = replace(str,"/","_")
	str = replace(str,"\","_")
	str = replace(str,"[","")
	str = replace(str,"]","")
	str = replace(str," ","")
	repSpecialChar = str
end function

function getText(Byval Num,Byval SName)
	if isNum(Num) Then
		if not isN(SName) Then
			getText=Left(SName,Num)
		else
			getText=""
		end if
	else
		getText=SName
	end if
end function

function getDate(byval iformat,byval iTime)
	if isN(iformat) then iformat = "yyyy-mm-dd hh:ii:ss"
	if not IsDate(iTime) then getDate = "Date Error" : exit function
	if Instr(",0,1,2,3,4,",","&iformat&",")>0 then getDate = FormatDateTime(iTime,iformat) : exit function
	dim diffs,diffd,diffw,diffm,diffy,dire,before,pastTime
	dim iYear, iMonth, iDay, iHour, iMinute, iSecond,iWeek,tWeek
	dim iiYear, iiMonth, iiDay, iiHour, iiMinute, iiSecond,iiWeek
	dim iiiWeek, iiiMonth, iiiiMonth
	dim SpecialText, SpecialTextRe,i,t
	iYear = right(Year(iTime),2) : iMonth = Month(iTime) : iDay = Day(iTime)
	iHour = Hour(iTime) : iMinute = Minute(iTime) : iSecond = Second(iTime)
	iiYear = Year(iTime) : iiMonth = right("0"&Month(iTime),2)
	iiDay = right("0"&Day(iTime),2) : iiHour = right("0"&Hour(iTime),2)
	iiMinute = right("0"&Minute(iTime),2) : iiSecond = right("0"&Second(iTime),2)
	tWeek = Weekday(iTime)-1 : iWeek = Array("日","一","二","三","四","五","六")
	iiWeek = Array("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
	iiiWeek = Array("Sun","Mon","Tue","Wed","Thu","Fri","Sat")
	iiiMonth = Array("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")
	iiiiMonth = Array("January","February","March","April","May","June","July","August","September","October","November","December")
	SpecialText = Array("y","m","d","h","i","s","w")
	SpecialTextRe = Array(Chr(0),Chr(1),Chr(2),Chr(3),Chr(4),Chr(5),Chr(6))
	for i = 0 To 6 : iformat = Replace(iformat,"\"&SpecialText(i), SpecialTextRe(i)) : next
	t = Replace(iformat,"yyyy", iiYear) : t = Replace(t, "yyy", iiYear)
	t = Replace(t, "yy", iYear) : t = Replace(t, "y", iiYear)
	t = Replace(t, "mmmm", iiiiMonth(iMonth-1)) : t = Replace(t, "mmm", iiiMonth(iMonth-1))
	t = Replace(t, "mm", iiMonth) : t = Replace(t, "m", iMonth)
	t = Replace(t, "dd", iiDay) : t = Replace(t, "d", iDay)
	t = Replace(t, "hh", iiHour) : t = Replace(t, "h", iHour)
	t = Replace(t, "ii", iiMinute) : t = Replace(t, "i", iMinute)
	t = Replace(t, "ss", iiSecond) : t = Replace(t, "s", iSecond)
	t = Replace(t, "www", iiiWeek(tWeek)) : t = Replace(t, "ww", iiWeek(tWeek))
	t = Replace(t, "w", iWeek(tWeek))
	for i = 0 To 6 : t = Replace(t, SpecialTextRe(i),SpecialText(i)) : next
	getDate = t
end function

function replaceStr(byval str1,byval str2,byval str3)
	if isNull(str1) then replaceStr ="" :exit function
	if isNull(str3) then str3=""
	replaceStr = Replace(str1,str2,str3)
end function

function regReplace(byval str,byval rule,byval Result)
	dim tmpStr,Reg : tmpStr = str
	if not isNull(tmpStr) then
		set Reg = New Regexp
		Reg.Global = True
		Reg.Ignorecase = True
		Reg.Pattern = rule
		tmpStr = Reg.Replace(tmpStr,Result)
		set Reg = nothing
	end if
	regReplace = tmpStr
end function

function regMatch(byval Str,byval rule)
	dim Reg,match,matches
	set Reg = New Regexp
	Reg.Global = True
	Reg.Ignorecase = True
	Reg.Pattern = rule
	set matches = Reg.Execute(Str)
	set Reg = Nothing
	for each match in matches
		regMatch= match.SubMatches(0)
		exit function
	next
end function

function escape(byval str)
	dim i,c,a,s : s = ""
	if isN(str) then escape = "" : exit function
	for i = 1 To Len(str)
		c = Mid(str,i,1)
		a = ASCW(c)
		if (a>=48 and a<=57) or (a>=65 and a<=90) or (a>=97 and a<=122) then
			s = s & c
		elseif InStr("@*_+-./",c)>0 then
			s = s & c
		elseif a>0 and a<16 then
			s = s & "%0" & Hex(a)
		elseif a>=16 and a<256 then
			s = s & "%" & Hex(a)
		else
			s = s & "%u" & Hex(a)
		end if
	next
	escape = s
end function

Function UrlDecode(ByVal str)
    Dim B,ub
    Dim UtfB
    Dim UtfB1, UtfB2, UtfB3
    Dim i, n, s
    n=0
    ub=0
    For i = 1 To Len(str)
        B=Mid(str, i, 1)
        Select Case B
            Case "+"
                s=s & " "
            Case "%"
                ub=Mid(str, i + 1, 2)
                UtfB = CInt("&H" & ub)
                If UtfB<128 Then 
                    i=i+2
                    s=s & ChrW(UtfB)
                Else 
                    UtfB1=(UtfB And &H0F) * &H1000
                    UtfB2=(CInt("&H" & Mid(str, i + 4, 2)) And &H3F) * &H40
                    UtfB3=CInt("&H" & Mid(str, i + 7, 2)) And &H3F
                    s=s & ChrW(UtfB1 Or UtfB2 Or UtfB3)
                    i=i+8
                End If 
            Case Else
                s=s & B
        End Select 
    Next
    UrlDecode = s
End Function


function htmlEncode(byval str)
	if not isN(str) then
		str = replace(str, Chr(38), "&#38;")
		str = replace(str, ">", "&gt;")
		str = replace(str, "<", "&lt;")
		str = replace(str, Chr(39), "&#39;")
		str = replace(str, Chr(32), "&nbsp;")
		str = replace(str, Chr(34), "&quot;")
		str = replace(str, Chr(9), "&nbsp;&nbsp;&nbsp;&nbsp;")
		str = replace(str, Chr(13), "")
		str = replace(str, Chr(10), "<br />")
	end if
	htmlEncode = str
end function

function htmlDecode(byval str)
	if not IsN(str) then
		str = replace(str, "<br/>", Chr(13)&Chr(10))
		str = replace(str, "<br>", Chr(13)&Chr(10))
		str = replace(str, "<br />", Chr(13)&Chr(10))
		str = replace(str, "&nbsp;&nbsp;&nbsp;&nbsp;", Chr(9))
		str = replace(str, "&amp;", Chr(38))
		str = replace(str, "&#39;", Chr(39))
		str = replace(str, "&apos;", Chr(39))
		str = replace(str, "&nbsp;", Chr(32))
		str = replace(str, "&quot;", Chr(34))
		str = replace(str, "&gt;", ">")
		str = replace(str, "&lt;", "<")
		str = replace(str, "&#38;", Chr(38))
		htmlDecode = str
	end if
end function

function htmlFilter(byval str)
	if not isN(str) then
		str = regReplace(str,"<[^>]+>|</[^>]+>","")
		str = Replace(str, ">", "&gt;")
		str = Replace(str, "<", "&lt;")
		htmlFilter = str
	end if
end function

function htmltojs(byval content)
	dim arrLines,i,strNew,sLine
	arrLines = Split(content, Chr(10))
	if IsArray(arrLines) then
	    for i=0 To UBound( arrLines )
			sLine = replaceStr( arrLines(i) , "\" , "\\")
			sLine = replaceStr( sLine , "/" , "\/")
			sLine = replaceStr( sLine , "'" , "\'")
			sLine = replaceStr( sLine , """" , "\""")
		    sLine = replaceStr( sLine , Chr(13) , "" )
		    strNew = strNew & "document.writeln('" & sLine  & "');" & Chr(10)
	   next
	end if
	htmltojs=strNew
end function

function jstohtml(byval str)
	if not isN(str) then
		str = replace( str , "document.writeln('" , "")
		str = replace( str , "\'" , "'")
		str = replace( str , "\""" , """")
		str = replace( str , "\\" , "\")
		str = replace( str , "\/" , "/")
		str = replace( str , "');" , "")
	end if
    jstohtml=str
end function

function jsEncode(byval str)
	if not isN(str) then
		str = replace(str,Chr(92),"\\")
		str = replace(str,Chr(34),"\""")
		str = replace(str,Chr(39),"\'")
		str = replace(str,Chr(9),"\t")
		str = replace(str,Chr(13),"\r")
		str = replace(str,Chr(10),"\n")
		str = replace(str,Chr(12),"\f")
		str = replace(str,Chr(8),"\b")
	end if
	jsEncode = str
end function

function badFilter(byval str)
	dim filters ,badKeywordArr,s_i
	filters = app_filter
	badKeywordArr=split(filters,",")
	for s_i=0 to ubound(badKeywordArr)	
		str=replaceStr(str,badKeywordArr(s_i),"***") 
	next
	badFilter=str
end function

function bytesToBstr(byval Body,byval CharSet)
	on error resume next
	dim stream
	set stream = Server.CreateObject("adodb.stream")
	stream.Type = 1
	stream.Mode =3
	stream.Open
	stream.Write body
	stream.Position = 0
	stream.Type = 2
	stream.Charset = CharSet
	bytesToBstr = stream.ReadText
	stream.Close
	set stream = nothing
	if err then bytesToBstr="": err.clear
end function  

function getBody(byval strBody,byval strStart,byval strEnd)
	   if strBody=False or isN(strBody) or isN(strStart) or isN(strEnd) then  getBody=False:  exit function
	   dim strTemp,Start,Over
	   strTemp=Lcase(strBody)
	   strStart=Lcase(strStart)
	   strEnd=Lcase(strEnd)
	   on error resume next
	   Start = InStrB(1, strTemp, strStart, vbBinaryCompare)
	   if Start<=0 then  getBody=false: exit function else Start=Start+LenB(strStart)
	   Over = InStrB(Start,strTemp,strEnd,vbBinaryCompare)
	   getBody = MidB(strBody,Start,Over-Start)
   	   if err then getBody=False : err.clear
end function

function getArray(byval strBody,byval strStart,byval strEnd)
	if strBody=False Or isN(strBody) or isN(strStart) Or isN(strEnd) then getArray=False:exit function
	dim TempStr,TempStr2,objRegExp,Matches,Match,strPattern
	TempStr=""
	strStart = replaceStr(strStart,"(","\(")
	strStart = replaceStr(strStart,")","\)")
	strStart = replaceStr(strStart,"'","\'")
	strStart = replaceStr(strStart,"?","\?")
	strStart = replaceStr(strStart,"+","\+")
	strEnd = replaceStr(strEnd,"(","\(")
	strEnd = replaceStr(strEnd,")","\)")
	strEnd = replaceStr(strEnd,"'","\'")
	strEnd = replaceStr(strEnd,"?","\?")
	strEnd = replaceStr(strEnd,"+","\+")
	strPattern = "("&strStart&")([\s\S]*?)("&strEnd&")"
	
	set objRegExp = New Regexp 
	objRegExp.Ignorecase = True 
	objRegExp.Global = True
	objRegExp.Pattern = strPattern
	on error resume next
	set Matches =objRegExp.Execute(strBody)
	for each Match in Matches
		if instr(","&TempStr,Match.Value) =0 then TempStr=TempStr & "$Array$" & Match.Value
	next
	set Matches=nothing
	if TempStr="" then	getArray=False : set objRegExp=nothing :exit function
	
	TempStr=Right(TempStr,Len(TempStr)-7)
	objRegExp.Pattern =strStart
	TempStr=objRegExp.Replace(TempStr,"")
	objRegExp.Pattern =strEnd
	TempStr=objRegExp.Replace(TempStr,"")
	set objRegExp=nothing
	TempStr=replaceStr(TempStr,"""","")
	TempStr=replaceStr(TempStr,"'","")
	TempStr=replaceStr(TempStr," ","")
	if TempStr="" then	getArray=False	else	getArray=TempStr
	if err then getArray=false:err.clear
end function

dim span : span=""
function makeSelect(byval tabName,byval colID,byval colName,byval colSort,byval Byurl,byval separateStr,byval id)
	dim sql,rs,strSelected,strTemp,strValue,strOrder,arr,arr1,i
	if not isN(colSort) then strOrder =   " order by "&colSort&" Asc"
	if isN(id) then id =0
	
	select case tabName
		case "{pre}user_group": arr = cacheusergroup
		case "{pre}art_topic": arr = cachearttopic
		case "{pre}vod_topic": arr = cachevodtopic
	end select
	
	for i=0 to ubound( arr )
		arr1 = arr(i)
		if clng(id) = arr1(0) then strSelected=" selected" else strSelected=""
		if isN(ByUrl) then strValue=arr1(0) else strValue = ByUrl & "?" & tabName & "=" & arr1(0)
		strTemp = strTemp &   "<option value='"&strValue&"' "&strSelected&">&nbsp;|—"&arr1(1)&"</option>"
	next
	
	'sql = "select "&colID&","&colName&" from "& tabName &strOrder
	'set rs = objdb.DB(sql,"rs1")
	'do while not rs.eof
	'	if clng(id) = rs(colID) then strSelected=" selected" else strSelected=""
	'	if isN(ByUrl) then strValue=rs(colID) else strValue = ByUrl & "?" & tabName & "=" & rs(colID)
	'	strTemp = strTemp &   "<option value='"&strValue&"' "&strSelected&">"&span&"&nbsp;|—"&rs(colName)&"</option>"
	'	rs.movenext
	'loop
	'if not isN(span) then span = left(span,len(span)-len(separateStr))
	'objdb.C(rs)
	makeSelect = strTemp
end function

function makeSelectAll(byval tabName,byval colID,byval colName,byval colPID,byval colSort,byval pid,byval ByUrl,byval separateStr,byval id)
	dim sql,rs,strSelected,strTemp,strValue,arr,arr1,arr2,i,j
	if isN(id) then id =0
	
	select case tabName
		case "{pre}art_type": arr = cachearttype
		case "{pre}vod_type": arr = cachevodtype
	end select
	
	for i=0 to ubound( arr )
		arr1 = arr(i)
		if arr1(4) = 0 then
			if clng(id)=arr1(0) then strSelected=" selected" else strSelected=""
			if isN(ByUrl) then strValue=arr1(0) else strValue = ByUrl & "?" & tabName & "=" & arr1(0)
			strTemp = strTemp &   "<option value='"&strValue&"' "&strSelected&">&nbsp;|—"&arr1(1)&"</option>"
			
			for j=0 to ubound(arr)
				arr2 = arr(j)
				if arr2(4) = arr1(0) then
					
					if clng(id)=arr2(0) then strSelected=" selected" else strSelected=""
					if isN(ByUrl) then strValue=arr2(0) else strValue = ByUrl & "?" & tabName & "=" & arr2(0)
					strTemp = strTemp &   "<option value='"&strValue&"' "&strSelected&">&nbsp;|&nbsp;&nbsp;&nbsp;|—"&arr2(1)&"</option>"
				end if
			next
			
		end if
	next
	set arr2=nothing
	set arr1=nothing
	set arr=nothing
	'sql = "select "&colID&","&colName&" from "& tabName &" where "&colPID &" = "& pid &" order by "& colSort &" Asc"
	'set rs = objdb.DB(sql,"rs1")
	'do while not rs.eof 
	'	if pid <> 0 then span = span&separateStr
	'	if clng(id)=rs(colID) then strSelected=" selected" else strSelected=""
	'	if isN(ByUrl) then strValue=rs(colID) else strValue = ByUrl & "?" & tabName & "=" & rs(colID)
	'	strTemp = strTemp &   "<option value='"&strValue&"' "&strSelected&">"&span&"&nbsp;|—"&rs(colName)&"</option>"
	'	strTemp = strTemp & makeSelectAll (tabName,colID,colName,colPID,colSort,rs(colID),ByUrl,separateStr,id)
	'	rs.movenext
	'loop
	'if not isN(span) then span = left(span,len(span)-len(separateStr))
	'objdb.C(rs)
	makeSelectAll = strTemp
end function

function makeSelectPlayer(byval strfrom)
	dim strTemp,playArr,strSelected,from,show,i,status
	playArr = getVodXml("vodplay.xml","players/player")
    For i = 0 To UBound(playArr,2)
		if strfrom = playArr(0,i) then strSelected=" selected" else strSelected=""
		strTemp = strTemp& "<option value='"&playArr(0,i)&"' "&strSelected&">"&playArr(1,i)&"</option>" 
	Next
	makeSelectPlayer=strTemp
end function

function makeSelectDown(byval strfrom)
	dim strTemp,downArr,strSelected,from,show,i,status
	downArr = getVodXml("voddown.xml","downs/down")
    For i = 0 To UBound(downArr,2)
		if strfrom = downArr(0,i) then strSelected=" selected" else strSelected=""
		strTemp = strTemp& "<option value='"&downArr(0,i)&"' "&strSelected&">"&downArr(1,i)&"</option>"
	Next
	makeSelectDown=strTemp
end function

function makeSelectServer(byval strserver)
	dim strTemp,serverArr,strSelected,from,show,i,status
	serverArr = getVodXml("vodserver.xml","servers/server")
    For i = 0 To UBound(serverArr,2)
		if strserver = serverArr(0,i) then strSelected=" selected" else strSelected=""
		strTemp = strTemp& "<option value='"&serverArr(0,i)&"' "&strSelected&">"&serverArr(1,i)&"</option>"
	Next
	makeSelectServer=strTemp
end function

function makeSelectAreaLang(byval flag,byval val)
	dim str,i,strSelected,strTemp,file,j,arr,arr1
	j=0
	select case flag
		case "area": arr = cachearea
		case "lang": arr = cachelang
	end select
	for i=0 to ubound( arr )
		arr1 = arr(i)
		if val = arr1(1) then j=j+1 : strSelected=" selected" else strSelected=""
		strTemp = strTemp & "<option value='"&arr1(1)&"' "&strSelected&">"&arr1(1)&"</option>"
	next
	'str = objFile.getFile(app_installdir & "inc/vod"&flag&".txt")
	'str = replace(str,chr(10),"")
	'arr = split(str, chr(13))
	
	'for i=0 to UBound(arr)
	'	if not isN(arr(i)) then
	'		if val = arr(i) then j=j+1 : strSelected=" selected" else strSelected=""
	'		strTemp = strTemp & "<option value='"&arr(i)&"' "&strSelected&">"&arr(i)&"</option>"
	'	end if
	'next
	if val <>"" and j=0 then
		strTemp = strTemp & "<option value='"&val&"' selected>"&val&"</option>"
	end if
	makeSelectAreaLang = strTemp
end function

function pagelist_manage(byval pagecount, byval page, byval recordcount, byval pagesize, byval url)
    recordcount = int(recordcount): pagesize = int(pagesize)
    pagecount = int(pagecount): page = int(page)
    if recordcount = 0 then pagelist_manage="" :exit function
    
    dim tempstr: tempstr = "{<<} {循环} {>>} {跳转} 共{总条数}数据&nbsp;每页{每页数量}条&nbsp; 页次:{当前页}/{总页数}"
    dim jumpurl, i, j, loopurl, m,clickstr
    tempstr = replace(tempstr, "{总页数}", pagecount)
    tempstr = replace(tempstr, "{总条数}", recordcount)
	tempstr = replace(tempstr, "{当前页}", page)
	tempstr = replace(tempstr, "{每页数量}", pagesize)
    tempstr = replace(tempstr, "{<<}", "<a href=" & replace(url, "{p}", 1) & " class='page'>首页</a>")
    tempstr = replace(tempstr, "{>>}", "<a href=" & replace(url, "{p}", pagecount) & " class='page'>尾页</a>")
    if page > 1 then tempstr = replace(tempstr, "{<}", "<a href=" & replace(url, "{p}", page - 1) & " class='page'><</a>") else tempstr = replace(tempstr, "{<}", "<span class='page'><</span>")
    if page < pagecount then tempstr = replace(tempstr, "{>}", "<a href=" & replace(url, "{p}", page + 1) & " class='page'>></a>") else tempstr = replace(tempstr, "{>}", "<span class='page'>></span>")
    if instr(url,"onclick")>0 then
    	clickstr = getBody(url,"onclick=""",";")
    	clickstr = replace(clickstr, "{p}", "document.getElementById('page').value") 
    else
    	clickstr = "location.href='" & replace(url, "{p}", "' + document.getElementById('page').value + '") & "'"
    end if
    jumpurl = "<input name=""page"" type=""text"" id=""page"" size=3  style='font-size:10px;color:#666;'><input name=""go"" type=""button"" id=""go"" value=""GO"" style='font-size:10px;color:#666;' onclick=""var intstr=/^\d+$/;if(intstr.test(document.getElementById('page').value)&&document.getElementById('page').value<=" & pagecount & "&&document.getElementById('page').value>=1){"&clickstr&";}"">"
    
    tempstr = replace(tempstr, "{跳转}", jumpurl)
    i = page - 4: j = page + 5
    if i < 1 then j = j + (1 - i): i = 1
    if j > pagecount then
        i = i + (pagecount - j): j = pagecount
        if i < 1 then i = 1
    end if
    for m = i to j
        if m = page then loopurl = loopurl & " <span class='pagein'>" & m & "</span>" else loopurl = loopurl & " <a href=" & replace(url, "{p}", m) & " class='page'>" & m & "</a>"
    next
    tempstr = replace(tempstr, "{循环}", loopurl)
    pagelist_manage = tempstr
end function

function getColorText(byval txt,byval color,byval lens)
	if isN(txt) then getColorText="" : exit function
	if lens>0 then txt = left(txt,lens)
	if not isN(color) then txt="<font color="&color&">"& txt & "</font>"
	getColorText=txt
end function

function getColorDay(byval strTime)
	if isN(strTime) then getColorDay =  "" : exit function
	dim strNow,strColor
	strNow = date
	if instr(strTime,strNow)>0 then strColor = "color=""#FF0000"""
	getColorDay =  "<font "&strColor&">"&strTime&"</font>"
end function

function getXmlHttpVer()
	dim i,arr
	arr = Array("Microsoft.XMLHTTP", "MSXML2.XMLHTTP", "MSXML2.XMLHTTP.3.0","MSXML2.XMLHTTP.4.0","MSXML2.XMLHTTP.5.0")
	getXmlHttpVer = false
	on error resume next
	for i=0 to ubound(arr)
		if isObjInstalled(arr(i)) then
			getXmlHttpVer = arr(i)
			exit for
		end if
	next
	if err.number=0 then err.clear
end function

function getXmlHttp()
	dim i,arr
	arr = Array("Microsoft.XMLHTTP", "MSXML2.XMLHTTP", "MSXML2.XMLHTTP.3.0","MSXML2.XMLHTTP.4.0","MSXML2.XMLHTTP.5.0")
	getXmlHttp = false
	on error resume next
	for i=0 to ubound(arr)
		set getXmlHttp=Server.CreateObject(arr(i))
		if err.number=0 then : getXmlHttp.setTimeouts 10000,10000,15000,15000 : err.clear:exit function : else err.clear :end if
	next
end function
	
function getPage(url,charSet)
	if not isObject(objXmlHttp) then:set objXmlHttp=getXmlHttp():end if
	on error resume next
	objXmlHttp.open "GET",url,False
	objXmlHttp.send()
	if Err then  GetPage=false:Err.Clear:exit function
	getPage = bytesToBstr(objXmlHttp.responseBody,charSet)
end function
	
function getImg(url)
	if not isObject(objXmlHttp) then:set objXmlHttp=getXmlHttp():end if
	on error resume next
	objXmlHttp.open "GET",url,False
	objXmlHttp.send()
	if Err then  GetPage=false:Err.Clear:exit function
	getImg = objXmlHttp.responseBody
end function

sub clsCache()
	Application.Lock()
	Application.Contents.RemoveAll()
	Application.UnLock()
end sub
	
sub delCache(cName)
	Application.Lock
	Application.Contents.Remove(app_cacheid & cName)
	Application.UnLock
end sub
 	
function setCache(cName,cValue)
	if app_cache =0 then exit function
	dim cacheValue : cacheValue = application(app_cacheid & cName)
	if isarray(cacheValue) then
		cacheValue(0) = cValue
		cacheValue(1) = now()
	else
		Redim cacheValue(2)
		cacheValue(0) = cValue
		cacheValue(1) = now()
	end if
	application.lock
	application("cache") = now()
	application(app_cacheid & cName) = cacheValue
	application.unlock
end function
	
function getCache(cName)
	dim cacheValue : cacheValue = application(app_cacheid & cName)
	if isarray(cacheValue) then getCache = cacheValue(0) else getCache = ""
end function
	
function chkCache(cName)
	chkCache = false
	if app_cache =0 then exit function
	dim cacheValue : cacheValue = application(app_cacheid & cName)
	if not isarray(cacheValue) then exit function
	if not IsDate(cacheValue(1)) then exit function
	if DateDiff("s", CDate(cacheValue(1)), now()) < 60*app_cachetime then chkCache = true
	application("cache") = CDate(cacheValue(1))
end function

Function getVodXml(byval name,byval path)
    Dim i,j,n, xmldom, nodes, nodeLen, playarr,tmp,status
        If chkCache(name) Then
            playarr = getCache(name)
        Else
            Set xmldom = New AppXMLDOM
            xmldom.OpenXml app_installdir & "inc/"&name
            Set nodes = xmldom.FindNodes(path)
            nodeLen = nodes.length
            
            n=0
            ReDim playarr(4,0)
            For i = 0 To nodeLen - 1
            	status = xmldom.GetAttr(path, "status", i)
            	if not isNum(status) then status=1 else status=cint(status)
            	if status = 1 then
	            	ReDim Preserve playarr(4,n)
	            	playarr(0,n) = xmldom.GetAttr(path, "from", i)
	            	playarr(1,n) = xmldom.GetAttr(path, "show", i)
	            	playarr(2,n) = xmldom.GetAttr(path, "des", i)
	            	playarr(3,n) = xmldom.GetAttr(path, "sort", i)
	            	playarr(4,n) = nodes(i).childNodes(0).Text
	            	if isNum(playarr(3,n)) then playarr(3,n)=clng(playarr(3,n)) else playarr(3,n)=1
	            	n=n+1
            	end if
            Next
            Set nodes = Nothing
            Set xmldom = Nothing
            
            nodeLen = ubound(playarr,2)
            for i=0 to nodeLen
				for j=i+1 to nodeLen
					if playarr(3,i) < playarr(3,j) then
						tmp=playarr(0,j):playarr(0,j)=playarr(0,i):playarr(0,i)=tmp
						tmp=playarr(1,j):playarr(1,j)=playarr(1,i):playarr(1,i)=tmp
						tmp=playarr(2,j):playarr(2,j)=playarr(2,i):playarr(2,i)=tmp
						tmp=playarr(3,j):playarr(3,j)=playarr(3,i):playarr(3,i)=tmp
						tmp=playarr(4,j):playarr(4,j)=playarr(4,i):playarr(4,i)=tmp
					end if
				next
			next
            setCache name, playarr
        End If
        
        getVodXml = playarr
End Function

Function getVodXmlText(byval name,byval path,byval from, byval k)
        Dim i, j,str, playArr,fromArr,rc
        rc=false
        if isN(from) then from=""
        fromArr = split(from,"$$$")
        playArr = getVodXml(name,path)
        For i = 0 To UBound(playArr,2)
            for j=0 to ubound(fromArr)
	            If fromArr(j) = playArr(0,i) Then
	            	if rc then str = str &","
	                str = str & playArr(k,i)
	                rc=true
	            End If
            next
        Next
        getVodXmlText = str
End Function

function updateCacheFile()
	dim str,strtemp,strvodtype,strarttype,strserver,strvodtopic,strarttopic,strarea,strlang,strusergroup,strplay,strchild,rs,rs1,rc,rc1,arr,i
	
	str = "<" & "%" & vbcrlf
	'视频分类缓存
	strvodtype = "cachevodtype=array("
	rc=false : rc1 = false
	set rs = objdb.DB("SELECT * FROM {pre}vod_type","rs1")
	do while not rs.eof
		if rc then strvodtype= strvodtype & ","
		strchild=""
		rc1=false
		set rs1 = objdb.DB("SELECT t_id FROM {pre}vod_type WHERE t_pid=" & rs("t_id"),"rs1")
		do while not rs1.eof
			if rc1 then strchild= strchild & ","
			strchild = strchild & rs1("t_id")
			rs1.movenext
			rc1 = true
		loop
		objdb.c(rs1)
		if isN(strchild) then strchild = rs("t_id") else strchild = rs("t_id") & "," & strchild
		strvodtype = strvodtype & "array(" &rs("t_id")& ","""&rs("t_name")&""",""" & rs("t_enname") & """," & rs("t_sort") & "," & rs("t_pid") & ",""" & rs("t_key") & """,""" & rs("t_des") & """,""" & rs("t_template") & """,""" & rs("t_vodtemplate") & """,""" & rs("t_playtemplate") &  """,""" & rs("t_downtemplate") & """," & rs("t_hide") & ","""& strchild &""")"
		rs.movenext
		rc=true
	loop
	strvodtype = strvodtype & ")"& vbcrlf
	objdb.c(rs)
	on error resume next
	Execute strvodtype
	if err then err.clear : writeA "更新视频分类缓存失败，请检查数据是否合法，是否包含引号、单引号、百分号、尖括号等特殊字符" :exit function
	
	'文章分类缓存
	strarttype = "cachearttype=array("
	rc=false : rc1 = false
	set rs = objdb.DB("SELECT * FROM {pre}art_type","rs1")
	do while not rs.eof
		if rc then strarttype= strarttype & ","
		strchild=""
		rc1=false
		set rs1 = objdb.DB("SELECT t_id FROM {pre}art_type WHERE t_pid=" & rs("t_id"),"rs1")
		do while not rs1.eof
			if rc1 then strchild= strchild & ","
			strchild = strchild & rs1("t_id")
			rs1.movenext
			rc1 = true
		loop
		objdb.c(rs1)
		if isN(strchild) then strchild = rs("t_id") else strchild = rs("t_id") & "," & strchild
		strarttype = strarttype & "array(" &rs("t_id")& ","""&rs("t_name")&""",""" & rs("t_enname") & """," & rs("t_sort") & "," & rs("t_pid") & ",""" & rs("t_key") & """,""" & rs("t_des") & """,""" & rs("t_template") & """,""" & rs("t_arttemplate") & """," & rs("t_hide") & ","""& strchild &""")"
		rs.movenext
		rc=true
	loop
	strarttype = strarttype & ")" & vbcrlf
	objdb.c(rs)
	on error resume next
	Execute strvodtype
	if err then err.clear : writeA "更新文章分类缓存失败，请检查数据是否合法，是否包含引号、单引号、百分号、尖括号等特殊字符":exit function
	
	
	'视频专题缓存
	strvodtopic = "cachevodtopic=array("
	rc=false : rc1 = false
	set rs = objdb.DB("SELECT * FROM {pre}vod_topic","rs1")
	do while not rs.eof
		if rc then strvodtopic= strvodtopic & ","
		strvodtopic = strvodtopic & "array(" &rs("t_id")& ","""&rs("t_name")&""",""" & rs("t_enname") & """," & rs("t_sort") & ",""" & rs("t_template") & """,""" & rs("t_pic") & """,""" & rs("t_des") & """)"
		rs.movenext
		rc=true
	loop
	strvodtopic = strvodtopic & ")" & vbcrlf
	objdb.c(rs)
	Execute strvodtopic
	if err then err.clear : writeA "更新视频专题缓存失败，请检查数据是否合法，是否包含引号、单引号、百分号、尖括号等特殊字符":exit function
	
	'文章专题缓存
	strarttopic = "cachearttopic=array("
	rc=false : rc1 = false
	set rs = objdb.DB("SELECT * FROM {pre}art_topic","rs1")
	do while not rs.eof
		if rc then strarttopic= strarttopic & ","
		strarttopic = strarttopic & "array(" &rs("t_id")& ","""&rs("t_name")&""",""" & rs("t_enname") & """," & rs("t_sort") & ",""" & rs("t_template") & """,""" & rs("t_pic") & """,""" & rs("t_des") & """)"
		rs.movenext
		rc=true
	loop
	strarttopic = strarttopic & ")" & vbcrlf
	objdb.c(rs)
	Execute strarttopic
	if err then err.clear : writeA "更新文章专题缓存失败，请检查数据是否合法，是否包含引号、单引号、百分号、尖括号等特殊字符":exit function
	
	'地区缓存
	strarea = "cachearea=array("
	rc=false : rc1 = false
	strtemp = objFile.getFile(app_installdir & "inc/vodarea.txt")
	strtemp = replace(strtemp,chr(10),"")
	arr = split(strtemp, chr(13))
	strtemp = ""
	for i=0 to UBound(arr)
		if rc then strarea = strarea & ","
		strarea = strarea & "array(" &i+1& ",""" & arr(i) & """)"
		rc = true
	next
	strarea = strarea & ")" & vbcrlf
	on error resume next
	Execute strarea
	if err then err.clear : writeA "更新地区缓存失败，请检查数据是否合法，是否包含引号、单引号、百分号、尖括号等特殊字符":exit function
	
	'语言缓存
	strlang = "cachelang=array("
	rc=false : rc1 = false
	strtemp = objFile.getFile(app_installdir & "inc/vodlang.txt")
	strtemp = replace(strtemp,chr(10),"")
	arr = split(strtemp, chr(13))
	strtemp = ""
	for i=0 to UBound(arr)
		if rc then strlang = strlang & ","
		strlang = strlang & "array(" &i+1& ",""" & arr(i) & """)"
		rc = true
	next
	strlang = strlang & ")" & vbcrlf
	on error resume next
	Execute strlang
	if err then err.clear : writeA "更新语言缓存失败，请检查数据是否合法，是否包含引号、单引号、百分号、尖括号等特殊字符":exit function
	
	'用户组缓存
	strusergroup = "cacheusergroup=array("
	rc=false : rc1 = false
	set rs = objdb.DB("SELECT * FROM {pre}user_group","rs1")
	do while not rs.eof
		if rc then strusergroup= strusergroup & ","
		strusergroup = strusergroup & "array(" &rs("ug_id")& ","""&rs("ug_name")&""",""" & rs("ug_type") & """,""" & rs("ug_popedom") & """," & rs("ug_upgrade") & "," & rs("ug_popvalue") & ")"
		rs.movenext
		rc=true
	loop
	strusergroup = strusergroup & ")" & vbcrlf
	objdb.c(rs)
	on error resume next
	Execute strusergroup
	if err then err.clear : writeA "更新用户组缓存失败，请检查数据是否合法，是否包含引号、单引号、百分号、尖括号等特殊字符":exit function
	
	str = str &  strvodtype & strarttype  &  strvodtopic & strarttopic & strserver & strarea & strlang & strusergroup & "%" & ">"
	objFile.createFile app_installdir & "inc/cache.asp",str
	writeA ""
end function

function getValueByArray(byval arr,byval val)
	dim i ,arr1
	for i=0 to ubound( arr )
		arr1 = arr(i)
		if arr1(0) = cint(val) then getValueByArray = arr1 : exit for
	next
end function

function getFileByCache(byval cacheFlag,byval filePath)
	if chkCache(cacheFlag) then
		getFileByCache = getCache(cacheFlag)
	else
		getFileByCache = objFile.getFile(filepath)
		setCache cacheFlag,getFileByCache
	end if
end function

function setCacheFile(byval cPath,byval cName,byval cValue)
	if app_dynamiccache =1 then
		dim cachefile:cachefile = app_installdir&"upload/cache/"&cPath&"/"&cName&".html"
		objFile.createFilePath cachefile
		objFile.createFile cachefile,cValue
	end if
end function

function attemptCacheFile(byval cPath,byval cName)
	if app_dynamiccache =1 then
		dim cachefile,cachecontent,cachetime
		cachefile = app_installdir&"upload/cache/"&cPath&"/"&cName&".html"
		cachetime = objFile.getFileTime(cachefile)
		if cachetime <> "" then
			if DateDiff("s", CDate(cachetime), now()) < 60*app_cachetime then
				cachecontent=objFile.getFile(cachefile): cachecontent = replaceStr(cachecontent,"{maccms:runtime}",getRunTime):writeE cachecontent
			end if
		end if
	end if
end function

function getVodCount(flag)
	dim whereStr
	if flag = "day" then
		whereStr = " AND year(d_time)="&Year(date)&" AND month(d_time)="&month(date)&" AND day(d_time)="&day(date)
	end if
	getVodCount = objdb.DB("SELECT count(*) FROM {pre}vod WHERE d_hide=0 AND d_type>0" & whereStr,"exe")(0)
end function

function getArtCount(flag)
	dim whereStr
	if flag = "day" then
		whereStr = " AND year(a_time)="&Year(date)&" AND month(a_time)="&month(date)&" AND day(a_time)="&day(date)
	end if
	getArtCount = objdb.DB("SELECT count(*) FROM {pre}art WHERE a_hide=0 AND a_type>0" & whereStr,"exe")(0)
end function

function getUserCount(flag)
	dim whereStr
	if flag = "day" then
		whereStr = " AND year(u_regtime)="&Year(date)&" AND month(u_regtime)="&month(date)&" and day(u_regtime)="&day(date)
	end if
	getUserCount = objdb.DB("SELECT count(*) FROM {pre}user WHERE u_status=1" & whereStr,"exe")(0)
end function

function getKeysLink(key,ktype)
	dim tempArray,i,str
	if not isN(key) then
		key = replaceStr(key,"|"," ")
		key = replaceStr(key,","," ")
		key = replaceStr(key,"  "," ")
		tempArray = split(key," ")
		for i=0 to ubound(tempArray)
			if not isN( tempArray(i) ) then
				str = str & "<a target='_blank' href='"&app_installdir&"search.asp?"&ktype&"="& Server.URLEncode(  tempArray(i) ) &"'>"&tempArray(i)&"</a>&nbsp;"
			end if
		next
	end if
	getKeysLink = str
end function

Function repPse(ByVal txt,ByVal id)
	dim psecontent,psearr,i,j
	id = id MOD 7
	if isN(txt) then repPse="":exit function
	psecontent=getFileByCache( "dim_index", app_installdir & "inc/dim_pse2.txt" )
	if isN(psecontent) then repPse = txt : exit function
	psecontent = replace(psecontent,chr(10),"")
	psearr = split(psecontent,chr(13)) : i=UBound(psearr)+1
	if i<1 then i=1
	j=inStr(txt,"<br>")
	if j=0 then j=inStr(txt,"<br/>")
	if j=0 then j=inStr(txt,"<br />")
	if j=0 then j=inStr(txt,"</p>")
	if j=0 then j=inStr(txt,"。")+1
	if j>0 then
		repPse=Mid(txt,1,j-1)&psearr(id MOD i)&Mid(txt,j)
	else
		repPse=psearr(id MOD 1)&txt
	end if
End Function

function getTypeIDS(id,tabName)
	dim i,j,tmpArray,strResult,tmpSp
	tmpArray = objdb.db("select t_id,t_pid from "& tabName &" a order by t_sort asc","arr")
	tmpSp=split(id,",") : strResult=""
	for j=0 to UBound(tmpSp)
		if isN(strResult) then strResult = tmpSp(j) else strResult = strResult & "," &tmpSp(j)
		for i=0 to UBound(tmpArray,2)
			if ""&tmpArray(1,i)=""&tmpSp(j) then
				strResult= strResult &","&getTypeIDS(tmpArray(0,i),tabName)
			end if
		next
	next
	getTypeIDS=strResult
end function

Function getAddressInfo(byval flag,byval vodname,byval vodfrom,byval vodserver,byval vodurl)
    Dim urlStr
    Dim i, j, playurlarr, playfromarr, playserverarr, playurlarrlen, playfromarrlen, playserverarrlen, arr1, rc, rc1, str, serverarr, server, from, urlarr, url,fromrc
    if isN(vodurl) then vodurl=""
    if isN(vodfrom) then vodfrom=""
    if isN(vodserver) then vodserver=""
    
    playurlarr = Split(vodurl, "$$$"): playurlarrlen = UBound(playurlarr)
    playfromarr = Split(vodfrom, "$$$"): playfromarrlen = UBound(playfromarr)
    playserverarr = Split(vodserver, "$$$"): playserverarrlen = UBound(playserverarr)
    
    rc = False
    fromrc = true
     
    For i = 0 To playfromarrlen
        rc1 = False
        
        server = "null"
        from = playfromarr(i): If isN(from) Then from = "null"
        If playserverarrlen >= i Then
        	server = getVodXmlText("vodserver.xml","servers/server", playserverarr(i) , 2)
        End If
        if isN(server) then server = "null"
        
        If playurlarrlen >= i Then
        	If rc Then str = str & "$$$"
        	
            url = playurlarr(i)
            If isN(url) Then
            	url = "null"
            Else
                urlarr = Split(url, "#"): url = ""
                For j = 0 To UBound(urlarr)
                    If Not isN(urlarr(j)) Then
                        If rc1 Then url = url & "#"
                        url = url & urlarr(j)
                        rc1 = True
                    End If
                Next
            End If
        End If
        str = str & server & "$$" & from & "$$" & url : rc = True
    Next
    str = replaceStr(str,"'","\'")
    If app_encrypt = 1 Then
        urlStr = "var maccms_"&flag&"list = unescape('" & escape(str) & "');"
    ElseIf app_encrypt = 2 Then
        urlStr = escape(str)
        urlStr = objBase64.Base64Encode(escape(str))
        urlStr = "var maccms_"&flag&"list = unescape(base64decode('" & urlStr & "'));"
    Else
        urlStr = "var maccms_"&flag&"list = '" & str & "';"
    End If
    getAddressInfo = "var playname='" & replaceStr(vodname,"'","\'") & "';" & vbCrLf & urlStr 
End Function

Function getPlayer()
    getPlayer = "<script>var strUrlQS=getQS('" & app_vodsuffix & "');getPlayer(strUrlQS[1],strUrlQS[2]);</script>"
End Function

Function getDowner()
    getDowner = "<script>var strUrlQS=getQS('" & app_vodsuffix & "');getDowner(strUrlQS[1],strUrlQS[2]);</script>"
End Function

function getUserFlag(byval flag)
	select case flag
	case 1 : getUserFlag="包时"
	case 2 : getUserFlag="IP段"
	case else  : getUserFlag="计点"
	end select
end function

function getTypeByPopedomFilter(byval flag)
	dim userid,usergroup,i,rc,arr,arr1,a,b,res
	a="0,"
	b="0,"
	rc=false
	userid=session("userid") : usergroup=session("usergroup")
	if isN(usergroup) then usergroup=0 else usergroup = cint(usergroup)
	arr = getValueByArray(cacheusergroup, usergroup)
	
	for i=0 to ubound( cacheusergroup )
		arr1 = cacheusergroup(i)
		
		if usergroup=0 then
			if  instr(","&arr1(3),",1,") then
				a = a & arr1(2)
			end if
		else
			if instr(","&arr1(3),",1,") and arr1(5) > arr(5) then
				a = a & arr1(2)
			end if
			if arr1(5) <= arr(5) then
				b = b & arr1(0) & ","
			end if
		end if
	next
	
	a = replaceStr(a,",,",",")
	b = replaceStr(b,",,",",")
	
	if right(a, 1) = "," then a = Mid(a, 1, Len(a) - 1)
	if right(b, 1) = "," then b = Mid(b, 1, Len(b) - 1)
	if flag="menu" then
		res = " and t_id not in("& a &") "
	else
		res = " and d_type not in("& a &") and d_usergroup in("& b &") "
	end if
	getTypeByPopedomFilter= res
end function

function getUserPopedom(id,flag)
	dim userid,usergroup,i,result,ug_id,ug_popvalue1,num
	dim arr
	userid=session("userid") : usergroup=session("usergroup") : result=false : ug_popvalue1=0 :num=0
	if flag= "list" then
		flag = "1"
	elseif flag= "vod" then
		flag = "2"
	elseif flag="play" then
		flag = "3"
	elseif flag="down" then
		flag = "4"
	end if
	
	for i=0 to ubound(cacheusergroup)
		ug_id=cacheusergroup(i)(0)
		if ug_id=usergroup then ug_popvalue1=cacheusergroup(i)(5)
		if indexOf(cacheusergroup(i)(2),","&id&",") and indexOf(cacheusergroup(i)(3),","&flag&",") then
			 num=num+1
			 if ug_popvalue1 >= cacheusergroup(i)(5) then result = true :exit for
		end if
	next
	if num =0 then result = true
	getUserPopedom=result
end function
%>