XMLHTTP et Avertissement de sécurité

**cerede2000** · 28/04/2016, 17h52

Ah ! Il me semblait être tomber sur un truc un jour ou il est précisé que pour proxy il fallait forcément utiliset WinHTTP, tant mieux du coup !!

Donc c'est nickel tout fonctionne maintenant

Après il te reste à déterminer si tu veux une usine à gaz pour l'autoconfig proxy ou si tu te contente de la definir manuellement

Au mieux via une constante !

**Oliv-** · 28/04/2016, 18h01

Je vais utiliser la méthode simple le proxy en dur pour le moment !

MERCI

**Marc-L** · 28/04/2016, 18h06

Oliv,

maintenant que tu gères le proxy, tu n'as peut-être plus besoin de gérer la redirection,
l'adresse initiale directement pourrait suffire, à tester …

**cerede2000** · 28/04/2016, 14h25

Essaye sans le .6.0 :

Code :

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

1
2
    Dim pXmlHttp As Object
    Set pXmlHttp = CreateObject("Msxml2.ServerXMLHTTP")

**Marc-L** · 28/04/2016, 14h30

Ou encore avec WinHttp.WinHttpRequest.5.1 …

**Oliv-** · 28/04/2016, 14h32

Pareil
erreur sur le pXmlHttp.send

suis sous W7 (64BIT) OFFICE 2010-32BITS

**cerede2000** · 02/05/2016, 17h11

Heu........
Excuse moi mais ton code avec le Msxml2.XMLHTTP => Go_Traitement_Msxml2XMLHTTP n'est pas bon !
Tu ne suis pas les redirections !
Donc forcément c'est ultra rapide !
Le truc arrive sur la première page ou il n'y a rien à charger et tu t'arrête la.

Et en plus tu ne passe par le proxy, donc le temps est encore réduit.
On compare un peu de l'incomparable là

**Oliv-** · 02/05/2016, 21h59

Salut,

Sauf que j'obtiens bien avec les 3 méthodes le même résultat.

**cerede2000** · 28/04/2016, 18h10

Heu.... Marc-L le problème de redirection est réglé avec les options de WinHTTP
Et tu n'as peut être pas vu un de message ou j'indiquai que l'adresse finale n'est pas intéressante car le but est de chercher avec juste un numéro de SIRET là ou l'adresse finale après redirection contient le nom complet de l'entreprise qu'il n'est pas vraiment facile de déterminer !

**Oliv-** · 29/04/2016, 09h23

Salut,
Oui la nécessité c'était d'obtenir la page finale à partir du SIREN (=société vs SIRET=établissement) en passant le Proxy

et donc sans avertissement, parce que dans certains cas je traite beaucoup de lignes !

Bonne journéeeee

**Oliv-** · 02/05/2016, 17h04

Salut,
J'ai mis en place les changements et je certes je n'ai plus les avertissements mais c'est beaucoup plus LONG

voici les temps pour 20 recherches identiques

WinHttpRequest 20 00:01:08
WinHttpRequest 20 00:00:57

Msxml2ServerXMLHTTP60 20 00:01:02
Msxml2ServerXMLHTTP60 20 00:00:15
Msxml2ServerXMLHTTP60 20 00:01:01
Msxml2ServerXMLHTTP60 20 00:01:14
Msxml2ServerXMLHTTP60 20 00:00:46
Msxml2ServerXMLHTTP60 20 00:02:04
Msxml2ServerXMLHTTP60 20 00:01:10

Msxml2XMLHTTP 20 00:00:14
Msxml2XMLHTTP 20 00:00:10
Msxml2XMLHTTP 20 00:00:23

