Yahoo video sans pub et inscription

Soyez le premier à donner votre avis sur cette source.

Vue 7 698 fois - Téléchargée 347 fois

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

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
56
Date d'inscription
jeudi 26 décembre 2002
Statut
Membre
Dernière intervention
28 septembre 2005

ah oui j'oubliais de remercier jrivet pour son aide avec ce code
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
et je tiens a remercier aussi crenaud76 pour son aide avec ce code
If LenB(item) <> 0 Then List1.AddItem item
Messages postés
56
Date d'inscription
jeudi 26 décembre 2002
Statut
Membre
Dernière intervention
28 septembre 2005

Des commentaires svp
Messages postés
56
Date d'inscription
jeudi 26 décembre 2002
Statut
Membre
Dernière intervention
28 septembre 2005

petite astuce dans IE, clic droit sur le nom de la vidéo
ajouter aux favoris...

pour visionner
aller sur Launch France
et la aller dans favori selectionner votre video.
a noter que les liens sur le site australien sont different
donc ne fonctionneras pas comme si haut mentionner

n'hesite pas a visiter tout les sites de Launch
pour trouver ta video j'ai remarquer que le site anglophone ne contient pas toutes les videos

ex. anastacia - Left Outside Alone
je ne l'ai trouver que sur le site allemand et nul part ailleurs

pour mon prog je vais ajouter un bouton favori qui fonctionneras sur tous les sites incluant le site australien
Messages postés
21
Date d'inscription
vendredi 2 mai 2003
Statut
Membre
Dernière intervention
8 décembre 2007

C'est une astuce pour faire connaitre le service Yahoo vidéo ;) ?

Bon, je vais suivre le dev du prog, t'as interêt à bien bosser dessus, jour et nuit si il le faut!

TchA0.
Messages postés
56
Date d'inscription
jeudi 26 décembre 2002
Statut
Membre
Dernière intervention
28 septembre 2005

as tu remarqué que si tu n'utilise pas mon prog tu as une bande annonce avant de visionner ton video
Afficher les 6 commentaires

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.