Capita sempre più spesso di dover integrare un'applicazione con dati provenienti da fonti esterne, altre applicazioni.
Per far fronte a questa situazione una delle soluzioni ottimali è quella di poter effettuare una richiesta via HTTP e gestirne la risposta che può essere in formati differenti come XML o Json. In questo esempio supponiamo una risposta in formato XML.
Questo il Codice:
'***********************************************************
' INIZIO MAIN
'***********************************************************
'Dichiarazione Variabile
Dim bolRispostaDaChiamataHTTP_ScritturaXML 'variabile booleana
bolRispostaDaChiamataHTTP_ScritturaXML = eseguiRichiestaHTTP_ScritturaFileXML("GET", _
"http://URLDaRichiamare/esempio?par1=val1&par2=val2, _
false, _
"user", _
"password", _
"c:\temp\mioXMLdiProva.xml")
if bolRispostaDaChiamataHTTP_ScritturaXML then
msgbox "File Creato"
else
msgbox "Errore"
end if
'***********************************************************
' FINE MAIN
'***********************************************************
'**************************************************************
'FUNZIONI
'**************************************************************
'Funzione di chiamata che contiene i seguenti parametri:
' - metodo: GET [POST/PUT/HEAD/DELETE/CONNECT/OPTIONS] --- STRINGA
' - indirizzo: URL da richiamare --- STRINGA
' - chiamataAsincrona: True/False --- BOOLEANO
' - utente: user con la quale autenticarsi --- STRINGA (solo se necessaria)
' - password: password dell'utente --- STRINGA (solo se necessaria)
'Ritorna la risposta in formato testo della chiamata HTTP
'*****************************************************************
Function eseguiRichiestaHTTP(metodo, indirizzo, chiamataAsincrona, utente, password)
Dim objSrvHTTP, res
'res è la variabile risultato che conterrà la risposta della chiamata HTTP
res = ""
'creazione oggetto per inviare richiesta HTTP
set objSrvHTTP = CreateObject("Msxml2.ServerXMLHTTP.6.0")
'effettuo la open (settaggio parametri) a cui passo:
'il metodo di invio richiesta,
'l'URL,
'l'indicazione se la chiamata è sincrona o no
'gli eventuali user e password
if Not(utente="") then
objSrvHTTP.open metodo, indirizzo, chiamataAsincrona, utente, password
else
objSrvHTTP.open metodo, indirizzo, chiamataAsincrona
end if
'invio richiesta HTTP
objSrvHTTP.send
'Controllo che la chiamata sia andata a buon fine
if objSrvHTTP.status = 200 then
'Carico nella variabile res il ritorno della chiamata in formato testo (=stringa)
res = objSrvHTTP.responseText
else
res = "ERROR"
msgbox "Errore nella chiamata HTTP per " & objSrvHTTP.statusText,vbCritical + vbSystemModal,"Errore nella chiamata HTTP"
end if
'distruzione dell'oggetto objSrvHTTP
set objSrvHTTP = nothing
'ritorno del risultato
eseguiRichiestaHTTP = res
End Function
'Esecuzione RichiestaHTTP e scrittura XML (vale solo per GET con ritorno di XML)
'La Funzione ritorna un valore booleano
Function eseguiRichiestaHTTP_ScritturaFileXML(metodo, indirizzo, chiamataAsincrona, utente, password, fileName)
Dim strContenuto, res, objXML
res = false
strContenuto = eseguiRichiestaHTTP(metodo, indirizzo, chiamataAsincrona, utente, password)
if strContenuto="" then
eseguiRichiestaHTTP_ScritturaFileXML = res
Exit Function
end if
'MS XML DOM
set objXMLDoc=CreateObject("Msxml2.DOMDocument")
objXMLDoc.async = false
'caricamento da risposta xml
objXMLDoc.loadXML(strContenuto)
on error resume next
err.clear
objXMLDoc.save(fileName)
if err.number = 0 then
res = true
else
msgbox "Attenzione! Scrittura del file " & fileName & " non riuscita per " & err.description & "!!!", vbCritical + vbSystemModal, "Errore Scrittura File XML"
end if
set objXMLDoc = nothing
eseguiRichiestaHTTP_ScritturaFileXML = res
End Function
'**************************************************************