PROGRAMME TV

Commentaire de Trainkill666 le 12/11/2005 17:31:13

Salut,
beau programme, car bien pratique.
le code peut etre simplifié mais ça c'est autre chose.
Le plus important c'est que l'idée est là.
Je vais le modifier pour l'adapter à mon bureau, essentiellement au niveau graphique.
Allez, un ch'ti 10

Commentaire de Trainkill666 le 12/11/2005 19:16:21

Salut chez remoi,
je viens de regarder un peu plus ton programme,
tu peux simplifier pas mal de chose, par exemple :
dans Private Sub SelectionH_Click()
tu retires tout et remplaces par
Page = "/" & Mdate(3) & "-" & Mdate(2) & "-" & Mdate(1) & "/" & SelectionMode.ListIndex + 1 & "/" & SelectionH.ListIndex + 1 & "/" & ModeChaines & ".html"
voilà comment remplacer une cinquantaine de lignes par 1 seule.
Vérifies quand même si j'ai pas fait d'erreur.
y'a des autres trucs mais j'ai pas trop le temps,
@+

Commentaire de Nexto le 13/11/2005 11:47:54

Excellent le programme surtoup très pratique... Je vais souvent voir le pogramme télé le soir sur le web ce qui me prend plus de temps :p

Je suis pas chez moi, j'ai pas pu encore voir le code source mais le screen à l'air pas mal dutout.

A++
Nexto (fabienfs)

Commentaire de djamalbe le 14/11/2005 10:53:19

Tout nouveau et tout beau ! Bonne suite et que 10/10 :)

Commentaire de roka le 14/11/2005 16:51:56

merci à tous

Commentaire de racattac13 le 18/11/2005 15:53:15

salut
ben... comme beaucoup de monde je te met 10 .... l'idée n'est pas original pour moi ... je m'etait deja fais une petite page html qui affiche la page de telerama a une heure precise grace a un petit script vbs , mais le mettre dans un programme c'est fort , et ca me servir pour d'autre site dont j'ai besoin de tirées des infos .... merci
a plus

Commentaire de Trainkill666 le 18/11/2005 22:40:44

Salut j'ai fait petite modif à ton programme,
voici le code la form1, où tu peux y supprimer winsock1
j'ai fait ça sans réelle vérification, dans le peut de temps de libre que j'ai :
Option Explicit
Dim valeuretape
Const URL = "www.programme-tv.net"
Private Sub Command1_Click()
  SelectionH_Click
  ListView1.ListItems.Clear ' Effacement de la list
  TotalHTML = vbNullString ' efface le contenu
  Winsock.Close
  valeuretape = 1
  Winsock.Connect URL, 80
End Sub
Private Sub Form_Load()
Dim tempload As Integer
   valeuretape = 1
  With ListView2
      .ListItems.Add 1, , "Durée", , 0
      .ListItems.Add 2, , "Son", , 0
      .ListItems.Add 3, , "Vers. Multilingue", , 0
      .ListItems.Add 4, , "VO sous titrée", , 0
      .ListItems.Add 5, , "Ss-titres malentendant", , 0
      .ListItems.Add 6, , "Ratio", , 0
      .ListItems.Add 7, , "En direct", , 0
      .ListItems.Add 8, , "En clair", , 0
      .ListItems.Add 9, , "CSA", , 0
     For tempload = 1 To 9
      .ListItems(tempload).SubItems(1) = "--"
     Next
  End With
  SelectionH.ListIndex = 0 ' preparation de la selection
  SelectionMode.ListIndex = 0 ' preparation de la selection
  ModeChaines = LCase(SelectionMode.Text) 'on entre notre preference de depart
  Mdate(1) = Split(Date, "/")(0) 'traitement de la date
  Mdate(2) = Split(Date, "/")(1)
  Mdate(3) = Split(Date, "/")(2)
End Sub
Private Sub ListView1_Click()
  If ListView1.ListItems.Count = 0 Then Exit Sub
    TotalHTML = ""
     Text1 = vbNullString
      Page = ListView1.SelectedItem.Key
  Winsock.Close
  valeuretape = 2
  Winsock.Connect URL, 80
End Sub
Private Sub SelectionH_Click()
Page = "/" & Mdate(3) & "-" & Mdate(2) & "-" & Mdate(1) & "/" & SelectionMode.ListIndex + 1 & "/" & SelectionH.ListIndex + 1 & "/" & ModeChaines & ".html"
End Sub
Private Sub SelectionMode_Click()
'Ici Selection de la préference Chaines
  ModeChaines = LCase(SelectionMode.Text)
  'SelectionH_Click 'refrech de notre string "Page" pour lui affecter la valeur
End Sub
Public Function Etape1()
Dim I As Integer
'gestion de du tableau
  For I = 1 To UBound(MaTable)
      Etape2 MaTable(I)
  Next I
End Function
Public Function Etape2(retour As String)
'recuperation du nom de la chaines tv + 1 split pour garder que les programmes de la chaine
Dim Separation() As String
Dim Chaines As String
Dim I As Integer
   Chaines = Split(Split(retour, "alt=")(1), " />")(0)
   Separation = Split(retour, "<a href=")
   For I = 1 To UBound(Separation)
       If InStr(1, Separation(I), "<script") Then Exit For 'fin des donné programmes (bas html)
       If InStr(1, Separation(I), "<span") Then 'si sa contien ce terme c'est que des programmes sont disponible pour cette chaine tv
          Etape3 Separation(I), Chaines
       End If
   Next I
