1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
| Sub testsinmple()
Dim ReQ, url As String, listPRnst, prétab, dicosynth
listPRnst = Array("Bilto :", "Agence TIP :", "Top Entraineurs : ", "Stato Turf : ", "Paris Turf : ")
prétab = Application.Rept("<TH> </TH>", 4)
Set dicosynth = CreateObject("Scripting.Dictionary")
url = "http://www.pronostics-turf.info/fg-pronostics-presse.php"
Set ReQ = CreateObject("microsoft.xmlhttp")
ReQ.Open "get", url, False
ReQ.setRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
ReQ.setRequestHeader "Accept-Language", " fr-FR"
ReQ.setRequestHeader "User-Agent", " Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
ReQ.setRequestHeader "Accept-Encoding", "gzip, deflate"
ReQ.setRequestHeader "Host", "www.pronostics - turf.info"
ReQ.setRequestHeader "DNT", 1
ReQ.setRequestHeader "Connection", "Keep - Alive"
'ReQ.setRequestHeader "Cookie", "c_veses = 12"
ReQ.send
With CreateObject("htmlfile")
donne = Split(ReQ.responsetext, "<h1>")
ltext = Split(donne(3), ":")(0)
madate = Replace(Split(Split(ltext, "le")(1), ",")(0), "-", "/") 'récupère la date
RC = "R" & Replace(Split(donne(3), "ion ")(1), "Course ", "C")
reunion1 = Split(RC, " ")(0) 'récupère la reunion
course = Split(RC, " ")(1) 'récupère la course
discipline = Split(Split(Split(donne(3), "<img")(1), "/>")(1), "</")(0) 'récupère la discipline
prix = Split(Split(donne(2), ":")(1), "</")(0) 'récupère le prix
hippo = Split(ltext, " ")(0) 'récupère l'hippodrome
'vu que les librairie IE sont inutilisable par rapport au script de protection je vais traiter la page en string(texte)
' c'est pas demain la veille qu'on va m'empecher de choper du code HTML a moi !!!!!un GROS LOL!!! pour leur protection a 2 balles
mestables = (Split(ReQ.responsetext, "<table"))
For i = 4 To UBound(mestables)
texte = texte & "<BR>" & "<table" & Split(mestables(i), "</table")(0) & "</table>"
Next
'on réecrit le faux doc html avec seulement les données des tables
.body.innerhtml = texte
'on supprime tout ce qui n'est pas necessaire (les icon ,image ,src ,etc.....)
'For Each elem In .all
'If elem.tagname = "TH" Then elem.innerhtml = elem.innertext
'Next
'**********************************************************************************************************
' et maintenant que l'on a toutes nos tables dans notre faux doc html
'on va garder que celles qui nous interesse
Set mestables = .getelementsbytagname("table")
For i = 0 To mestables.Length - 1
For t = 0 To UBound(listPRnst)
If InStr(mestables(i).outerhtml, listPRnst(t)) > 0 Then tableau = tableau & vbCrLf & "</TR>" & mestables(i).Children(0).Children(0).innerhtml & "</TR>"
Next
'pour la syntheze c'est un peu différent mais je la récupère c'est bon cela dit il y a 16 cellules les pronos il y en a que 8
If InStr(mestables(i).outerhtml, "Synthèse") > 0 Then
suite1 = mestables(i).getelementsbytagname("TR")(1).outerhtml & _
mestables(i).getelementsbytagname("TR")(5).outerhtml
End If
Next
.body.innerhtml = "<table>" & tableau & "<BR>" & suite1 & "</TABLE>"
' SYNTHEZE PERSO ******************************************************************************
Set mestr = .getelementsbytagname("TR")
For Z = 0 To 4
Set mesTH = mestr(Z).getelementsbytagname("TH")
For a = 1 To mesTH.Length - 1
lPoint = 8 - (a - 1)
If IsNumeric(mesTH(a).innertext) Then dicosynth(mesTH(a).innertext) = dicosynth(mesTH(a).innertext) + 8 - (a - 1) 'lPoint
Next
Next
synthperso = "<TR><TH> Ma synthèse perso</TH>"
Do
pt = pt + 1: old = 0
For Each elem In dicosynth
If dicosynth(elem) > old Then
cehtml = "<TH>" & elem & "</TH>"
old = dicosynth(elem): items = elem
End If
Next
dicosynth(items) = 0
synthperso = synthperso & "<TH>" & items & "</TH>"
Loop Until pt = dicosynth.Count
synthperso = synthperso & "</TR>" |
Partager