Richiesta HTTP con Salvataggio Risposta su File

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

'**************************************************************

 

Pag: <<       >   >>