vassistant.asp

一款不错的影音视频网站源代码。asp的程序。后台有自动采集功能

<!--#include file="../../inc/conn.asp"-->
<!-- #include file="function.asp" -->
<%'call login_check()
Server.ScriptTimeOut=999999999
Response.Buffer = True
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
Response.Charset="GB2312"

If len(trim(Request.Form))>10 Then
	r_url=Request.Form
	if left(r_url,7)<>"http://" then response.write "False":response.end
	if inStr(r_url,"tudou.com")>0 then
		Response.Write rtrimVBcrlf(tudou(r_url))&"|8"
	elseif inStr(r_url,"youku.com")>0 then
		Response.Write rtrimVBcrlf(youku(r_url))&"|3"
	elseif inStr(r_url,"56.com")>0 then
		Response.Write rtrimVBcrlf(v56(r_url))&"|13"
	elseif inStr(r_url,"qq.com")>0 then
		Response.Write rtrimVBcrlf(qq(r_url))&"|5"
	elseif inStr(r_url,"sohu.com")>0 then
		Response.Write rtrimVBcrlf(sohu(r_url))&"|14"
	elseif inStr(r_url,"6.cn")>0 then
		Response.Write rtrimVBcrlf(liucn(r_url))&"|9"
	elseif inStr(r_url,"sina.com.cn")>0 then
		Response.Write rtrimVBcrlf(sina(r_url))&"|4"
	end if
end if

function youku(url)
if inStr(url,"playlist_show")>0 then
v_id=GetBody(url,"id_",".")
a_url="http://www.youku.com/playlist/rss/id/"&v_id
Set xml=Server.CreateObject("Microsoft.XMLDOM")
xml.Async=false
xml.loadxml(gethttp(a_url,"utf-8"))
If xml.ReadyState>2 Then
set citem=xml.getelementsbytagname("item")
for i=0 to citem.length-1
v_url=citem.item(i).selectSingleNode("guid").text
v_title=citem.item(i).selectSingleNode("title").text
if v_url<>"" then youku=youku&v_url&"$"&v_title&VBcrlf
next
end if
else
v_content=gethttp(url,"utf-8")
v_title=GetBody(v_content,"<meta name=""title"" content=""",""">")
v_url=GetBody(v_content,"var videoId = '","'")
if v_url=False then
v_url=GetBody(v_content,"fo.addVariable(""VideoIDS"",",");")
end if
youku=youku&v_url&"$"&v_title
end if
end function

function tudou(url)
if inStr(url,"/playlist/")>0 then
v_id=GetBody(url,"id/","/")
if v_id=False then v_id=GetBody(url&"/","lid=","/")
a_url="http://www.tudou.com/playlist/rss.do?lid="&v_id
Set xml=Server.CreateObject("Microsoft.XMLDOM")
xml.Async=false
xml.loadxml(gethttp(a_url,"utf-8"))
If xml.ReadyState>2 Then
set citem=xml.getelementsbytagname("item")
for i=0 to citem.length-1
v_url=citem.item(i).selectSingleNode("tudou:info").attributes.getNamedItem("id").text
v_title=citem.item(i).selectSingleNode("title").text
if v_url<>"" then tudou=tudou&v_url&"$"&v_title&VBcrlf
next
end if
else
v_content=gethttp(url,"utf-8")
v_title=GetBody(v_content,"title: """,""",")
v_url=GetBody(v_content,"iid: """,""",")
if v_title=False then v_title=GetBody(v_content,"<title>"," - 视频")
if v_url=False then v_url=GetBody(v_content,"var iid=",",")
tudou=tudou&v_url&"$"&v_title
end if
end function

function sina(url)
if inStr(url,"/a/")>0 then
dim regEx,v_url
vcontent=gethttp(url,"gb2312")
v_a=GetBody(vcontent,"[共","个视频]")
	If v_a<=16 Then
	v_b=1
	Else 
	If v_a Mod 16<>0 Then
		v_b=Int(v_a/16)+1
	Else
		v_b=Int(v_a/16)
	End If 
	End If
For i=1 To v_b
l_url=GetBody(url,"/a/",".")
vcontent=gethttp("http://you.video.sina.com.cn/a/"&l_url&"/"&i&"/2.html","gb2312")
Set regEx = New RegExp
regEx.Pattern = "<a href=""javascript:;""  name=""playlist"" vid=""(\d*)"" uid=""(\d*)"" author=""(\d*)"" title=""(.*?)"" pic=""(.*?)"" >"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(vcontent)
For Each Match In Matches
	On Error Resume Next
   If Err.Number = 0 Then
	v_url=v_url&Match.SubMatches(0)&"&uid="&Match.SubMatches(1)&"$"&Match.SubMatches(3)&VBcrlf
   End If
Next
Set regEx = Nothing 
Next
sina=v_url
else
v_url=GetBody(url&"#","#","#")
v_url=v_url&"&uid="&GetBody(url,"uid=","#")
if v_url="&uid=False" then
v_urlarray=Split(url, "/")
v_url=Replace(Replace(v_urlarray(UBound(v_urlarray)),".html",""),"-","&uid=")
end if
l_url=Split(url,"#")
v_content=gethttp(l_url(0),"gb2312")
v_title=GetBody(v_content,"<title>","  专辑播放页")
if v_title=False then v_title=GetBody(v_content,"<title>","-播客视频")
sina=sina&v_url&"$"&v_title
end if
end function

function liucn(url)
if inStr(url,"/playlist/")>0 then
l_url=GetBody(url&"*","playlist/","*")
l_content=gethttp(url,"utf-8")
v_i=GetBody(l_content,"视频：<em class=""hit"">","</em> &nbsp; &nbsp; 订阅：")
for i=0 To v_i-1
v_content=gethttp("http://6.cn/plist/"&l_url&"/"&i&".html","utf-8")
v_title=GetBody(v_content,"<h2 class=""pvt"">","</h2>")
v_url=GetBody(v_content,"pageMessage.evid = '","'")
liucn=liucn&v_url&"$"&v_title&VBcrlf
next
else
v_content=gethttp(url,"utf-8")
v_title=GetBody(v_content,"<h2 class=""pvt"">","</h2>")
if v_title=False then v_title=GetBody(v_content,"<title>"," - 视频")
v_url=GetBody(v_content,"pageMessage.evid = '","'")
liucn=liucn&v_url&"$"&v_title
end if
end function

function v56(url)
if inStr(url,"/album")>0 then
l_id=GetBody(url,"-aid-",".")
l_content=gethttp("http://www.56.com/w"&(l_id mod 89+11)&"/album_v2/album_videolist.phtml?callback=albumV2.callback&aid="&l_id&"&o=0","gb2312")
l_url=GetArray(l_content,"video_id"":""",""",""")
v_id=Split(l_url,"$Array$")
For i=0 To UBound(v_id)
v_content=gethttp("http://www.56.com/w"&(l_id mod 89+11)&"/play_album-aid-"&l_id&"_vid-"&v_id(i)&".html","gb2312")
v_title=GetBody(v_content,"id=""playingVideo"">","</a></li>")
v_url=GetBody(v_content,"http://www.56.com/n_",".swf")
v56=v56&v_url&"$"&v_title&VBcrlf
next
else
v_content=gethttp(url,"gb2312")
v_title=GetBody(v_content,"id=""playingVideo"">","</a></li>")
if v_title=False then v_title=GetBody(v_content,"&Subject=","&channel=")
v_url=GetBody(v_content,"http://www.56.com/n_",".swf")
v56=v56&v_url&"$"&v_title
end if
end function