End Function
Public Function Etape3(retour As String, Chaine As String)
' pour chaque chaines tv on recherche les valeurs qui nous interesse
Dim Icon As Integer
Dim LienProgramme As String
Dim Horaire As String
Dim Programme As String
Dim Description As String
   LienProgramme = Mid(retour, 2, InStr(3, retour, Chr(34)) - 2) 'le lien pour la description du programme
   Horaire = Split(Split(retour, "horaire" & Chr(34) & ">")(1), "<span")(0) & Split(Split(retour, "minute" & Chr(34) & ">")(1), "</span")(0) ' ajout Minutes
'pas simplifier sinon erreur
  Programme = Split(Split(retour, "nomProgramme" & Chr(34) & ">")(1), "</span")(0) ' Recherche Nom du Programmes
  Programme = RemplaceCharacter(Programme, True) ' on remplace les character
'
   Description = RemplaceCharacter(Split(Split(retour, "<em>")(1), "</em>")(0) & Split(Split(retour, "</em>")(1), "<")(0), True) ' on remplace les character
   Chaine = RemplaceCharacter(Chaine, True) ' on remplace les character
   Icon = RechercheIcon(Chaine) 'recherche de l icon
     Set MonItem = ListView1.ListItems.Add(, LienProgramme, UCase(Chaine), , Icon) 'ajout dans la list
        MonItem.SubItems(1) = Horaire
        MonItem.SubItems(2) = Programme
        MonItem.SubItems(3) = Description
        ListView1.Refresh
End Function
Public Function Etape4(retour As String)
'On Error Resume Next
Dim tempetape4 As Integer
Dim Position(1 To 2) As Long
  Position(2) = 1
For tempetape4 = 1 To 3
  If InStr(Position(2), retour, "<strong>") Then
     Position(1) = InStr(Position(2), retour, "<strong>") + 8
     Position(2) = InStr(Position(1), retour, "</strong>")
     Select Case tempetape4
       Case 1: suiteetape4 retour, Position(1), Position(2), True, "<br"
       Case 2: suiteetape4 retour, Position(1), Position(2), True, "<"
       Case 3: suiteetape4 retour, Position(1), Position(2), False, "<"
     End Select
  End If
Next
  Text1.SelStart = 1
'pas simplifier sinon erreur
  retour = Split(retour, "<table")(1)
  retour = RemplaceCharacter(retour, False)
'
  For tempetape4 = 1 To 9
    If InStr(1, retour, LCase(ListView2.ListItems(tempetape4))) Then
       ListView2.ListItems(tempetape4).SubItems(1) = suite2etape4(tempetape4, retour)
         Position(1) = InStr(1, retour, LCase(ListView2.ListItems(tempetape4)))
         retour = Mid(retour, Position(1))
    End If
  Next
End Function
Public Sub suiteetape4(texte As String, debut As Long, fin As Long, Guillemets As Boolean, textefin As String)
     Text1.SelText = RemplaceCharacter(Mid(texte, debut, fin - debut), Guillemets) & RemplaceCharacter(Mid(texte, fin + 9, InStr(fin + 9, texte, textefin) - fin - 9), Guillemets) & vbCrLf & vbCrLf
End Sub
Public Function suite2etape4(ByVal nombre As Integer, retour As String)
  Select Case nombre
    Case 1: suite2etape4 = Split(Split(retour, "<td class=" & Chr(34) & "clair" & Chr(34) & ">")(1), "<")(0)
    Case 2: suite2etape4 = Split(Split(retour, "<td>")(1), "<")(0)
    Case 3, 4, 5, 7, 8: suite2etape4 = Split(Mid(Split(retour, "<span class")(1), 8), "<")(0)
    Case 6: suite2etape4 = Split(Split(retour, "<td>")(1), "</td>")(0)
    Case 9: suite2etape4 = Split(Mid(Split(retour, "<td class")(1), 10), "<")(0)
  End Select
End Function
Private Sub Winsock_Connect()
'Methode GET
   Envoie = "GET " + Page + " HTTP/1.0" + vbCrLf + "Accept: *.*, */*" + vbCrLf + "User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)" & vbCrLf + "Referer: " & URL & vbCrLf + "Host: " & URL & vbCrLf + "Connection: Keep -Alive" & vbCrLf + vbCrLf
     Winsock.SendData Envoie
End Sub
Private Sub Winsock_DataArrival(ByVal bytesTotal As Long)
  Winsock.GetData RetourHTML, vbString 'Recuperation des donné
   TotalHTML = TotalHTML & RetourHTML 'tout n 'arrive pas en meme temps donc on memorise
  If InStr(1, LCase(RetourHTML), "</html>") Then 'une fois la fin de page arriver on peut commencer a découper tout sa !
     If valeuretape = 1 Then
       MaTable = Split(TotalHTML, "<h2") 'on coupe les donné recu pour chaque chaines tv
       Etape1
     Else
       TotalHTML = Split(TotalHTML, "<p style=")(1) & Split(TotalHTML, "<p style=")(2) & Split(TotalHTML, "<p style=")(3)
       TotalHTML = Split(TotalHTML, "<script")(0)
       Etape4 TotalHTML
     End If
     Winsock.Close
  End If
End Sub
voilà,
j'espère que ça pourra tu servir

Commentaire de croftman le 09/12/2005 22:00:41

Tres bonne source, bien commentée, et qui sert bien! ^^

Commentaire de danone le 31/12/2005 01:43:30

Vraiment super et tres bien fait 10/10