Eu peguei vários exemplos na Web que deram certos, mas preciso pegar os valores desse arquivo que segue o link abaixo.
Como eu faria isso com VB6
?
Stack Overflow em Português é um site de perguntas e respostas para programadores profissionais e entusiastas. Leva apenas um minuto para se inscrever.
Inscreva-se para participar desta comunidadeEu peguei vários exemplos na Web que deram certos, mas preciso pegar os valores desse arquivo que segue o link abaixo.
Como eu faria isso com VB6
?
Você pode usar XMLHTTPRequest
, que funciona bem semelhante ao do javascript e para fazer o parse do XML pode usa:
Set doc = CreateObject("MSXML2.DOMDocument")
doc.loadXML(xhr.responseText)
E o Xpath pode ser útil pra selecionar os nodes necessários:
Set nodes = doc.SelectNodes("//IPAddress")
Um exemplo "síncrono":
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 que usei MSXML2.XMLHTTP
e MSXML2.DOMDocument
se causar erro tente mudar o MSXML2.
para Microsoft.
, depende do sistema.
Pra usar XMLHTTP assíncrono você pode usar:
Set xhr = CreateObject("MSXML2.XMLHTTP")
xhr.open hMethod, hUrl, True
E deve usar a propriedade:
xhr.onreadystatechange = GetRef([Nome de uma Function ou Sub])
Um exemplo completo:
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