salut
je suis une fille debutant tu peut mon aideret donner les etaper pour telecharger les programme de cette site aussi jai besoin d'un programme de facturation mon email aziza_1981@hotmail.com
merci a tout le monde
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, "")(1), "")(1), "")(1), "")(1), "")(0) & Split(Split(retour, "")(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, "") Then
Position(1) = InStr(Position(2), retour, "") + 8
Position(2) = InStr(Position(1), retour, "")
Select Case tempetape4
Case 1: suiteetape4 retour, Position(1), Position(2), True, "
")(1), "<")(0)
Case 2: suite2etape4 = Split(Split(retour, "<td>")(1), "<")(0)
Case 3, 4, 5, 7, 8: suite2etape4 = Split(Mid(Split(retour, "")(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
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
En effet Trainkill666 sa fonctionne tres bien avec ta methode et quand on y reflechie sa parait LOGIQUE !!!!(Quelle bite je suis.non je rigole on a toujours quelque chose à aprendre) lolllll merci pour l info c 'est cool la je vais lui rajouter la date que l on souhaite choisir j'ai oublié :(
thank Mr
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,
@+
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
je suis une fille debutant tu peut mon aideret donner les etaper pour telecharger les programme de cette site aussi jai besoin d'un programme de facturation mon email aziza_1981@hotmail.com
merci a tout le monde