Librairie pour Internet Explorer - navigator @dependsOn multiSplit (LIB_STRING) and trier (LIB_LIST)

LIB_IE.vbs

Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)

Public Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Sub navigator(ByVal myNav As Collection)
    Dim s As String
    ' on navigue
    Dim ie As SHDocVw.InternetExplorer
    Set ie = Nothing
    
    For Each c In myNav
        wait_load = False
        If UBound(c) > 0 Then
            If c(0) = "goto" Then
                s = c(1)
                Set ie = IE7Navigate(s, ie)
                wait_load = True
            ElseIf c(0) = "input" And UBound(c) = 2 Then
                Set el = getHTMLElement(ie.Document, c(1))
                ' si c(2) commence par "@", c'est une fonction
                If Left(c(2), 1) = "@" Then
                    myFun = Right(c(2), Len(c(2)) - 1)
                    myVal = Application.Run(myFun)
                    el.Value = myVal
                Else
                    el.Value = c(2)
                End If
            ElseIf c(0) = "click" Then
                Set el = getHTMLElement(ie.Document, c(1))
                el.Click
                wait_load = True
            ElseIf c(0) = "dblclick" Then
                Set el = getHTMLElement(ie.Document, c(1))
                el.Click
                el.FireEvent "ondblclick", 1, 2
                wait_load = True
            ElseIf c(0) = "download" And UBound(c) = 2 Then
                If LCase(Left(c(1), 4)) <> "http" Then
                    Set el = getHTMLElement(ie.Document, c(1))
                    s = el.href
                Else
                    s = c(1)
                End If
                
                lRet = URLDownloadToFile(0&, s, c(2), 0&, 0)
            Else
                Debug.Print "Incorrect command " & Join(c, ";")
            End If
        Else
            Debug.Print "Incorrect command " & Join(c, ";")
        End If
        
        ' on attend éventuellement le chargement de la page
        If wait_load Then
            Do Until (ie.ReadyState = READYSTATE_COMPLETE And ie.Document.ReadyState = "complete")
                Sleep 10
                DoEvents
            Loop
            Sleep 50
        End If
    Next c
    
    ' on ferme ie
    If Not ie Is Nothing Then
      ie.Quit
    End If
End Sub

Function getHTMLElement(ByRef html, ByVal chemin, Optional ByVal ind As Integer = 1)
    Set path_obj = parseHTMLPath(chemin)
    Set myEl = Nothing
    For Each el In path_obj
        ' SELECT BY ID
        If el("id") <> "" Then
            Set myEl = html.getElementById(el("id"))
            GoTo fin
        ' SELECT BY TAGNAME + CLASS
        ElseIf el("type") <> "" Then
            For Each el2 In html.getElementsByTagName(el("type"))
                If checkCriteres(el2, el) Then
                    Set myEl = el2
                    GoTo fin
                End If
            Next el2
        End If
    Next el
fin:
    If ind = path_obj.Count Or myEl Is Nothing Then
        Set getHTMLElement = myEl
    Else
        Set getHTMLElement = getHTMLElement(myEl, chemin, ind + 1)
    End If
End Function

' vérifie que l'élément html el vérifie les criteres définis dans obj
Function checkCriteres(ByRef el, ByVal obj As Collection) As Boolean
    b = obj("id") = "" Or el.ID = obj("id")
    b = b And (obj("class") = "" Or el.className = obj("class"))
    b = b And (obj("type") = "" Or LCase(el.nodeName) = LCase(obj("type")))
    If collKeyExists(obj, "href") Then b = b And el.href = obj("href")
    checkCriteres = b
End Function

' chemin = "a@href(http://r.orange.fr/r/Owebmail_inbox_v2?ref=HPC_url_operateur_mail_accueil_authentifie)/input.class1/#machin/truc"
Function parseHTMLPath(ByVal chemin As String) As Collection
    Set arr = splitHTMLPath(chemin)
    Set elements = New Collection
    For i = 1 To arr.Count
        If arr(i) <> "" Then
            Set obj = getHTMLObj(arr(i))
            elements.Add obj
        End If
    Next i
    Set parseHTMLPath = elements
End Function

Function getHTMLObj(ByVal tag_str As String) As Collection
    tagName = ""
    className = ""
    myID = ""
    href = ""
    Set newcoll = New Collection
    arr_sep = Array("#", "@", "aaaaa", ".", "tt")
    ' on get les positions
    Dim pos As Variant
    ReDim pos(UBound(arr_sep))
    For i = 0 To UBound(arr_sep)
        pos(i) = InStr(tag_str, arr_sep(i))
    Next i
    ' on trie
    ordre = trier(arr_sep, pos)
    ' on multi-split
    Set parts = splitHTMLPath(tag_str, Join(arr_sep, ","))
    ' on calcule l'offset
    myoffset = countOccur(pos, "0")
    
    ' on gere le parsing
    tagName = parts(1)
    For i = 2 To parts.Count
        curr_sep = ordre(myoffset + i - 2)
        Select Case curr_sep
            Case "#":
                myID = parts(i)
            Case ".":
                className = parts(i)
            Case "@":
                n = InStr(parts(i), "(")
                myAttr = Left(parts(i), n - 1)
                myVal = Mid(parts(i), n + 1, Len(parts(i)) - n - 1)
                If myAttr = "href" Then
                    newcoll.Add myVal, myAttr
                End If
        End Select
    Next i
    
    newcoll.Add tagName, "type"
    newcoll.Add className, "class"
    newcoll.Add myID, "id"
    Set getHTMLObj = newcoll
