Connaitre les info d'une radio


Télécharger le projet
Commenter

Description

Voila ce code permet de recuperer les info d'une piste en cours sur une radio utilisant YACAST

Cette source est pour Le mouv' mais foncttionne avec d'autres

Source / Exemple : 


' Déclaration des constantes liées aux API utilisées pour le téléchargement.
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const HTTP_QUERY_CONTENT_LENGTH = 5
Private Const HTTP_QUERY_STATUS_CODE = 19

' Déclaration des API utilisées pour le téléchargement.
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hRequest As Long, ByVal dwInfoLevel As Long, ByRef lpvBuffer As Any, ByRef lpdwBufferLength As Long, ByRef lpdwIndex As Long) As Boolean

Public Type Infosradio
    Artist1 As String
    Album1 As String
    Titre1 As String
    Date1 As String
    Editeur1 As String
    Achat1 As String
    Image1 As String
    
    Artist2 As String
    Album2 As String
    Titre2 As String
    Date2 As String
    Editeur2 As String
    Achat2 As String
    Image2 As String
    
    Artist3 As String
    Album3 As String
    Titre3 As String
    Date3 As String
    Editeur3 As String
    Achat3 As String
    Image3 As String
    
    Artist4 As String
    Album4 As String
    Titre4 As String
    Date4 As String
    Editeur4 As String
    Achat4 As String
    Image4 As String
    
    Artist5 As String
    Album5 As String
    Titre5 As String
    Date5 As String
    Editeur5 As String
    Achat5 As String
    Image5 As String
    
    Reussi As Boolean
End Type
Public Function OuiFm() As Infosradio
OuiFm = Yacast("http://cache.yacast.fr/V4/lemouv/d_data.html")
End Function

Private Function Yacast(Url As String) As Infosradio
Dim Text As String
Dim Infos

On Error GoTo Erreur:

Yacast.Reussi = False

'telecharge le fichier ou l'adresse du fichier info est stocké
If TéléchargeFichier(Url, App.Path & "\info.txt") = False Then
    Exit Function
End If
Text = ""
Text = OuvreFichier(App.Path & "\info.txt") 'Ouvre le fichier telechargé
Text = Replace(Text, Chr(34), "") 'supprime les guillemet""
Text = Replace(Text, vbLf, "") 'suprime les retour a la ligne
Text = Replace(Text, "<html><head><meta http-equiv=Content-Type content=text/html; charset=windows-1252><meta http-equiv=Expires content=0><meta http-equiv=Pragma content=no-cache><meta http-equiv=Cache-Control content=no-cache> <meta http-equiv=Refresh content=10; url=", "") 'supprime le debut du fichier => l'adresse
Text = Replace(Text, "><base target=_self></head></html>", "")  'supprime la fin du fichier
Url = Replace(Url, "/d_data.html", "/" & Text) 'crée l'adresse du fichier ou les info sont sotcké
Kill (App.Path & "\info.txt")

'telecharge le fichier "info"
If TéléchargeFichier(Url, App.Path & "\info.txt") = False Then
    Exit Function
End If
Text = ""
Text = OuvreFichier(App.Path & "\info.txt")    'Ouvre le fichier telechargé
If Text = "" Then
    Kill (App.Path & "\info.txt")
    Exit Function
End If
Text = Replace(Text, Chr(34), "")
Text = Replace(Text, vbLf, "")
Infos = Split(Text, ";")
   
With Yacast
    .Titre1 = Replace(Infos(30), "top.titresPochettes[0] = ", "")
    .Album1 = Replace(Infos(31), "top.albumsPochettes[0] = ", "")
    .Artist1 = Replace(Infos(32), "top.interpretesPochettes[0] = ", "")
    .Achat1 = Replace(Infos(34), "top.urlsAchatPochettes[0] = ", "")
    .Date1 = Replace(Infos(38), "top.sortiePochettes[0] = ", "")
    .Editeur1 = Replace(Infos(39), "top.labelPochettes[0] = ", "")
    .Image1 = "http://cache.yacast.fr" & Replace(Infos(16), "        top.imagesPochettesSrc[0] = ", "")
    
    .Titre2 = Replace(Infos(56), "top.titresPochettes[2] = ", "")
    .Album2 = Replace(Infos(57), "top.albumsPochettes[2] = ", "")
    .Artist2 = Replace(Infos(58), "top.interpretesPochettes[2] = ", "")
    .Date2 = Replace(Infos(64), "top.sortiePochettes[2] = ", "")
    .Editeur2 = Replace(Infos(65), "top.labelPochettes[2] = ", "")
    .Image2 = "http://cache.yacast.fr" & Replace(Infos(20), "        top.imagesPochettesSrc[2] = ", "")
    
    .Titre3 = Replace(Infos(69), "top.titresPochettes[3] = ", "")
    .Album3 = Replace(Infos(70), "top.albumsPochettes[3] = ", "")
    .Artist3 = Replace(Infos(71), "top.interpretesPochettes[3] = ", "")
    .Date3 = Replace(Infos(77), "top.sortiePochettes[3] = ", "")
    .Editeur3 = Replace(Infos(78), "top.labelPochettes[3] = ", "")
    .Image3 = "http://cache.yacast.fr" & Replace(Infos(22), "        top.imagesPochettesSrc[3] = ", "")
    
    .Titre4 = Replace(Infos(82), "top.titresPochettes[4] = ", "")
    .Album4 = Replace(Infos(83), "top.albumsPochettes[4] = ", "")
    .Artist4 = Replace(Infos(84), "top.interpretesPochettes[4] = ", "")
    .Date4 = Replace(Infos(90), "top.sortiePochettes[4] = ", "")
    .Editeur4 = Replace(Infos(91), "top.labelPochettes[4] = ", "")
    .Image4 = "http://cache.yacast.fr" & Replace(Infos(24), "        top.imagesPochettesSrc[4] = ", "")
    
    .Titre5 = Replace(Infos(95), "top.titresPochettes[5] = ", "")
    .Album5 = Replace(Infos(96), "top.albumsPochettes[5] = ", "")
    .Artist5 = Replace(Infos(97), "top.interpretesPochettes[5] = ", "")
    .Date5 = Replace(Infos(103), "top.sortiePochettes[5] = ", "")
    .Editeur5 = Replace(Infos(104), "top.labelPochettes[5] = ", "")
    .Image5 = "http://cache.yacast.fr" & Replace(Infos(26), "        top.imagesPochettesSrc[5] = ", "")
    
    .Reussi = True
