Yahoo video sans pub et inscription

Télécharger le projet
Commenter

Description

Je sais le code est pas terrible et pas commenter mais ca fonctionne (jusqu'au jour ou ils changeront leur site )

Donc ceci permet de visionner des vidéos sans pub et sans inscription
tout dans le zip

Source / Exemple : 


'Form1
'-------------------------
Dim A, B, C As String

Private Sub Command1_Click()
On Error Resume Next
WebBrowser1.GoBack
End Sub

Private Sub Command10_Click()
WebBrowser1.Navigate "http://launch.yahoo.com/musicvideos/"
End Sub

Private Sub Command2_Click()
On Error Resume Next
'WebBrowser1.GoForward
End Sub

Private Sub Command3_Click()
WebBrowser1.Navigate "http://fr.launch.yahoo.com/v/"
End Sub

Private Sub Command4_Click()
WebBrowser1.Navigate "http://au.launch.yahoo.com/videos/"
End Sub

Private Sub Command5_Click()
WebBrowser1.Navigate "http://de.launch.yahoo.com/v/"
End Sub

Private Sub Command6_Click()
WebBrowser1.Navigate "http://it.launch.yahoo.com/v/"
End Sub

Private Sub Command7_Click()
WebBrowser1.Navigate "http://es.launch.yahoo.com/v/"
End Sub

Private Sub Command8_Click()
WebBrowser1.Navigate "http://uk.launch.yahoo.com/v/"
End Sub

Private Sub Command9_Click()
WebBrowser1.Navigate "http://espanol.launch.yahoo.com/v/"
End Sub

Private Sub Form_Load()
Me.WindowState = vbMaximized
WebBrowser1.Navigate "http://launch.yahoo.com/musicvideos/"
End Sub

Private Sub Form_Resize()
On Error Resume Next
WebBrowser1.Width = Me.ScaleWidth - 1
WebBrowser1.Height = Me.ScaleHeight - 350
End Sub

Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
Dim Numero As String
Dim i As Integer
A = Text
For i = 1 To Len(A)
If IsNumeric(Mid$(A, i, 1)) And IsNumeric(Mid$(A, i, 7)) Then
Numero = Mid$(A, i, 7)
Exit For
End If
Next
If LenB(Numero) <> 0 Then C = Numero
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Me.Caption = WebBrowser1.LocationName
B = URL
End Sub

Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
Cancel = True
WebBrowser1.Navigate B
Form2.Show
Form2.Text1 = C
Form2.WebBrowser1.Navigate "http://today.launch.yahoo.com/player/player.asp?cid=512&ps=&sx=ondemand%2Exml&vid=" & C
End Sub
'-----------------------
'Form2
'-----------------------
Private Sub Command1_Click()
If Text1 <> "" Then
List1.AddItem Text1
Text1 = ""
End If
End Sub

Private Sub Form_Load()
ChargeListe
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
WebBrowser1.Width = Form2.ScaleWidth - List1.Width - 1
Form2.WebBrowser1.Height = Form2.ScaleHeight
End Sub

Private Sub List1_DblClick()
Dim Numero As String
Numero = List1.List(List1.ListIndex)
WebBrowser1.Navigate "http://today.launch.yahoo.com/player/player.asp?cid=512&ps=&sx=ondemand%2Exml&vid=" & Numero
End Sub

Function ChargeListe()
On Error GoTo Fin
Dim item As String
Open "c:\Favori.ini" For Input As #1 'Lecture
Do While Not EOF(1) 'jusqua la derniere ligne
Line Input #1, item 'met la premiere ligne de Favori.ini dans la variable item
If LenB(item) <> 0 Then List1.AddItem item 'verifie une ligne vide
Loop 'ligne suivante
Close #1
Fin:
End Function

Function SauveListe()
Dim cpt4 As Integer
Dim ligne As String
Open "c:\Favori.ini" For Output As #2 'Écriture
For cpt4 = 0 To List1.ListCount 'du premier au dernier item de la listbox
ligne = List1.List(cpt4) 'met l'item dans la variable ligne
Print #2, ligne
Next 'retour a For
Close #2
End Function

Private Sub Form_Unload(Cancel As Integer)
SauveListe
End Sub

Conclusion :


Le fichier d'installation est sur ce site http://pages.infinit.net/cheatman

pour ceux qui n'ont pas VB
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_trouduc)