VB源代码-FLV嗅探工具.doc

Private Declare Function ShellExecute Lib shell32.dll Alias ShellExecuteA (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long 声明Public Sub SetThunderAgentTask(ByVal pURL As String, Optional ByVal pFileName As String = , Optional ByVal pPath As String = , Optional ByVal pComments As String = , Optional ByVal pReferURL As String = , Optional ByVal nStartMode As Integer = -1, Optional ByVal nOnlyFromOrigin As Integer = 0, Optional ByVal nOriginThreadCount As Integer = -1) Dim ThunderAgent As Object Set ThunderAgent = CreateObject(ThunderAgent.Agent) ThunderAgent.AddTask pURL, pFileName, pPath, pComments, pReferURL, nStartMode, _ nOnlyFromOrigin, nOriginThreadCount ThunderAgent.CommitTasks2 (1) Set ThunderAgent = NothingEnd SubSub ClearDups(lst As Control, comptype As Boolean) Dim i&, j&, tmp$(), cID&, lstCount&, sComptype&, tmpLine$ lst.Visible = True lstCount = lst.ListCount - 1 If lstCount cID - 1 Then tmp(cID) = tmpLine cID = cID + 1 End If Next lst.Visible = TrueEnd SubPrivate Sub Command1_Click()On Error Resume NextOn Error Resume NextWebBrowser1.Silent = TrueWebBrowser2.Silent = TrueWebBrowser1.Document.All.Item(kw).FocusWebBrowser1.Document.All(kw).Value = Text1.TextDim vTag, kFor Each vTag In WebBrowser1.Document.All If UCase(vTag.tagName) = INPUT Then If vTag.Type = submit And vTag.Value = 开始GO! Then vTag.Click End IfNextEnd SubPrivate Sub Command2_Click()Dim outdatatxt As String Open d:record.txt For Output As #1 For i = 0 To List1.ListCount - 1 Print #1, 第 & i + 1 & 段 & List1.List(i) Next i Close #1 MsgBox 已保存在“d:record.txt”中, , 提示End SubPrivate Sub Command3_Click()On Error Resume NextWebBrowser1.Silent = TrueWebBrowser2.Silent = TrueFor i = 0 To List1.ListCount - 1Call SetThunderAgentTask(List1.List(i), 第 & i + 1 & 片段)Next iEnd SubPrivate Sub Form_Load()On Error Resume NextWebBrowser1.Silent = TrueWebBrowser2.Silent = TrueDim bRes As Boolean bRes = SkinStart(App.Path & skin.urf, 2, RQPJNW0N0V2QRMAP1KXVBHHDUVVQGUXR, 1, 0, 0)WebBrowser1.Navigate /index.htmEnd SubPrivate Sub Label3_Click()On Error Resume NextShellExecute 0, open, /s/blog_92b6d74d01012s3r.html, vbNullString, vbNullString, 3End SubPrivate Sub Text1_GotFocus()Text1.SelStart = 0Text1.SelLength = Len(Text1)End SubPrivate Sub Timer1_Timer()Static c As Integerc = c + 1Select Case cCase 1Label3.ForeColor = vbGreenCase 2Label3.ForeColor = vbYellowCase 3Label3.ForeColor = vbBlueCase 4Label3.ForeColor = &HFF00&c = 0End SelectEnd SubPrivate Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)On Error Resume NextWebBrowser1.Silent = TrueWebBrowser2.Silent = TrueWebBrowser2.Navigate WebBrowser1.LocationURLDim i As IntegerFor i = 0 To WebBrowser1.Document.links.length - 1If WebBrowser1.Document.links.Item(i).innerText = 超清模式解析 ThenWebBrowser2.Navigate WebBrowser1.Document.links.Item(i)Label1.Caption = 已转为超清模式ElseIf WebBrowser1.Document.links.Item(i).innerText = 高清模式解析 ThenWebBrowser2.Navigate WebBrowser1.Document.links.Item(i)Label1.Caption = 已转为高清模式ElseIf WebBrowser1.Document.links.Item(i).innerText = 480P版解析 ThenWebBrowser2.Navigate WebBrowser1.Document.links.Item(i)Label1.Caption = 480P版解析End IfNext iEnd SubPrivate Sub Text1_Change()Label1.Caption = 普通模式If List1.ListCount 0 ThenFor a = List1.ListCount - 1 To 0 Step -1 List1.RemoveItem (a)Next aEnd IfEnd SubPrivate Sub WebBrowser2_DocumentComplete(ByVal pDisp As Object, URL As Variant)On Error Resume NextWebBrowser1.Silent = TrueWebBrowser2.Silent = TrueDim i As IntegerFor i = 0 To WebBrowser2.D