End With
Text = ""
Kill (App.Path & "\info.txt")
Exit Function

Erreur:
Yacast.Reussi = False
End Function

Function OuvreFichier(Fichier As String) As String
Dim a As Integer
a = FreeFile
Open Fichier For Binary Access Read As #a
    Do While Not EOF(a)
        OuvreFichier = OuvreFichier & Input(1024, #a)
    Loop
Close #a
End Function

Public Function TéléchargeFichier(Url As String, Chemin As String) As Boolean
    TéléchargeFichier = False
    
    ' Déclaration des variables locales et du buffer.
    Dim HandleInternetOpen As Long
    Dim HandleInternetOpenUrl As Long
    Dim ResInternetReadFile As Boolean
    Dim Buffer As String * 2048
    Dim NumberOfBytesRead As Long
    Dim Taille As Long
    Dim SizeOfBuffer As Long
    Dim b As Integer
    
    ' Ouverture d'un point d'accès à Internet.
    HandleInternetOpen = InternetOpen("Radio", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    
    ' Teste si l'ouverture du point d'accès a réussi.
    If HandleInternetOpen = 0 Then
        GoTo Erreur
    End If
    
    ' Connexion à l'adresse du fichier à télécharger.
    HandleInternetOpenUrl = InternetOpenUrl(HandleInternetOpen, Url, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
    
    ' Teste si la connexion s'est bien effectuée.
    If HandleInternetOpenUrl = 0 Then
        GoTo Erreur
    End If
    
    Buffer = vbNullString
    SizeOfBuffer = Len(Buffer)
    
    ' Lecture du code de status du .
    ResInternetReadFile = HttpQueryInfo(HandleInternetOpenUrl, HTTP_QUERY_STATUS_CODE, ByVal Buffer, SizeOfBuffer, 0)
    
    ' Teste si la lecture du code de status s'est bien effectuée.

    
    ' Teste si le code de status est 404.
    If Buffer = "404" Then
        GoTo Erreur
    End If
    
    Buffer = vbNullString
    SizeOfBuffer = Len(Buffer)
    
    ' Lecture de la taille du fichier à télécharger.
    ResInternetReadFile = HttpQueryInfo(HandleInternetOpenUrl, HTTP_QUERY_CONTENT_LENGTH, ByVal Buffer, SizeOfBuffer, 0)
    
    ' Teste si la lecture de la taille s'est bien effectuée.
    If ResInternetReadFile = False Then
        GoTo Erreur
    End If
    
    On Error GoTo Erreur
    
    ' Conversion de la taille en Long et placement du résultat dans la variable "Taille".
    Taille = CLng(Buffer)
    
    ' Initialisation de la barre de progression.

    
    NumberOfBytesRead = 1
    b = FreeFile
    ' Ouverture du fichier de destination.
    Open Chemin For Binary Access Write As #b
    
    ' Boucle de lecture/écriture du fichier.
    Do While NumberOfBytesRead > 0
        Buffer = vbNullString
        
        ' Remplissage du buffer par les caractères lus.
        ResInternetReadFile = InternetReadFile(HandleInternetOpenUrl, Buffer, Len(Buffer), NumberOfBytesRead)
        
        ' Teste si la lecture s'est bien déroulée.
        If ResInternetReadFile = False Then
            GoTo Erreur
        End If
        
        ' Ecriture du contenu du buffer dans le fichier de destination.
        Put #b, , Left$(Buffer, NumberOfBytesRead)
        

        DoEvents
    Loop
    
    Close #b

    
    ' Fermeture de la connexion à l'adresse du fichier.
    If HandleInternetOpenUrl <> 0 Then
        InternetCloseHandle (HandleInternetOpenUrl)
    End If
    
    ' Fermeture du point d'accès à Internet.
    If HandleInternetOpen <> 0 Then
        InternetCloseHandle (HandleInternetOpen)
    End If
    
    TéléchargeFichier = True
    
    Exit Function

Erreur:

    ' Fermeture de la connexion à l'adresse du fichier.
    If HandleInternetOpenUrl <> 0 Then
        InternetCloseHandle (HandleInternetOpenUrl)
    End If
    
    ' Fermeture du point d'accès à Internet.
    If HandleInternetOpen <> 0 Then
        InternetCloseHandle (HandleInternetOpen)
    End If
    

    
    ' Teste la présence du fichier de destination.
    If Dir(Chemin) <> "" Then
        Close #b
        Kill (Chemin)
    End If
End Function

Conclusion :


Merci de mettre un lien vers mon site dans votre application (http://crae.free.fr/)
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 (Crae)