Usuario
Adecuar servicio SOAP a REST - Consumir servicio Rest con respuesta en JSON en VB6

Pregunta
-
Hola a todos, El problema es que el servicio que desarrollaron lo hicieron en REST con respuesta en JSON.En mi codigo yo lo tengo con SOAP.
Deseo adecuardo para que consuma el servicio Rest con respuesta en JSON. El nombre del servicio es ZFMI_001.
Public Function ValidaTarjetaCredito_WS(ByVal strFecha As String, _
ByVal dblMonto As Double, _
ByVal strCompania As String, _
ByVal strIdBanc As String, _
ByVal strNumOpe As String, _
ByVal strCodCaja As String, _
ByVal strRocta As String, _
ByVal mstrAccion As String, _
ByVal intId_Pool As String, _
ByVal mstrNroPlanilla As String, _
ByVal mstrAutoriza As String, _
ByVal mstrUsua_Au As String, _
ByVal mstrUsua_Pla As String, _
ByVal strIdMoneda As String) As clsGenItem
'REESCRIBIENDO VALORES
Dim strMoneda As String
Dim strSociedad As String
Dim StrTarjeta As String
Dim StrComercio As String
Select Case strIdMoneda
Case "001"
strMoneda = "PEN"
Case "002"
strMoneda = "USD"
End Select
Select Case strCompania
Case "1"
strSociedad = "1010"
Case "2"
strSociedad = "1020"
Case "3"
strSociedad = "1030"
End Select
StrTarjeta = Mid(strNumOpe, 12, 1)
StrComercio = Mid(strNumOpe, 1, 11)
'DECLARACIONES
Dim strServiceSOAP As String
Dim domSolicitud As DOMDocument
Dim domRespuesta As DOMDocument
Dim oHttReq As XMLHTTPRequest
Dim objGenItem As clsGenItem
Dim oNodo0 As MSXML.IXMLDOMNode 'BASE
Dim oNodo1 As MSXML.IXMLDOMNode 'RESGITROS
Dim oNodo2 As MSXML.IXMLDOMNode 'COLUMNAS DE RESGISTRO
Dim oNodo3 As MSXML.IXMLDOMNode
Dim strBroker As String
'CREANDO OBJETOS
Set domSolicitud = New DOMDocument
Set domRespuesta = New DOMDocument
Set oHttReq = New XMLHTTPRequest
strServiceSOAP = "" & _
"<?xml version=""1.0"" encoding=""utf-8""?>" & _
"<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">" & _
"<soap:Body>" & _
"<ZFMI_0001 xmlns=""http://tempuri.org/"">" & _
"<Sociedad>string</Sociedad>" & _
"<Moneda>string</Moneda>" & _
"<Proveedor_tarjeta>string</Proveedor_tarjeta>" & _
"<Nmro_comercio>string</Nmro_comercio>" & _
"</ZFMI_0001>" & _
"</soap:Body>" & _
"</soap:Envelope>"
'LECTURA DE XML
domSolicitud.loadXML strServiceSOAP
On Error GoTo TransError
'BAPI ZFMI_0001
'CARGANDO PARAMETROS A ENVIAR
domSolicitud.selectSingleNode("/soap:Envelope/soap:Body/ZFMI_0001/Sociedad").Text = strSociedad '"1010"
domSolicitud.selectSingleNode("/soap:Envelope/soap:Body/ZFMI_0001/Moneda").Text = strMoneda '"PEN"
domSolicitud.selectSingleNode("/soap:Envelope/soap:Body/ZFMI_0001/Proveedor_tarjeta").Text = StrTarjeta '"V"
domSolicitud.selectSingleNode("/soap:Envelope/soap:Body/ZFMI_0001/Nmro_comercio").Text = StrComercio '"00123456789"
If mstrAutoriza = "SI" Then
domSolicitud.selectSingleNode("/soap:Envelope/soap:Body/ZFMI_0001/Serkey_au").Text = mstrUsua_Au 'Usuario que autoriza
Else
domSolicitud.selectSingleNode("/soap:Envelope/soap:Body/ZFMI_0001/Serkey_au").Text = "" 'Usuario que no autoriza
End If
domSolicitud.selectSingleNode("/soap:Envelope/soap:Body/ZFMI_0001/Suserkey_co").Text = mstrUsua_Pla 'Usuario que crea/elimina
'INICIANDO LLAMADA AL SERVICIO
'oHttReq.Open "POST", "http://10.10.31.150:9080/MM_LPS_SAPAdapterWeb/sca/I_LPS_SAPExport1", False
oHttReq.Open "POST", strRuta_WS, False
oHttReq.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
oHttReq.setRequestHeader "SOAPAction", "http://tempuri.org/ZFMI_0001"
oHttReq.Send domSolicitud.XML
'Set lstGenItem = New collGenItem
Dim intEstatus As Integer
intEstatus = oHttReq.Status
Set objGenItem = New clsGenItem
If intEstatus = 200 Then
'RECEPCION DE RESPUESTA
domRespuesta.loadXML oHttReq.responseText
Set oNodo0 = domRespuesta.selectSingleNode("/soap:Envelope/soap:Body/ZFMI_0001Response/ZFMI_0001Result")
'OBTENIENDO DATOS
If Not (oNodo0 Is Nothing) Then
If oNodo0.hasChildNodes Then
With objGenItem
If oNodo0.childNodes(0).baseName = "strSestado" Then
If Not IsNull(oNodo0.childNodes(0).nodeTypedValue) Then
.Sestado = oNodo0.childNodes(0).nodeTypedValue
Else
.Sestado = ""
End If
End If
If oNodo0.childNodes.Length > 1 Then
If oNodo0.childNodes(1).baseName = "strSmensaje" Then
If Not IsNull(oNodo0.childNodes(1).nodeTypedValue) Then
.Mensaje = oNodo0.childNodes(1).nodeTypedValue
Else
.Mensaje = ""
End If
End If
End If
End With
Else
Set objGenItem = Nothing
End If
End If
Else
objGenItem.Sestado = CStr(oHttReq.Status)
End If
Set ValidaTarjetaCredito_WS = objGenItem
Exit Function
TransError:
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
Exit Function
End Function
- Editado Sbzjulius lunes, 6 de enero de 2020 15:37