優酷一鍵采集 測試

啊城

看看采集后的視頻能用多長時不過期啊 美中不足，就是當采集和單首增加同時用，列表就排得亂七八糟 看以后有時間能不能再改善 asp版 采集程序開源，是否有朋友能轉換成php版 如能記的發我參照一下為謝。 測試方法的地址；http://www.flashcs5as3.com/bfs/代理程序/youku采集.asp?id=http://v.youku.com/v_show/id_XMzc1MjIxODI0.html

2. <%
3. '說明 當 輸入url目標網頁地址，返回值getHTTPPage是目標網頁的html代碼
4. '跟隨當前的 html代碼 中找到相關的信息
5. '---------------------------------加載html代碼 URL網址數據--------------------
6. function getHTTPPage(url) '定義函數
7. dim Http '定義變量http
8. set Http=server.createobject("MSXML2.XMLHTTP")'建立XMLHTTP對象
9. Http.open "GET",url,false '設置http對象打開方式 GET方式， URL 連接頁面地址，同步處理
10. Http.send() '發送請求
11. if Http.readystate<>4 then '對象處理狀態為 非結束
12. exit function '退出函數
13. end if
14. getHTTPPage=bytesToBSTR(Http.responseBody,"utf-8") '接收數據并轉換 文本格式 utf-8 也可以用 GB2312
15. set http=nothing
16. if err.number<>0 then err.Clear '錯誤代碼非0則出錯 清除錯誤
17. end function ''退出定義函數
18. '------------------------------------轉換html代碼數據---------------------------
19. '轉換亂瑪，直接用xmlhttp調用有中文字符的網頁得到的將是亂瑪，可以通過adodb.stream組件進行轉換
20. Function BytesToBstr(body,Cset)
21. dim objstream
22. set objstream = Server.CreateObject("adodb.stream")
23. objstream.Type = 1
24. objstream.Mode =3
25. objstream.Open
26. objstream.Write body
27. objstream.Position = 0
28. objstream.Type = 2
29. objstream.Charset = Cset
30. BytesToBstr = objstream.ReadText
31. objstream.Close
32. set objstream = nothing
33. End Function
34. '------------------------------------強制數據----------------------------------
35. '強制函數相 當無法得到 html代碼時
36. '進行強制性來得到 url目標網頁地址所有的代碼
37. Function GetKey(HTML,Start,Last)
38. Dim filearray,filearray2
39. filearray=split(lcase(HTML),lcase(Start))
40. filearray2=split(lcase(filearray(1)),lcase(Last))
41. GetKey=filearray2(0)
42. End Function
44. '------------------------------------輸入url網頁地址---------------------------
45. '連接 ID 的信息
46. Dim Url,Html '定義2個變量 Url Html
47. Url=request.querystring("id")'設為 ?id= 后面的網址信息
48. Html = getHTTPPage(Url)
49. '輸出當前要采集的 標題名稱
50. 'Response.write "當前采集的的標題名是："&GetKey(Html,"<title>","</title>")
53. '--------------------------防止別的域名連接使用-------------------
54. 'dim iphtmlUrl,strURid,aryReturnm
55. 'iphtmlUrl ="http://"&Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL")
56. 'strURid = iphtmlUrl 'http://www.flashcs5as3.com/bfs/代理程序/
57. 'aryReturnm = Split(strURid,"flashcs5as3")
58. 'if aryReturnm then
59. ' call ponseList1()
60. 'else
61. 'call ponseList2()
62. 'end if
64. 'sub ponseList1()
65. 'response.Redirect("http://www.flashcs5as3.com")
66. 'end sub
68. 'sub ponseList2()
69. 'response.Redirect("ok本站使用")
70. 'end sub
72. '----------------------------------生成xml 數據-------------------
73. dim body,jmStr,tvName,tvTitle
74. dim i
75. flag = instr(Html,"<ul class=""pack_number"">")'設置 flag 變量名 從html代碼中到到相關的位置 開始位置
76. jmStr = mid(Html,flag,instr(flag,Html,"</ul>")-flag)'結束的位置
77. 'response.write(jmStr)' '輸出相關內容
78. bfsxml = bfsxml & "<?xml version='1.0' encoding='gb2312'?>" & vbcrlf &"<list>" &""'設置XML 的編碼 方便FLASH中讀入
79. a = 0
80. for i = 1 to len(jmStr)'進行計算 輸出 XML 的ID
81. if mid(jmStr,i,3) = "d=""" then
82. tvName = mid(jmStr,i+3,instr(i+3,jmStr,""">")-i-3)
83. Session("tvTitle") = Session("tvTitle") & tvName & vbcrlf
84. a = a + 1
85. bfsxml = bfsxml & "<m label=""" & tvName & """ />" & vbcrlf
86. 'bfsxml = bfsxml & "<m> "&"<n>""" & tvName & """ <n> "&"<m/>" & vbcrlf
87. end if
88. next
89. bfsxml = bfsxml & vbcrlf & "</list>"
90. response.write(bfsxml)'輸出bfsxml 輸出播放器需要加載的XML
91. %>

復制代碼

梵音未改

啊城的作品一定是高難新穎的。辛苦了

清音王梓

阿城是代碼達人啊，我看到這一堆代碼就頭大，哈哈！強人！{:soso_e179:}