Lire le code source à partir d'une page Web et en extraire des données par RegEx

**hackoofr** · 16/10/2017, 13h29

Je veux lire un code source à partir d'une page Web et en extraire des données.
J'ai utilisé ici dans mon exemple une RegEx pour extraire les données, mais je n'ai pas eu toutes les données, peut-être cela est dû à l'unicode ou le modèle ne correspond pas?
Quand je teste ce modèle avec RegExBuddy, cela correspond, mais avec vbscript j'obtiens rien ?
Merci de votre aide !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
sSrcUrl = "https://fr.giveawayoftheday.com/"
Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
bGetAsAsync = False
oHTTP.open "GET", sSrcUrl, bGetAsAsync
oHTTP.send
If oHTTP.status <> 200 Then
WScript.Echo "unexpected status = " & oHTTP.status & vbCrLf & oHTTP.statusText
WScript.Quit
End If
Data = oHTTP.responseText
wscript.echo Extract(Data)
'****************************************************************
Function Extract(Data)
    Dim oRE,oMatches,Match,Line
    set oRE = New RegExp
    oRE.IgnoreCase = True
    oRE.Global = True
    oRE.MultiLine = True
    oRE.Pattern = "<div class=""giveaway_wrap cf"">(\r.*\n.*){17}</div>"
    set oMatches = oRE.Execute(Data)
    If not isEmpty(oMatches) then
        For Each Match in oMatches   
            Line = Match.Value
            Extract = Line
        Next
    End if 
End Function
'*****************************************************************

Donc, le résultat que j'attends est:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
<div class="giveaway_wrap cf">
                    <div class="giveaway_img">
                        <img src="https://giveawayoftheday.com/wp-content/uploads/2017/10/82810932353ab590bf475ea3980f3038.png" alt="Excel Url Validator 1.0 Giveaway" />
                        <div class="giveaway_label">
                            <a href="https://fr.giveawayoftheday.com/excel-url-validator-1-0/" class="label_link"></a>
                            <div class="old_price">$40.00</div>
                            <div class="free">
                                <span class="big">GRATUIT</span> aujourd’hui
                            </div>
                        </div>
                    </div>
                    <div class="over">
                        <div class="giveaway_title">
                            <a href="https://fr.giveawayoftheday.com/excel-url-validator-1-0/">Excel Url Validator 1.0</a>
                            <div class="giveaway_date">16 octobre 2017</div>
                        </div>
                        <div class="giveaway_descr">Excel Url Validator trouve des liens rompus dans les feuilles de calcul Excel.</div>
                    </div>

**omen999** · 16/10/2017, 15h15

bonjour,

(très) vite fait, je soupçonne un problème de syntaxe spécifique au RegExp de Microsoft
la syntaxe {n} ne s'applique a priori qu'au caractère unique précédant l'accolade ouvrante
et non au groupe contenu dans les parenthèses capturantes
à tester...

**hackoofr** · 16/10/2017, 18h55

Merci pour la remarque, mais je séche encore

**I'm_HERE** · 18/10/2017, 08h20

Salut,

essaye avec ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
sSrcUrl = "https://fr.giveawayoftheday.com/"
Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
bGetAsAsync = False
oHTTP.open "GET", sSrcUrl, bGetAsAsync
oHTTP.send
If oHTTP.status <> 200 Then
WScript.Echo "unexpected status = " & oHTTP.status & vbCrLf & oHTTP.statusText
WScript.Quit
End If
Data = oHTTP.responseText
wscript.echo Extract(Data)
'****************************************************************
Function Extract(Data)
    Dim oRE,oMatches,Match,Line
    set oRE = New RegExp
    oRE.IgnoreCase = True
    oRE.Global = True
    oRE.MultiLine = TRUE
    oRE.Pattern = "<div class=""giveaway_wrap cf"">(?:(?!""giveaway_counter first"">)[\s\S])*</div>"
    set oMatches = oRE.Execute(Data)
    If not isEmpty(oMatches) then
        For Each Match in oMatches   
            Line = Match.Value
            Extract = Line
        Next
    End if 
End Function
'*****************************************************************

**hackoofr** · 18/10/2017, 15h19

et

pour votre réponse qui marche très bien

Pouvez-vous juste m'expliquer pourquoi dans mon pattern ne marche pas en vbscript, mais ça marche bien sur RegExBuddy ? et si c'est possible m'expliquer pourquoi vous avez choisi ce pattern et de le me commenter un peu

**omen999** · 18/10/2017, 15h27

Pouvez-vous juste m'expliquer pourquoi dans mon pattern ne marche pas en vbscript

son pattern contient des PCRE Perl Compatible Regular Expressions comme ! ou : qui ne sont pas
supportées par le regexp de microsoft

**tsuji** · 18/10/2017, 17h18