End Function

' chemin = "aaaa(c/o/c/o/)bb/aaa/ddd(c/o(z/s/z/s)/c)/aaaa"
Function splitHTMLPath(ByVal chemin As String, Optional ByVal sep As String = "/") As Collection
    Set splitHTMLPath = New Collection
    split_compt = 0
    curr_el = ""
    For i = 1 To Len(chemin)
        If Mid(chemin, i, 1) = "(" Then
            split_compt = split_compt + 1
            curr_el = curr_el & Mid(chemin, i, 1)
        ElseIf Mid(chemin, i, 1) = ")" Then
            split_compt = split_compt - 1
            curr_el = curr_el & Mid(chemin, i, 1)
        ElseIf InStr("," & sep & ",", "," & Mid(chemin, i, 1) & ",") > 0 And split_compt = 0 Then
            splitHTMLPath.Add curr_el
            curr_el = ""
        Else
            curr_el = curr_el & Mid(chemin, i, 1)
        End If
    Next i
    If curr_el <> "" Then splitHTMLPath.Add curr_el
End Function

Public Function IE7Navigate(strURL As String, oldIE As SHDocVw.InternetExplorer, Optional bFireAndForget As Boolean = False) As SHDocVw.InternetExplorer
    Dim theSHD As SHDocVw.ShellWindows
    Dim IE7 As SHDocVw.InternetExplorer
    Dim i As Long
    
    If oldIE Is Nothing Then
        Set theSHD = New SHDocVw.ShellWindows
        For i = 0 To theSHD.Count - 1
            Set IE7 = theSHD.Item(i)
            Sleep 10
            DoEvents
            If Not IE7 Is Nothing Then
                If IE7.LocationURL = strURL Then IE7.Quit
            End If
        Next
        Set IE7 = New SHDocVw.InternetExplorer
    Else
        Set IE7 = oldIE
    End If
    
    IE7.Navigate strURL
    Do
        Set theSHD = New SHDocVw.ShellWindows
        For i = theSHD.Count - 1 To 0 Step -1
            Set IE7 = theSHD.Item(i)
            Sleep 10
            DoEvents
            If Not IE7 Is Nothing Then
                If bFireAndForget Then Exit Do
                If IE7.LocationURL = strURL Then Exit Do
            End If
        Next
    Loop
    IE7.Visible = True
    Do Until IE7.ReadyState = READYSTATE_COMPLETE
        Sleep 10
        DoEvents
        If bFireAndForget Then Exit Do
        
    Loop
    Do Until IE7.Document.ReadyState = "complete"
        Sleep 10
        DoEvents
    Loop
    Set IE7Navigate = IE7
      
End Function

' ==============================================================================
'                               UNIT TESTS
' ==============================================================================

Sub unittest_nav_ogd()
    Dim myNav As New Collection
    myNav.Add Array("goto", "https://reportingogd.edf.fr/reporting/")
    myNav.Add Array("input", "#login_field", "@getSesameUser")
    myNav.Add Array("input", "#pwd_field", "@getSesamePsswd")
    myNav.Add Array("click", "input.btn_medium")
    myNav.Add Array("download", "https://reportingogd.edf.fr/reporting/exporterRapport.action?identifiant=166&jour=04/06/2015", "C:\Users\CB141B4N\Downloads\truc.xls")
    
    navigator myNav
End Sub


Sub unittest_parseHTMLPath()
    chemin = "input.class1/#machin/truc"
    chemin = "a@href(http://r.orange.fr/r/Owebmail_inbox_v2?ref=HPC_url_operateur_mail_accueil_authentifie)/input.class1/#machin/truc"
    Set res = parseHTMLPath(chemin)
End Sub

Sub unittest_splitHTMLPath()
    chemin = "aaaa(c/o@c.o/)bb/aaa.ddd(c/o(z/s/z/s)/c)@aaaa"
    Set c = splitHTMLPath(chemin, "/,@")
End Sub

Sub unittest_multiSplit()
    arr = multiSplit("truc@href(riri).machin#toto", Array("@", ".", "#"))
End Sub

Sub unittest_getHTMLObj()
    Set c = getHTMLObj("truc@href(riri).machin#toto")
End Sub

Sub unittest_trier()
    arr = Array("a", "b", "c", "d")
    critere = Array(34, 5, 0, 28)
    res = trier(arr, critere)
End Sub