voici les codes

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
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
Sub Go_Traitement_WinHttpRequest()
'Call ajout_site_de_confiance
    Const HTTPREQUEST_PROXYSETTING_DEFAULT = 0
    Const HTTPREQUEST_PROXYSETTING_PRECONFIG = 0
    Const HTTPREQUEST_PROXYSETTING_DIRECT = 1
    Const HTTPREQUEST_PROXYSETTING_PROXY = 2
 
    sirens = Array(813023868, 813156973, 813157476, 813622552, 813837507, 813986635, 814095113, 814279881, 814406989, 817727571, 818756991, 818993800, 819058124, 819130758, 819132135, 819253956, 886180694, 950516047, 957504061, 962227351)
 
    Dim i, j, k, l, elements, SP As String
    Dim htmlTabElement() As IHTMLElement
    Dim GenericElem As HTMLGenericElement
    Dim MyTags
    Dim MonDiv As HTMLDivElement
    Dim VERIF_siren
 
    ' selection des contacts
    Dim URLSTE, Titre As String, donnée_brut, donnée_propre
 
    '   Set MyXMLHttp = CreateObject("Microsoft.XMLHTTP")
    'Set MyXMLHttp = CreateObject("Msxml2.XMLHTTP")
    Set oRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
    Dim t0 As Double
    t0 = Time
    verrouEvent = True
    For Each contact In sirens
 
        mySIREN = contact
        URL$ = "https://www.ellisphere.fr/entreprise/" & mySIREN
        On Error GoTo suivant
        With oRequest
            .Open "GET", URL, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
            .setProxy HTTPREQUEST_PROXYSETTING_PROXY, "10.15.0.10:80"
            .Option(6) = True    'Pour autoriser la redirection
            .Option(12) = True    'Pour autoriser la redirection HTTPS to HTTP
 
            .send    '"{range:9129370}"
            .WaitForResponse
 
            On Error Resume Next
 
            On Error GoTo 0
 
            If .Status = 200 Then
                SP = .responseText
 
                '                    If InStr(1, SP, "app.entreprise = app.entreprise || {};", vbTextCompare) Then
                '                        'Call EXTRACT_DONNEES(SP)
                '                        Call EXTRACT_DONNEES_JSON_Contacts(SP, contact)
                '                    End If
 
            End If
 
        End With
 
        On Error GoTo 0
suivant:
    Next contact
    Debug.Print "WinHttpRequest" & vbTab & UBound(sirens) & vbTab & CStr(Time - t0)
    MsgBox CStr(Time - t0)
End Sub
 
Sub Go_Traitement_Msxml2XMLHTTP()
 
 
    sirens = Array(813023868, 813156973, 813157476, 813622552, 813837507, 813986635, 814095113, 814279881, 814406989, 817727571, 818756991, 818993800, 819058124, 819130758, 819132135, 819253956, 886180694, 950516047, 957504061, 962227351)
 
    Dim i, j, k, l, elements, SP As String
    Dim htmlTabElement() As IHTMLElement
    Dim GenericElem As HTMLGenericElement
    Dim MyTags
    Dim MonDiv As HTMLDivElement
    Dim VERIF_siren
 
    ' selection des contacts
    Dim URLSTE, Titre As String, donnée_brut, donnée_propre
 
    '   Set MyXMLHttp = CreateObject("Microsoft.XMLHTTP")
    Set MyXMLHttp = CreateObject("Msxml2.XMLHTTP")
    Dim t0 As Double
    t0 = Time
    verrouEvent = True
    For Each contact In sirens
 
        mySIREN = contact
        URL$ = "https://www.ellisphere.fr/entreprise/" & mySIREN
 
 
        With MyXMLHttp
            .Open "get", URL, False
            .setRequestHeader "DNT", "1"
            On Error Resume Next
            .send
            On Error GoTo 0
 
            If .Status = 200 Then
                SP = .responseText
 
 
                '                    If InStr(1, SP, "app.entreprise = app.entreprise || {};", vbTextCompare) Then
                '                        'Call EXTRACT_DONNEES(SP)
                '                        Call EXTRACT_DONNEES_JSON_Contacts(SP, contact)
                '                    End If
 
            End If
 
        End With
 
        On Error GoTo 0
suivant:
    Next contact
    Debug.Print "Msxml2XMLHTTP" & vbTab & UBound(sirens) & vbTab & CStr(Time - t0)
    MsgBox CStr(Time - t0)
End Sub
 
Sub Go_Traitement_Msxml2ServerXMLHTTP60()
 
 
    sirens = Array(813023868, 813156973, 813157476, 813622552, 813837507, 813986635, 814095113, 814279881, 814406989, 817727571, 818756991, 818993800, 819058124, 819130758, 819132135, 819253956, 886180694, 950516047, 957504061, 962227351)
 
    Dim i, j, k, l, elements, SP As String
    Dim htmlTabElement() As IHTMLElement
    Dim GenericElem As HTMLGenericElement
    Dim MyTags
    Dim MonDiv As HTMLDivElement
    Dim VERIF_siren
 
    ' selection des contacts
    Dim URLSTE, Titre As String, donnée_brut, donnée_propre
 
 
    Set MyXMLHttp = CreateObject("Msxml2.ServerXMLHTTP.6.0")
    Dim t0 As Double
    t0 = Time
    verrouEvent = True
    For Each contact In sirens
 
        mySIREN = contact
        URL$ = "https://www.ellisphere.fr/entreprise/" & mySIREN
 
        MyXMLHttp.setProxy 2, "10.15.0.10:80", ""
 
        MyXMLHttp.Open "GET", URL$, False
        MyXMLHttp.send
 
        While MyXMLHttp.Status Like "3##"
            MyXMLHttp.Open "GET", MyXMLHttp.getResponseHeader("Location"), False
            MyXMLHttp.send
        Wend
        SP = MyXMLHttp.responseText
 
 
 
        On Error GoTo 0
