復制代碼 代碼如下:

Imports System.Net
Imports System.IO
Imports System.Text
Imports System.Text.RegularExpressions
Public Class frmMain
Structure VList
Dim id As Integer
Dim title As String
Dim vid1 As String
Dim vid2 As String
Overloads Function ToString() As String
Return String.Format("{0}:<{1}> [{2}]", id, title, vid1)
End Function
End Structure
Dim myList As New List(Of VList)
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
' 防止重復創建變量
Dim wr1 As HttpWebRequest
Dim wr2 As HttpWebResponse
Dim ret As String
Dim reg As Match
Dim g As Group
Dim preVid As String = "" '上一個VID
Dim nowid As Integer = 0 '當前的視頻集數
Dim listUrl As String = TextBox1.Text '獲取專輯URL，如
Dim tarUrl As String = "http://v.youku.com/v_playlist/f{0}" '{0}ListID
reg = Regex.Match(listUrl, "playlist_show/id_(/d+).*/.html")
If Not reg.Success Then
MsgBox("專輯列表提取失?。?)
Exit Sub
End If
g = reg.Groups(1)
tarUrl = String.Format(tarUrl, g.Value) & "o{1}p{0}.html" '{0}集數 {1}排序
wr1 = HttpWebRequest.Create(TextBox1.Text)
wr2 = wr1.GetResponse
ret = New StreamReader(wr2.GetResponseStream, Encoding.GetEncoding(wr2.CharacterSet)).ReadToEnd
reg = Regex.Match(ret, "<title>(.+) - 專輯 - 優酷視頻</title>")
If Not reg.Success Then
MsgBox("專輯名稱提取失?。?)
Else
g = reg.Groups(1)
MsgBox("專輯名：《" & g.Value & "》")
End If
Do
' 從Web流中獲取頁面文本
wr1 = HttpWebRequest.Create(String.Format(tarUrl, nowid, "0")) '按倒序方式查找視頻
wr2 = wr1.GetResponse
ret = New StreamReader(wr2.GetResponseStream, Encoding.GetEncoding(wr2.CharacterSet)).ReadToEnd
'TextBox2.Text = ret
' 創建一個臨時視頻列表變量
Dim nlist As New VList
nlist.id = nowid '獲取ID
' 獲取videoId
reg = Regex.Match(ret, "var/s+videoId/s*=/s*""(/d+)""/s*;")
If Not reg.Success Then Exit Do
g = reg.Groups(1)
' 如果VID等于上一個VID最退出
If g.Value = preVid Then Exit Do
nlist.vid1 = g.Value
' 獲取videoId2
reg = Regex.Match(ret, "var/s+videoId2/s*=/s*""((/w|=)+)""/s*;") '"var/s+videoId2/s*=/s*""(/w+)""/s*;")
If Not reg.Success Then Exit Do
g = reg.Groups(1)
nlist.vid2 = g.Value
' 獲取標題
reg = Regex.Match(ret, "<title>(.+) - (.+) - 視頻 - 優酷視頻 - 在線觀看 - </title>")
If Not reg.Success Then
nlist.title = "{名稱查找錯誤}"
Else
g = reg.Groups(2)
nlist.title = g.Value
End If
' 收尾工作
myList.Add(nlist) '添加到總列表中
preVid = nlist.vid1 '記錄最后一個VID
wr2.Close()
Me.Text = nowid & " : 處理完成！"
nowid += 1
Loop
wr2.Close()
MsgBox(nowid & " 個視頻全部采集處理完成！")
Button2_Click(sender, e)
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
ListBox1.Items.Clear()
For Each ls As VList In myList
ListBox1.Items.Add(String.Format("{0}:<{1}> [{2}]", ls.id, ls.title, ls.vid1))
Next
myList.Clear()
End Sub

End Class