<!--#include file="conn.asp"-->
<!--#include file="pinyin.asp"-->
<%
Response.Buffer = true
Server.ScriptTimeOut=999999
dim action, rpage, cjurl, cjflag, rtype, rkey ,rday, fa, xt, rid, url, typearr, backurl

action = be("all", "action")
rtype = be("all", "rtype")
rpage = be("all", "rpage")
cjurl = be("all", "cjurl")
rkey = be("all", "rkey")
rday = be("all", "rday")
fa = be("all", "fa")
xt = be("all","xt")
rid = be("all","rid")
cjflag = be("all","cjflag")
backurl = Request.ServerVariables("HTTP_REFERER")
If Not isNum(rtype) Then rtype = 0 Else rtype = CInt(rtype)
If Not isNum(rpage) Then rpage = 1 Else rpage = CInt(rpage)
If Not isNum(rday) Then rday = 1 Else rday = CInt(rday)
If rpage < 1 Then rpage = 1

if app_timming=0 then action="main": writeA "closed"
Select Case action
	Case "cjsel": cjsel
	Case "cjday": cjday
	Case "cjtype": cjtype
	Case "cjall": cjall
	Case Else: main
End Select
set typearr=nothing
dispseObj()

Function cut(str, start, start_num, Over, over_num)
    cut = Mid(str, InStr(str, start) + start_num, InStr(str, Over) + over_num - InStr(str, start) - start_num)
End Function

Sub cjsel()
    Dim ids
    ids = be("all", "ids")
    If isN(ids) Then ErrMsg "采集提示", "请选择采集数据": Exit Sub
    if xt="1" then
    	url = cjurl & "?ac=videolist&rid="&rid&"&ids=" & ids
    elseif xt="2" then
    	url = cjurl &  "-action-ids-vodids-"&ids&"-cid--play--inputer--wd--h-0-p-1"
    else
    	url = cjurl & "?action=cjsel&ids=" & ids
    end if
    Call insertdata(url, "cjsel")
End Sub

Sub cjday()
    if xt="1" then
    	url = cjurl & "?ac=videolist&rid="&rid&"&h="&rday&"&pg=" & rpage
    elseif xt="2" then
    	url = cjurl &"-action-day-vodids--cid--play--inputer--wd--h-"&rday&"-p-"&rpage
    else
    	url = cjurl & "?action=cjday&rday="&rday&"&rpage=" & rpage
    end if
    Call insertdata(url, "cjday")
End Sub

Sub cjtype()
    If isN(rtype) Then
        showMsg "请先进入分类,否则无法使用采集分类!", backurl
        Exit Sub
    End If
    if xt="1" then
    	url = cjurl & "?ac=videolist&rid="&rid&"&pg=" & rpage & "&t=" & rtype
    elseif xt="2" then
    	url = cjurl & "-action-all-vodids--cid-"&rtype&"-play--inputer--wd--h-0-p-"&rpage
    else
    	url = cjurl & "?action=cjtype&rpage=" & rpage & "&rtype=" & rtype
    end if
    Call insertdata(url, "cjtype")
End Sub

Sub cjall()
    if xt="1" then
    	url = cjurl & "?ac=videolist&rid="&rid&"&pg=" & rpage
    elseif xt="2" then
    	url = cjurl & "-action-all-vodids--cid--play--inputer--wd--h-0-p-" & rpage
    else
    	url = cjurl & "?action=cjall&rpage=" & rpage
    end if
    Call insertdata(url, "cjall")
End Sub

function getFrom(byval f)
	select case f
		case "百度影音" : f="baidu"
		case "bdhd":f="baidu"
		case "皮皮影音":f="pipi"
		case "闪播Pvod":f="pvod"
		case "迅播高清":f="gvod"
		case "优酷","yuku":f="youku"
		case "qq播客":f="qq"
		case "yuku":f="youku"
	end select
	getFrom = f
end function