suivant:
    Next contact
    Debug.Print "Msxml2ServerXMLHTTP60" & vbTab & UBound(sirens) + 1 & vbTab & CStr(Time - t0)
    MsgBox CStr(Time - t0)
End Sub

**cerede2000** · 28/04/2016, 14h36

Ha mince !
Je suis sous W10 x64/O2k16 x32 pas de soucis et je ne l'ai pas encore rencontré

Faut qu'on trouve il n'y a pas de raisons !

**cerede2000** · 28/04/2016, 14h42

Ben en fait la mienne fais comme un webbrowser lambda ou un conducteur sur l'autoroute

On lui dit : cette route est fermé, il y a une déviation, suivez donc les panneaux

Edit : C'est vraiment bizarre @Oliv- je viens de tester sur un XP/O2k3 et ça fonctionne aussi !!

**Oliv-** · 28/04/2016, 15h11

En fait par défaut chez nous, les menus de sécurité de IE sont masqués.

Si je les réactive, et que je fais "réinitialisé" dans la ZONE INTERNET, je n'ai plus ce message.

**cerede2000** · 28/04/2016, 15h14

Heu attends parce que là on est partie dans deux direction.
Il y a le message d'avertissement de sécurité qui est une chose et tout a l'heure tu as parlé d’erreur automation.

Du coup avec Msxml2.ServerXMLHTTP ou WinHttp.WinHttpRequest.5.1 ça donne quoi ?
Avertissement de sécurité ou automation ?

Si tu réinit la zone de sécurité IE tu n'as plus l'avertissement ok.
Et l'automation ?

Edit : En passant @Marc-L, on ne l'utilise pas souvent mais le WinHttp.WinHttpRequest permet la redirection directement via ses options !
Like this

:

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub test()
    Dim pXmlHttp As Object
    Set pXmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    pXmlHttp.Option(6) = True 'Pour autoriser la redirection
    pXmlHttp.Option(12) = True 'Pour autoriser la redirection HTTPS to HTTP
    pXmlHttp.Open "GET", "https://www.ellisphere.fr/entreprise/327733184", False
    pXmlHttp.send
 
    Debug.Print pXmlHttp.ResponseText
End Sub

Les différentes options : https://msdn.microsoft.com/fr-fr/lib...(v=vs.85).aspx
Plutôt pratique

**Marc-L** · 28/04/2016, 15h39

Oui je connais mais t'as bien fait de l'indiquer !
Par contre l'autre c'était une commande de redirection directement dans le send …

En passant, si vous tenez réellement à créer une variable objet, ne pas oublier alors de la libérer en fin de procédure !

Set VariableObjet = Nothing …

**Oliv-** · 28/04/2016, 15h41

Avec les 2 "WinHttp.WinHttpRequest.5.1" et "Msxml2.ServerXMLHTTP.6.0"
j'ai une erreur automation.

Est ce que ca peut venir du fait que j'ai un PROXY ?

je pense que oui parce que avec cette syntaxe, il me parle plus polie

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
30
31
32
Sub DoSomeJob()
Const sUrl As String = "https://www.ellisphere.fr/entreprise/327733184"
 
Dim oRequest As Object 'WinHttp.WinHttpRequest
Dim sResult As String
 
On Error GoTo Err_DoSomeJob
 
Set oRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
With oRequest
    .Open "GET", sUrl, False
    .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
    .send '"{range:9129370}"
    .WaitForResponse
    sResult = .ResponseText
    Debug.Print sResult
    sResult = oRequest.Status
    Debug.Print sResult
End With
 
 
 
Exit_DoSomeJob:
    On Error Resume Next
    Set oRequest = Nothing
    Exit Sub
 
Err_DoSomeJob:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_DoSomeJob
 
End Sub

--->impossible d'établir une connexion avec le serveur

XMLHTTP et Avertissement de sécurité [Toutes versions]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager