How to read XML web service in VB6?

1

I've got several examples on the web that worked, but I need to get the values from this file that follows the link below.

  

link

How would I do this with VB6 ?

    
asked by anonymous 22.09.2017 / 17:25

1 answer

0

You can use XMLHTTPRequest , which works very similar to and to parse the XML can use:

Set doc = CreateObject("MSXML2.DOMDocument")
doc.loadXML(xhr.responseText)

And Xpath can be useful for selecting the required nodes:

Set nodes = doc.SelectNodes("//IPAddress")

A "synchronous" example:

Dim xhr, method, url, contents, formatcontent, doc

Set xhr = CreateObject("MSXML2.XMLHTTP")

method = "GET" 'Escolhe o método HTTP de envio
url = "https://ws.printwayy.com/api/Printer?api_token=1F61D333-CCA5-423A-A764-F8577119A9FE&company_token=&serialNumbers=AK18054352&initialDate=&endDate=" 'url da API
contents = "" 'conteudo
formatcontent = "application/json" 'Se a API usar outro formato basta alterar aqui

xhr.Open method, url, False

'Necessário pra sua API retornar XML ao invés de JSON
xhr.setRequestHeader "Accept", "application/xml"

If method = "POST" Or method = "PUT" Then
    xhr.setRequestHeader "Content-Type", formatcontent
    xhr.setRequestHeader "Content-Length", Len(contents)
    xhr.send contents
Else
    xhr.send
End If

If xhr.status < 200 Or xhr.status >= 300 Then
    'Algo falhou, as vezes pode haver uma descrição em 'xhr.responseText' ou pode retornar vazio, o 'xhr.status' indica o tipo de erro
    MsgBox "Erro HTTP:" & xhr.status & " - Detalhes: " & xhr.responseText
Else
    'Faz o parse da String para XML
    Set doc = CreateObject("MSXML2.DOMDocument")
    doc.loadXML(xhr.responseText)

    'Seleciona com XPATH
    Set nodes = doc.SelectNodes("//IPAddress")

    MsgBox "Elementos encontrados para IPAddress: " & nodes.length

    For Each node In nodes
        MsgBox "Endereço IP: " & node.text
    Next
End If

Note that I used MSXML2.XMLHTTP and MSXML2.DOMDocument if it causes an error try changing the MSXML2. to Microsoft. , it depends on the system.

Asynchronous XmlHttpRequest

To use asynchronous XMLHTTP you can use:

Set xhr = CreateObject("MSXML2.XMLHTTP")
xhr.open hMethod, hUrl, True

And you should use the property:

xhr.onreadystatechange = GetRef([Nome de uma Function ou Sub])

A complete example:

Dim hMethod, hUrl, hFormat, hContents, hAccepts, xhr

'url da API
hUrl = "https://ws.printwayy.com/api/Printer?api_token=1F61D333-CCA5-423A-A764-F8577119A9FE&company_token=&serialNumbers=AK18054352&initialDate=&endDate="

hMethod   = "GET"              'Metodo HTTP
hAccepts  = ""                 'Necessário pra sua API retornar XML ao invés de JSON
hContents = ""                 'Conteúdo em requisições POST/PUT
hAccepts  = "application/xml"  'http accepts

MsgBox hUrl

Set xhr = CreateObject("MSXML2.XMLHTTP")

Sub doParseXml(xmlStr)
    'Faz o parse da String para XML
    Set doc = CreateObject("MSXML2.DOMDocument")
    doc.loadXML(xmlStr)

    'Seleciona com XPATH
    Set nodes = doc.SelectNodes("//IPAddress")

    MsgBox "Elementos encontrados para IPAddress: " & nodes.length

    For Each node In nodes
      MsgBox "Endereço IP: " & node.text
    Next
End Sub

'Recebe assincronamente o resultado
Sub doReadyStateChange()
    If xhr.readyState = 4 Then
        If xhr.status < 200 Or xhr.status >= 300 Then
            MsgBox "Erro HTTP:" & xhr.status & " - Detalhes: " & xhr.responseText
        Else
            doParseXml xhr.responseText
        End If
    End If
End Sub

xhr.onreadystatechange = GetRef("doReadyStateChange")

xhr.open hMethod, hUrl, True

If hAccepts <> "" Then
    xhr.setRequestHeader "Accept", hAccepts
End If

If hMethod = "POST" Or hMethod = "PUT" Then
    'Accpet HTTP request
    If hFormat = "" Then
        xhr.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    Else
        xhr.setRequestHeader "Content-Type", hFormat
    End If

    xhr.setRequestHeader "Content-Length", Len(hContents)
    xhr.send hContents
Else
    xhr.send
End If
    
22.09.2017 / 18:17