优酷一键采集 测试
<div style="LEFT: -210px; WIDTH: 1000px; POSITION: relative; TOP: 150px"><palign=center><embed style="WIDTH: 890px; HEIGHT: 550px"
src=http://www.flashcs5as3.com/bfs/mv27.swf?id=优酷采集 width=890 height=550
type=application/octet-stream allowscriptaccess="never" allownetworking="internal"
invokeurls="false" flashvars="logo= &skin=http://www.flashcs5as3.com/bfs/mv27.swf?id=优酷采
集.&repeat=true&autostart=true&allowfullscreen=true&file=&autostart=true&logo="
autostart="false" allowfullscreen="true"
bgcolor="000000"><p></P></DIV><br><br><br><br><br><br><br><br><br><br><br><br><br>
看看采集后的视频能用多长时不过期啊
美中不足，就是当采集和单首增加同时用，列表就排得乱七八糟
看以后有时间能不能再改善
asp版 采集程序开源，是否有朋友能转换成php版 如能记的发我参照一下为谢。
测试方法的地址；http://www.flashcs5as3.com/bfs/代理程序/youku采集.asp?id=http://v.youku.com/v_show/id_XMzc1MjIxODI0.html
<%
'说明 当 输入url目标网页地址，返回值getHTTPPage是目标网页的html代码
'跟随当前的 html代码 中找到相关的信息
'---------------------------------加载html代码 URL网址数据--------------------
function getHTTPPage(url)'定义函数
dim Http'定义变量http
set Http=server.createobject("MSXML2.XMLHTTP")'建立XMLHTTP对象
Http.open "GET",url,false'设置http对象打开方式 GET方式， URL连接页面地址，同步处理
Http.send()'发送请求
if Http.readystate<>4 then'对象处理状态为 非结束
exit function'退出函数
end if
getHTTPPage=bytesToBSTR(Http.responseBody,"utf-8") '接收数据并转换文本格式 utf-8也可以用 GB2312
set http=nothing
if err.number<>0 then err.Clear'错误代码非0则出错 清除错误
end function''退出定义函数
'------------------------------------转换html代码数据---------------------------
'转换乱玛，直接用xmlhttp调用有中文字符的网页得到的将是乱玛，可以通过adodb.stream组件进行转换
Function BytesToBstr(body,Cset)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
'------------------------------------强制数据----------------------------------
'强制函数相当无法得到 html代码时
'进行强制性来得到 url目标网页地址所有的代码
Function GetKey(HTML,Start,Last)
Dim filearray,filearray2
filearray=split(lcase(HTML),lcase(Start))
filearray2=split(lcase(filearray(1)),lcase(Last))
GetKey=filearray2(0)
End Function
'------------------------------------输入url网页地址---------------------------
'连接 ID 的信息
Dim Url,Html'定义2个变量Url Html
Url=request.querystring("id")'设为 ?id=后面的网址信息
Html = getHTTPPage(Url)
'输出当前要采集的 标题名称
'Response.write "当前采集的的标题名是："&GetKey(Html,"<title>","</title>")
'--------------------------防止别的域名连接使用-------------------
'dim iphtmlUrl,strURid,aryReturnm
'iphtmlUrl ="http://"&Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL")
'strURid = iphtmlUrl 'http://www.flashcs5as3.com/bfs/代理程序/
'aryReturnm = Split(strURid,"flashcs5as3")
'if aryReturnm then
'call ponseList1()
'else
'call ponseList2()
'end if
'sub ponseList1()
'response.Redirect("http://www.flashcs5as3.com")
'end sub
'sub ponseList2()
'response.Redirect("ok本站使用")
'end sub
'----------------------------------生成xml 数据-------------------
dim body,jmStr,tvName,tvTitle
dim i
flag = instr(Html,"<ul class=""pack_number"">")'设置 flag 变量名 从html代码中到到相关的位置 开始位置
jmStr = mid(Html,flag,instr(flag,Html,"</ul>")-flag)'结束的位置
'response.write(jmStr)' '输出相关内容
bfsxml = bfsxml & "<?xml version='1.0' encoding='gb2312'?>" & vbcrlf&"<list>" &""'设置XML 的编码 方便FLASH中读入
a = 0
for i = 1 to len(jmStr)'进行计算 输出 XML 的ID
if mid(jmStr,i,3) = "d=""" then
tvName = mid(jmStr,i+3,instr(i+3,jmStr,""">")-i-3)
Session("tvTitle") = Session("tvTitle") & tvName & vbcrlf
a = a + 1
bfsxml = bfsxml & "<m label=""" & tvName & """ />" & vbcrlf
'bfsxml = bfsxml & "<m> "&"<n>""" & tvName & """ <n> "&"<m/>" & vbcrlf
end if
next
bfsxml = bfsxml & vbcrlf & "</list>"
response.write(bfsxml)'输出bfsxml输出播放器需要加载的XML
%>
啊城的作品一定是高难新颖的。辛苦了 阿城是代码达人啊，我看到这一堆代码就头大，哈哈！强人！{:soso_e179:}
页:
[1]