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
|
Public Function invoquerMachin(ByVal p_NumeroTelephone_s As String, _
ByVal p_CodeOffre_s As String, _
ByRef p_reponseServiceWeb_o As Object) _
As String
Dim ServerXMLHTTP_o As Object
Dim Base64_o As Object
Dim SoapRequest_s As String
Dim AsynchroneMode_b As Boolean
On Error GoTo Erreur
a_Trace_o.tracer C_TRACEFONCTION, "DEBUT --- "
AsynchroneMode_b = False
'Creation de la requete SOAP
SoapRequest_s = createSoapRequest(p_NumeroTelephone_s, p_CodeOffre_s, a_InfoClient_s, a_Version_s)
a_Trace_o.tracer C_TRACEDEBUG, "SOAP Request = " & SoapRequest_s
'Connection au service web
Set ServerXMLHTTP_o = CreateObject(C_SERVERXMLHTTP)
ServerXMLHTTP_o.Open "POST", a_URLServiceWeb_s, AsynchroneMode_b
'Mise en place des Headers pour le type du document
ServerXMLHTTP_o.setRequestHeader "Content-Type", "text/xml"
ServerXMLHTTP_o.setRequestHeader "charset", "utf-8"
'A cause d'un bug reference de ServerXMLHTTP, il faut definir deux fois le cookie :((
ServerXMLHTTP_o.setRequestHeader "Cookie", a_SessionID_s
ServerXMLHTTP_o.setRequestHeader "Cookie", a_SessionID_s
'Encodage BASE64 du login:password pour le basic authentification de SSL
Set Base64_o = New Base64
Dim Authorization_s As String
Authorization_s = "Basic " & Base64_o.Encode(a_LoginSSL_s & ":" & a_PasswordSSL_s)
ServerXMLHTTP_o.setRequestHeader "Authorization", Authorization_s
Set Base64_o = Nothing
ServerXMLHTTP_o.setRequestHeader "SOAPAction", a_URNServiceWeb_s
'Positionnement sur le proxy pour la connexion (s'il y a lieu d'utiliser un proxy biensur)
If a_ProxyHost_s <> "" Then
If a_ProxyPort_s <> "" Then
ServerXMLHTTP_o.setProxy C_SXH_PROXY_SET_PROXY, a_ProxyHost_s & ":" & a_ProxyPort_s
Else
ServerXMLHTTP_o.setProxy C_SXH_PROXY_SET_PROXY, a_ProxyHost_s
End If
End If
If a_ProxyLogin_s <> "" Then
ServerXMLHTTP_o.setProxyCredentials a_ProxyLogin_s, a_ProxyPassword_s
End If
'Envoi de la requete SOAP au service WEB
a_Trace_o.tracer C_TRACEDEBUG, "Avant le send " & Now
ServerXMLHTTP_o.send (SoapRequest_s)
a_Trace_o.tracer C_TRACEDEBUG, "Apres le send 1 " & Now
'Traitement de la reponse
'Y a t-il une erreur HTTP ?
a_Trace_o.tracer C_TRACEDEBUG, "TEST"
a_Trace_o.tracer C_TRACEDEBUG, ServerXMLHTTP_o.Status
If ServerXMLHTTP_o.Status <> 200 Then
invoquerMachin = "Erreur HTTP (" & ServerXMLHTTP_o.Status & ")"
a_Trace_o.tracer C_TRACEERREUR, "Erreur HTTP (" & ServerXMLHTTP_o.Status & ")"
a_Trace_o.tracer C_TRACEDEBUG, "Response Text(" & ServerXMLHTTP_o.responseText & ")"
Set p_reponseServiceWeb_o = Nothing
Else
a_Trace_o.tracer C_TRACEDEBUG, "Cookie = " & a_SessionID_s
'Pour le moment un bug empeche d'utiliser les sessions,
'alors on utilise toujours le Cookie SMCHALLENGE=YES et pas SMSESSION=...
'If a_SessionID_s = C_SMCHALLENGE Then
' a_SessionID_s = getHeader(ServerXMLHTTP_o, "Set-cookie", "SMSESSION")
' a_Trace_o.tracer C_TRACEDEBUG, "Set-Cookie = " & a_SessionID_s
'End If
Set p_reponseServiceWeb_o = ServerXMLHTTP_o.responseXML
a_Trace_o.tracer C_TRACEDEBUG, "SOAP Response = " & p_reponseServiceWeb_o.xml
invoquerMachin = CStr(C_OK)
End If
GoTo Fin
Erreur:
If Err.Number <> 0 Then
invoquerMachin = "Erreur VB ( " & Err.Description & ")"
a_Trace_o.tracer C_TRACEERREUR, "Erreur VB (" & Err.Description & ")"
Else
invoquerMachin = "Erreur HTTP (Impossible de se connecter à la DIVOP)"
a_Trace_o.tracer C_TRACEERREUR, "Erreur HTTP (Impossible de se connecter à la DIVOP)"
End If
Set p_reponseServiceWeb_o = Nothing
Fin:
Set Base64_o = Nothing
Set ServerXMLHTTP_o = Nothing
a_Trace_o.tracer C_TRACEFONCTION, "FIN --- "
End Function |