[0] Je pense le groupement non-capturé (?:...) et le lookahead negatif (?!...) (et aussi le lookahead positif, d'ailleurs) sont bien supportés dans 5.6/5.7. C'est les lookbehind's qui ne sont pas supportés encore, et très possiblement pour toujours, il me semble, pour vbs.

[1] Je suis pour, dans tous les cas raisonable, simple ou complexe, la utilisation de regex. Mais dans le domaine de xml et de html, voire xhtml, et plus précisément pour ce genre de fonctionalité d'extraire des éléments en utilisant regexp, je ne suis pas trop impressionné, surtout quand ça donne une impression fausse parce que un document xml et une page html, ça a une grande liberté dans le scriptage... si un vbs ne se fait reflecter ce genre de fluidité, il rend le script trop fragile voire insupportable. Donc, par exemple, "<div class=""giveaway_wrap cf"">(\r.*\n.*){17}</div>" avec la rigidité de {17}, div+une seul espace+class... donnent une impression très inquietant. Et \r, aussi, il dépend trop le comportement du moteur au coté serveur, qui est parfois nomalisé par éliminer le \r !!!

[2] Comme vbs est pour longtemps malheureusement déjà délaissé par ms et qu'il n'est pas dans le domaine public, le support nécessaire communautaire s'évanouit: c'est dommage ! Mais on a des problèmes à résoudre au jour le jour malgré tout. Pour ce problème, je propose retomber sur internetexplorer.application malgré la lourdeur, mais, pour analyser une page html, on ne peut pas appeler à msxml2.domdocument et non plus le module utilisé ici déjà MSXML2.ServerXMLHTTP --- sinon, le responseXML serait un objet le plus approprié de travailler avec.

Code vbs :

Sélectionner tout - Visualiser dans une fenêtre à part

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
function extract2(data)
    dim sclass, oie, odoc, cdiv, i, n, odiv
    sclass="giveaway_wrap cf"
 
    set oie=createobject("InternetExplorer.Application")
    with oie
        .navigate "about:blank"
        do while .readystate<>4 : wscript.sleep 100 : loop
        .document.body.innerHTML=data
        set odoc=.document.DocumentElement
        set cdiv=odoc.getElementsByTagName("div")
    end with
 
    n=cdiv.length-1
    extract2=""
 
    if n<>0 then
        for i=0 to n
            set odiv=cdiv.item(i)
            if odiv.classname=sclass then
                extract2=extract2 & vbcrlf & odiv.outerhtml
            end if
            set odiv=nothing
        next
    end if
 
    set cdiv=nothing
    set odoc=nothing
    oie.quit
    set oie=nothing
 
end function

On voit que le texte retourné a quelques choses changées par rapport au original par le moteur, par exemple, div devient DIV etc... (une modélisation de IE, bonne ou mauvaise !) mais, le message, les infos génériques sont là, ce qui est essentiel, et le résultat est plus robust.

[3] Mais, comme on est forcé de utiliser InternetExplorer.Application finalement, on peut se demander pourquoi pas l'utiliser dès le début à la plus de MSXML2.ServerXMLHTTP ? Oui, c'est peut-être plus adapté pour ce genre de problème de html (mal-formé au sens de xml), avec

Code vbs :

Sélectionner tout - Visualiser dans une fenêtre à part

oie.navigate sSrcUrl

... une suggestion simplement.

**Marc-L** · 18/10/2017, 18h38

Bonjour,

comme le post précédent mais sans IE :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", "https://fr.giveawayoftheday.com/", False
        .setRequestHeader "DNT", "1"
         On Error Resume Next
        .send
         If Err.Number = 0 Then If .Status = 200 Then T = .responseText
         On Error GoTo 0
    End With
If T = "" Then
    WScript.Echo "Erreur !"
Else
    With CreateObject("htmlfile")
            .write T
        For Each Obj In .getElementsByTagName("DIV")
              If Obj.className = "giveaway_wrap cf" Then
                WScript.Echo Obj.outerHTML
                Exit For
              End If
        Next
    End With
End If

___________________________________________________________________________________________________________
Je suis Paris, Mogadicio, Barcelone, London, Manchester, Egypte, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

**omen999** · 19/10/2017, 11h31

ah l'objet "htmlfile"...

pas mieux bravo

**I'm_HERE** · 20/10/2017, 08h18

salut,

Envoyé par hackoofr

Pouvez-vous juste m'expliquer pourquoi dans mon pattern ne marche pas en vbscript,

j'ai pas creuser la question mais ton code à quelques problème (\r.*\n.*){17} ceci peux matcher \r\ntext1\r\n mais aussi \rtext1\ntext2 vaux mieux utiliser \r?\ntext à place pour etre compatible avec presque tous les retours à la ligne

maintenant pourquoi ceci à marcher sur regexbuddy et non pas sur vbscript...je ne sais pas il faut creusé un petit peu l'affaire, peux etre que c'est une optimisation sur regxbuddy

Envoyé par hackoofr

et si c'est possible m'expliquer pourquoi vous avez choisi ce pattern et de le me commenter un peu

ton pattern est basé sur la prayer-parsing est puisque qu'on travaille avec du html il faut atre plus strict que possible...la signification du pattern

**hackoofr** · 29/10/2017, 17h20

Code mis à jour pour faire apparaître un fichier HTA montrant le cadeau du jour

GiveAwayOfTheDay.vbs

Code Vbscript :

Sélectionner tout - Visualiser dans une fenêtre à part

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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
Option Explicit
Dim URL,fso,ws,LogFile,sSrcUrl,oHTTP,bGetAsAsync,HTA,Data
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("Wscript.Shell")
LogFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "hta"
if fso.FileExists(LogFile) Then 
    fso.DeleteFile LogFile
end If
 
If IsInternetConnected = True Then
    If Lang = True Then
        sSrcUrl = "https://fr.giveawayoftheday.com/"
    Else
        sSrcUrl = "https://www.giveawayoftheday.com/"
    End if
End If
 
Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
bGetAsAsync = False
oHTTP.open "GET", sSrcUrl, bGetAsAsync
oHTTP.send
If oHTTP.status <> 200 Then
WScript.Echo "unexpected status = " & oHTTP.status & vbCrLf & oHTTP.statusText
WScript.Quit
End If
Data = oHTTP.responseText
HTA = "<html>" & vbCrLf &_
"<title>Giveaway of the day by Hackoo</title>" & vbCrLf &_
"<head>" & vbCrLf &_
"<HTA:APPLICATION" & vbCrLf &_
  "APPLICATIONNAME=""GiveAway of the Day""" & vbCrLf &_
  "Icon=DxDiag.exe" & vbCrLf &_
  "BORDER=""thin""" & vbCrLf &_
  "MAXIMIZEBUTTON=""no""" & vbCrLf &_
  "MINIMIZEBUTTON=""no""" & vbCrLf &_
  "SCROLL=""no""" & vbCrLf &_
  "SINGLEINSTANCE=""yes""" & vbCrLf &_
  "CONTEXTMENU=""no""" & vbCrLf &_
  "SELECTION=""no""/>" & vbCrLf &_
"<SCRIPT language=""VBScript"">" & vbCrLf &_
"Sub Window_OnLoad" & vbCrLf &_
    "window.resizeTo 450,380" & vbCrLf &_
    "WindowLeft = (window.screen.availWidth - 450)" & vbCrLf &_  
    "WindowTop  = (window.screen.availHeight - 380)" & vbCrLf &_
    "window.moveTo WindowLeft, WindowTop" & vbCrLf &_
"end sub" & vbCrLf &_
"</script>" & vbCrLf &_
"</head>" & vbCrLf &_
"<center>" & vbCrLf &_
"<meta http-equiv=""Content-Type"" content=""text/html; charset=UTF-8"" />" & vbCrLf &_
"<meta http-equiv=""X-UA-Compatible"" content=""IE=edge"">" & vbCrLf &_
"<link rel=""stylesheet"" href=""https://www.giveawayoftheday.com/css/main.css"" />"
WriteLog HTA,LogFile
WriteLog Extract(Data),LogFile
WriteLog "</html>",LogFile
ws.run LogFile
'****************************************************************
Function Extract(Data)
    Dim oRE,oMatches,Match,Line
    set oRE = New RegExp
    oRE.IgnoreCase = True
    oRE.Global = True
    oRE.MultiLine = True
    oRE.Pattern = "<div class=""giveaway_wrap cf"">(?:(?!""giveaway_counter first"">)[\s\S])*</div>"
    set oMatches = oRE.Execute(Data)
    If not isEmpty(oMatches) then
        For Each Match in oMatches   
            Line = Match.Value
            Extract = Line
        Next
    End if 
End Function
'*****************************************************************
Sub WriteLog(strText,LogFile)
    Dim fs,ts 
    Const ForAppending = 8
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.OpenTextFile(LogFile,ForAppending,True,-1)
    ts.WriteLine strText
    ts.Close
End Sub
'*****************************************************************
Function Lang()
Dim sComputer,oWMI,colOperatingSystems,oOS,iOSLang
    sComputer = "."
    Set oWMI = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" _
        & sComputer _
        & "\root\cimv2")
Set colOperatingSystems = oWMI.ExecQuery _
        ("Select * from Win32_OperatingSystem")
For Each oOS in colOperatingSystems
    iOSLang = oOS.OSLanguage
Next
If (iOSLang = 1036) Then
    Lang = True
Else
    Lang = False
End If
End Function
'*****************************************************************
Function IsInternetConnected()
Dim MyLoop,strComputer,objPing,objStatus
IsInternetConnected = False
MyLoop = True
While MyLoop = True
    strComputer = "smtp.gmail.com"
    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
    ("select * from Win32_PingStatus where address = '" & strComputer & "'")
    For Each objStatus in objPing
        If objStatus.Statuscode = 0 Then
            MyLoop = False
            IsInternetConnected = True
            Exit Function
        End If
    Next
    MsgBox "Check your internet connection !",vbExclamation,"Check your internet connection !"
    Pause(10) 'To sleep for 10 secondes
Wend
End Function
'******************************************************************
 Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
 End Sub
'******************************************************************

Lire le code source à partir d'une page Web et en extraire des données par RegEx

VBScript

Discussions similaires

Partager

Partager