function getVUrl(byval u)
	dim arr1,arr2,arr3,i,j,str,rc
	arr1 = split(u,"#")
	rc=false
	for i=0 to ubound(arr1)
		if not isN(arr1(i)) then
			if instr( arr1(i),"$$") > 0 then
				arr3 = split(arr1(i),"$$")
				arr2= split(arr3(1),"$")
			else
				arr2= split(arr1(i),"$")
			end if
			if rc then str = str & "#"
			if ubound(arr2)=2 or ubound(arr2)=1 then
				str = str & arr2(0) & "$" & arr2(1)
			else
				str = str & arr2(0)
			end if
			rc =true
			set arr2=nothing
			set arr3=nothing
		end if
	next
	set arr1=nothing
	getVUrl = str
end function

Sub insertdata(ByVal surl, ByVal cjtype)
    Dim objxml, xmlnode, html, i, j, k, strpic, arr1, arr2, tmpplayfrom, tmpplayurl, tmpplayserver, vodurls, rc,sql, rs, pagecount, resultdes
    Dim vodid, vodname, vodenname,vodnote, vodstate, vodtype, vodstarring, vodpic, vodtime, vodyear, vodarea, vodlanguage,voddes, autoid, vodsubname, vodcolor, voddirected, vodremarks, vodhitstime,vodletter,vodfrom,vodserver,vodurl,voddownfrom,voddownserver,voddownurl
    Dim xn_list,xn_type,xn_vod,xn_vod_time,xn_vod_from,xn_vod_tid,xn_vod_starring,xn_vod_directed,xn_vod_language,xn_vod_lang,xn_vod_urls
    
    if xt="1" or xt="2" then
    	xn_list = "list"
    	xn_type = "rss/class/ty"
    	xn_vod = "rss/list/video"
    	xn_vod_time = "last"
    	xn_vod_from = "flag"
    	xn_vod_tid = "tid"
    	xn_vod_starring = "actor"
    	xn_vod_directed = "director"
    	xn_vod_language = "lang"
    	xn_vod_urls = "dl"
    else
    	xn_list = "vods"
    	xn_type = "maccms/types/type"
    	xn_vod = "maccms/vods/vod"
    	xn_vod_time = "time"
    	xn_vod_from = "from"
    	xn_vod_tid = "type"
    	xn_vod_starring = "starring"
    	xn_vod_directed = "directed"
    	xn_vod_language = "language"
    	xn_vod_urls = "urls"
    	cjflag=""
    end if
    
    html = getPage(surl, "utf-8")
    If html = False Then writeE "获取数据失败"
    on error resume next
    Set objxml = New AppXMLDOM
    objxml.LoadXml (html)
    Set xmlnode = objxml.Root
    
    if xt="1" or xt="2" then
    	pagecount = xmlnode.getElementsByTagName(xn_list).Item(0).getAttributeNode("pagecount").nodevalue
    else
    	pagecount = xmlnode.getElementsByTagName("pagecount").Item(0).Text
    end if
    If Not isNum(pagecount) Then pagecount = 1 Else pagecount = CLng(pagecount)
    Set xmlnode = objxml.FindNodes(xn_vod)
    
    If Err.Number > 0 Or xmlnode.length = 0 Then
        writeA "没有任何可用数据"
        Exit Sub
    End If
    Err.Clear
    On Error GoTo 0
    
    For i = 0 To xmlnode.length - 1
        rc = False
        vodid = xmlnode(i).SelectNodes("id")(0).Text
        vodname = xmlnode(i).SelectNodes("name")(0).Text
        vodremarks = xmlnode(i).SelectNodes("note")(0).Text
        vodstate = xmlnode(i).SelectNodes("state")(0).Text
        vodtype = cjflag & xmlnode(i).SelectNodes(xn_vod_tid)(0).Text
        vodstarring = xmlnode(i).SelectNodes(xn_vod_starring)(0).Text
        voddirected = xmlnode(i).SelectNodes(xn_vod_directed)(0).Text
        vodpic = xmlnode(i).SelectNodes("pic")(0).Text
        vodtime = xmlnode(i).SelectNodes(xn_vod_time)(0).Text
        vodyear = xmlnode(i).SelectNodes("year")(0).Text
        vodarea = xmlnode(i).SelectNodes("area")(0).Text
        vodlanguage = xmlnode(i).SelectNodes(xn_vod_language)(0).Text
        voddes = xmlnode(i).SelectNodes("des")(0).Text
        Set vodurls = xmlnode(i).SelectNodes(xn_vod_urls)(0).childNodes
        
        vodsubname = ""
        vodcolor = ""
        vodhitstime = ""
        voddownurl = ""
        
        
        vodname = replaceStr(vodname, "'", ""): If Len(vodname) > 255 Then vodname = Left(vodname, 255)
        vodenname = Hanzi2PinYin(vodname): If Len(vodenname) > 255 Then vodenname = Left(vodenname, 255)
        if not isN(vodenname) then vodletter = UCase(left(vodenname,1))
        vodstate = replaceStr(vodstate, "[", ""): vodstate = replaceStr(vodstate, "]", ""):    If Not isNum(vodstate) Then vodstate = 0
        vodstarring = CStr(replaceStr(vodstarring, "'", "")): If Len(vodstarring) > 255 Then vodstarring = Left(vodstarring, 255)
        vodyear = replaceStr(vodyear, "'", ""):  If Len(vodyear) > 32 Then vodyear = Left(vodyear, 32)
        vodlanguage = replaceStr(vodlanguage, "'", ""):  If Len(vodlanguage) > 32 Then vodlanguage = Left(vodlanguage, 32)
        vodarea = replaceStr(vodarea, "'", ""):  If Len(vodarea) > 32 Then vodarea = Left(vodarea, 32)
        vodpic = replaceStr(vodpic, "'", ""):  If Len(vodpic) > 255 Then vodpic = Left(vodpic, 255)
        voddes = htmlDecode(voddes) : voddes = replaceStr(voddes, "'", "")
        vodtype = getTypeID(vodtype):  If Not isNum(vodtype) Then vodtype = 0
        vodfrom =""
        vodurl = ""
        vodserver = ""
        
        If not isN(vodname) and vodtype > 0 Then
            sql = "SELECT * FROM {pre}vod WHERE d_name ='" & vodname & "' "
            if app_vodmaccjsname = 1 then sql = sql & " and d_type= " & vodtype
            Set rs = objdb.DB(sql, "rs3")
            If rs.EOF And rs.Bof Then
                For j = 0 To vodurls.length - 1
                    
                    If rc Then vodfrom = vodfrom & "$$$": vodurl = vodurl & "$$$" : vodserver = vodserver & "$$$" :end if
                    vodfrom = vodfrom & getFrom(vodurls(j).getAttributeNode(xn_vod_from).nodevalue)
                    if xt="1" then
                    	vodurl = vodurl & getVUrl(vodurls(j).Text)
                    elseif xt="2" then
                    	vodurl = vodurl & replaceStr(vodurls(j).Text,chr(10),"#")
                    	vodurl = replace(vodurl,chr(13),"#")
                    	vodurl = replace(vodurl,"##","#")
                    else
                    	vodurl = vodurl & vodurls(j).Text
                    end if
                    vodurl = replaceStr(vodurl, "'", "''")
                    vodserver = vodserver & "0"
                    rc = True
                Next
                objdb.add "{pre}vod", Array("d_type", "d_name", "d_subname", "d_enname","d_letter", "d_state", "d_color", "d_content", "d_remarks", "d_pic", "d_level", "d_hits", "d_starring", "d_directed", "d_year", "d_area", "d_language", "d_addtime", "d_time", "d_playfrom", "d_playserver","d_playurl", "d_downfrom","d_downserver","d_downurl"), Array(vodtype, vodname, vodsubname, vodenname, vodletter, vodstate, vodcolor, voddes, vodremarks, vodpic, 0, 0, vodstarring, voddirected, vodyear, vodarea, vodlanguage, Now(), Now(), vodfrom, vodserver, vodurl,voddownfrom,voddownserver, voddownurl )
                wTips vodname, "新增数据"
            Else
                
                tmpplayurl = rs("d_playurl")
                tmpplayfrom = rs("d_playfrom")
                tmpplayserver = rs("d_playserver")
                
                For j = 0 To vodurls.length -1
                    vodfrom = getFrom(vodurls(j).getAttributeNode(xn_vod_from).nodevalue)
                    if xt="1" then
                    	vodurl = getVUrl(vodurls(j).Text)
                    elseif xt="2" then
                    	vodurl = replaceStr(vodurls(j).Text,chr(10),"#")
                    	vodurl = replace(vodurl,chr(13),"#")
                    	vodurl = replace(vodurl,"##","#")
                    else
                    	vodurl = vodurls(j).Text
                    end if
                    vodurl = replaceStr(vodurl, "'", "''")
                    If tmpplayurl = vodurl Then
                         resultdes = "无需更新播放地址"
                    ElseIf isN(tmpplayurl) Or InStr(rs("d_playfrom"), vodfrom) <= 0 Then
                        resultdes = "新增播放地址组"
                        tmpplayurl = tmpplayurl & "$$$" & vodurl
                        tmpplayfrom = tmpplayfrom & "$$$" & vodfrom
                        tmpplayserver = tmpplayserver & "$$$" & vodserver
                        rs("d_time") = Now()
                    Else
                        resultdes = "更新播放地址"
                        arr1 = Split(tmpplayurl, "$$$"): arr2 = Split(tmpplayfrom, "$$$"): rc = False: tmpplayurl = ""
                        For k = 0 To UBound(arr2)
                            If rc Then tmpplayurl = tmpplayurl & "$$$"
                            if ubound(arr1) >= k then
								If arr2(k) = vodfrom Then arr1(k) = vodurl
								tmpplayurl = tmpplayurl & arr1(k)
							else
								tmpplayurl = tmpplayurl & vodurl
							end if
                            rc = True
                        Next
                        rs("d_time") = Now()
                    End If
                Next
                tmpplayurl = replaceStr(tmpplayurl, Chr(13), "#")
                strpic = rs("d_pic")
                If InStr(","&strpic, "http:") > 0 Then rs("d_pic") = vodpic
                rs("d_state") = vodstate
                rs("d_remarks") = vodremarks
                rs("d_playurl") = tmpplayurl
                rs("d_playfrom") = tmpplayfrom
                rs("d_playserver") = tmpplayserver
                rs.update
                
                wTips vodname, resultdes
            End If
            objdb.C (rs)
        Else
            wTips vodname, "没有绑定分类、跳过"
        End If
    Next
    
    Set vodurls = Nothing
    Set xmlnode = Nothing
    Set objxml = Nothing
    writeF "ok第"&rpage&"页完成,共"&pagecount&"页"
    
    if rpage < pagecount then
    	rpage = rpage+1
    	call cjday()
    end if
End Sub

Sub wTips(vname, vdes)
    
End Sub


Sub main()
    
End Sub

Function getTypeID(ByVal servertype)
    Dim sql, unionids, i, arrayLen
    
    if not isarray(typearr) then
    	sql = "select t_id,t_union from {pre}vod_type where t_union is not null "
    	typearr = objdb.DB(sql, "arr")
    end if
    
    if isarray(typearr) then
    	arrayLen = ubound(typearr,2)
	    For i = 0 To arrayLen
	        unionids = typearr(1, i)
	        If InStr("," & unionids, "," & servertype & ",") > 0 Then
	            getTypeID = typearr(0, i)
	            Exit function
	        End If
	    Next
    end if
    getTypeID = ""
End Function

%>