function qq(url)
if inStr(url,"?g=")>0 then
l_id=GetBody(url&"#","g=","#")
l_content=gethttp(url,"utf-8")
v_a=GetBody(l_content,"专辑所有视频<font>(",")</font>")
	If v_a<=10 Then
	v_b=1
	Else 
	If v_a Mod 10<>0 Then
		v_b=Int(v_a/10)+1
	Else
		v_b=Int(v_a/10)
	End If 
	End If
For i=1 To v_b
l_content=gethttp("http://video.qq.com/v1/group/video?p="&i&"&g="&l_id&"","utf-8")
l_Array=GetArray(l_content,"addVideo(",");"">")
l_Array=Replace(l_Array,"addVideo(","")
l_Array=Replace(l_Array,");>","")
l_Array=Replace(l_Array,"视频:","")
l_Arrayc=Split(l_Array,"$Array$")
For y=0 To UBound(l_Arrayc)
v_Array=Split(l_Arrayc(y),",")
qq=qq&v_Array(0)&"$"&v_Array(1)&VBcrlf
next
next
else
v_content=gethttp(url,"utf-8")
v_title=GetBody(v_content,"					title=""","""")
v_url=GetBody(v_content,"vid=""","""")
qq=qq&v_url&"$"&v_title
end if
end function

function sohu(url)
if inStr(url,"/pp/")>0 then
l_id=GetBody(url&"#","/pp/","#")
l_content=gethttp("http://v.blog.sohu.com/playlistVideo.jhtml?outType=3&m=list&playlistId="&l_id&"&size=10000&number=1","gb2312")
l_Array=GetArray(l_content,",""id"":",",")
v_Array=Split(l_Array,"$Array$")
For i=0 To UBound(v_Array)
sohu=sohu&v_Array(i)&VBcrlf
next
else
v_url=Split(url, "/")
if IsNumeric(v_url(UBound(v_url))) then
sohu=v_url(UBound(v_url))
else
sohu=Split(v_url(UBound(v_url)),"#")(0)
end if
end if
end function

function rtrimVBcrlf(str)
dim pos,isBlankChar
pos=len(str)
isBlankChar=true
while isBlankChar and pos>=2
if mid(str,pos-1,2)=VBcrlf then
pos=pos-2
else
isBlankChar=false
end if
wend
rtrimVBcrlf=left(str,pos)
end function
%>