Imports System.Xml Imports System.Net Imports System.IO Imports System.Web Imports System.Text.RegularExpressions Imports tsUtilidades.Extensiones.BinaryReaderExtensions ''' ''' Esta clase es una alternativa para cuando no puedes usar un cliente WCF (Referencia de Servicio) o la interfaz generada por wdsl.exe de .Net Framework 2.0. ''' Permite invocar métodos de un servicio web conociendo la URL del "endpoint" del servicio web, pero con la pega de que los mensajes que se envían para ''' invocar los servicios deben ser generados manualmente. ''' Public Class ClienteServicioWeb Public Property Url() As String Get Return m_Url End Get Set(value As String) m_Url = value End Set End Property Private m_Url As String Public Property Method() As String Get Return m_Method End Get Private Set(value As String) m_Method = value End Set End Property Private m_Method As String Private RequestString As String = [String].Empty Private Username As String = [String].Empty Private Password As String = [String].Empty Private sAuth As String = [String].Empty Public Params As New Dictionary(Of String, String)() Public ResponseSOAP As XDocument = XDocument.Parse("") Public ResultXML As XDocument = XDocument.Parse("") Public ResultString As String = [String].Empty Public Sub New() Url = [String].Empty Method = [String].Empty End Sub Public Sub New(baseUrl As String) Url = baseUrl Method = [String].Empty End Sub Public Sub New(baseUrl As String, methodName As String) Url = baseUrl Method = methodName End Sub #Region "Métodos públicos" ''' ''' Añade un parámetro a la llamada al método del servicio web. ''' ''' Nombre del parámetro (sensible a mayúsculas). ''' Valor del parámetro. ''' Intermanente estos parámetros se mandan como parámetros POST. Public Sub AddParameter(name As String, value As String) Params.Add(name, value) End Sub ''' ''' Añade credenciales para autenticarse en el servicio web usando autenticación HTTP básica. ''' ''' ''' ''' Se usa codificación UTF-8 para transmitir estas credenciales. Public Sub AddBasicAuthenticationCredential(ByVal username As String, ByVal password As String) Me.sAuth = System.Convert.ToBase64String(System.Text.Encoding.GetEncoding("ISO-8859-1").GetBytes(username & ":" + password)) Me.Username = username Me.Password = password End Sub Public Sub SetRequestString(ByVal sRequest As String) Me.RequestString = sRequest End Sub Public Sub Invoke(Optional ByVal ignoreSSLErrors As Boolean = False) Invoke(Method, True, ignoreSSLErrors = ignoreSSLErrors) End Sub ''' ''' Invoca un método del servicio web, identificado por su nombre. ''' ''' Nombre del método del servicio web. Public Sub Invoke(methodName As String, Optional ByVal ignoreSSLErrors As Boolean = False) Invoke(methodName, True, ignoreSSLErrors = ignoreSSLErrors) End Sub ''' ''' Limpia todos los datos del objeto excepto la URL del endpoint del servicio web. ''' Es útil para realizar subsecuentes llamadas al mismo servicio web, con otros datos o invocando a otros métodos. ''' Public Sub CleanLastInvoke() ResponseSOAP = InlineAssignHelper(ResultXML, Nothing) ResultString = InlineAssignHelper(Method, [String].Empty) Params = New Dictionary(Of String, String)() End Sub #End Region #Region "Métodos auxiliares públicos" ''' ''' Remove all xmlns:* instances from the passed XmlDocument to simplify our xpath expressions ''' Public Shared Function RemoveNamespaces(oldXml As XDocument) As XDocument ' FROM: http://social.msdn.microsoft.com/Forums/en-US/bed57335-827a-4731-b6da-a7636ac29f21/xdocument-remove-namespace?forum=linqprojectgeneral Try Dim newXml As XDocument = XDocument.Parse(Regex.Replace(oldXml.ToString(), "(xmlns:?[^=]*=[""][^""]*[""])", "", RegexOptions.IgnoreCase Or RegexOptions.Multiline)) Return newXml Catch [error] As XmlException Throw New XmlException([error].Message + " at WSCUtils.RemoveNamespaces") End Try End Function ''' ''' Remove all xmlns:* instances from the passed XmlDocument to simplify our xpath expressions ''' Public Shared Function RemoveNamespaces(oldXml As String) As XDocument Dim newXml As XDocument = XDocument.Parse(oldXml) Return RemoveNamespaces(newXml) End Function ''' ''' Elimina todos los espacios de nombres de un documento XML ''' Public Shared Function EliminarEspaciosDeNombres(xDocumento As XDocument) As XDocument ' FROM: http://social.msdn.microsoft.com/Forums/en-US/bed57335-827a-4731-b6da-a7636ac29f21/xdocument-remove-namespace?forum=linqprojectgeneral Try Dim sRespuestaSinNamespaces As String = System.Text.RegularExpressions.Regex.Replace(xDocumento.ToString(), "(xmlns:?[^=]*=[""][^""]*[""])", "", System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline) sRespuestaSinNamespaces = System.Text.RegularExpressions.Regex.Replace(sRespuestaSinNamespaces, "<\w+:", "<", System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Multiline) sRespuestaSinNamespaces = System.Text.RegularExpressions.Regex.Replace(sRespuestaSinNamespaces, " ''' Converts a string that has been HTML-enconded for HTTP transmission into a decoded string. ''' ''' String to decode. ''' Decoded (unescaped) string. Public Shared Function UnescapeString(escapedString As String) As String Return HttpUtility.HtmlDecode(escapedString) End Function #End Region #Region "Métodos auxiliares privados" Private Function GetCredential() As CredentialCache 'ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Dim credentialCache As New CredentialCache() credentialCache.Add(New System.Uri(Me.Url), "Basic", New NetworkCredential(Me.Username, Me.Password)) Return credentialCache End Function ''' ''' Checks if the WebService's URL and the WebMethod's name are valid. If not, throws ArgumentNullException. ''' ''' Web Method name (optional) Private Sub AssertCanInvoke(Optional methodName As String = "") If Url = [String].Empty Then Throw New ArgumentNullException("You tried to invoke a webservice without specifying the WebService's URL.") End If If (methodName = "") AndAlso (Method = [String].Empty) Then Throw New ArgumentNullException("You tried to invoke a webservice without specifying the WebMethod.") End If End Sub ''' ''' Invokes a Web Method, with its parameters encoded OrElse not. ''' ''' Name of the web method you want to call (case sensitive) ''' Do you want to encode your parameters? (default: true) Private Function Invoke(methodName As String, encode As Boolean, Optional ByVal ignoreSSLErrors As Boolean = False) As String AssertCanInvoke(methodName) Dim soapStr As String = "" & vbCr & vbLf & " " & vbCr & vbLf & " " & vbCr & vbLf & " <{0} xmlns=""http://tempuri.org/"">" & vbCr & vbLf & " {1}" & vbCr & vbLf & " " & vbCr & vbLf & " " & vbCr & vbLf & " " Dim req As HttpWebRequest = DirectCast(WebRequest.Create(Url), HttpWebRequest) If ignoreSSLErrors Then req.ServerCertificateValidationCallback() = Function(sender, certificate, chain, sslPolicyErrors) True End If req.Headers.Add("SOAPAction", (Convert.ToString("""http://tempuri.org/") & methodName) + """") req.ContentType = "text/xml;charset=""utf-8""" req.Accept = "text/xml" req.Method = "POST" 'If Not String.IsNullOrWhiteSpace(sAuth) Then ' req.Headers.Add("Authorization", "Basic " + sAuth) 'End If If Not String.IsNullOrWhiteSpace(Me.Username) AndAlso Not String.IsNullOrWhiteSpace(Me.Password) Then req.Credentials = GetCredential() req.PreAuthenticate = True End If Using stm As Stream = req.GetRequestStream() Dim postValues As String = "" For Each param In Params If encode Then postValues += String.Format("<{0}>{1}", HttpUtility.UrlEncode(param.Key), HttpUtility.UrlEncode(param.Value)) Else postValues += String.Format("<{0}>{1}", param.Key, param.Value) End If Next soapStr = String.Format(soapStr, methodName, postValues) Using stmw As New StreamWriter(stm) stmw.Write(soapStr) End Using End Using Using responseReader As New StreamReader(req.GetResponse().GetResponseStream()) Dim result As String = responseReader.ReadToEnd() ResponseSOAP = XDocument.Parse(UnescapeString(result)) End Using Me.ResultString = ResponseSOAP.ToString Me.ResultXML = ResponseSOAP Return ResponseSOAP.ToString End Function Public Function InvokeUsingRequestString(ByVal methodName As String, ByVal sRequest As String, Optional ByVal cert As System.Security.Cryptography.X509Certificates.X509Certificate2 = Nothing, Optional ByVal ignoreSSLErrors As Boolean = False) As XDocument PreInvoke() AssertCanInvoke(methodName) Dim req As HttpWebRequest = DirectCast(WebRequest.Create(Url), HttpWebRequest) If ignoreSSLErrors Then req.ServerCertificateValidationCallback() = Function(sender, certificate, chain, sslPolicyErrors) True End If req.ContentType = "text/xml;charset=""utf-8""" req.Accept = "text/xml" req.Method = "POST" If cert IsNot Nothing Then req.ClientCertificates.Add(cert) End If 'If Not String.IsNullOrWhiteSpace(sAuth) Then ' req.Headers.Add("Authorization", "Basic " + sAuth) 'End If If Not String.IsNullOrWhiteSpace(Me.Username) AndAlso Not String.IsNullOrWhiteSpace(Me.Password) Then req.Credentials = GetCredential() req.PreAuthenticate = True End If Using stm As Stream = req.GetRequestStream() Using stmw As New StreamWriter(stm) stmw.Write(sRequest) End Using End Using Dim respuesta As String = String.Empty Dim resultado As String = String.Empty Dim sbError As New Text.StringBuilder sbError.AppendLine("") Try Using responseReader As New StreamReader(req.GetResponse().GetResponseStream()) respuesta = responseReader.ReadToEnd() End Using For Each linea As String In respuesta.Split(New String() {Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries) If Not (linea.StartsWith("Content-") OrElse linea.StartsWith("--uuid:")) Then resultado += linea & Environment.NewLine End If Next Catch exTO As TimeoutException resultado = "Tiempo de espera agotado. El servidor del servicio web no respondió a la petición." Catch ex As WebException Using response As WebResponse = ex.Response Dim httpResponse As HttpWebResponse = DirectCast(response, HttpWebResponse) If httpResponse IsNot Nothing Then Try sbError.AppendLine(String.Format("({0}) {1}", DirectCast(httpResponse.StatusCode, Integer), httpResponse.StatusDescription)) Catch ex2 As Exception sbError.AppendLine("Error desconocido del servidor del servicio web.") End Try Else sbError.AppendLine("No hay objeto de tipo HttpWebResponse.") End If Dim sRespuesta As String = String.Empty If response IsNot Nothing Then Try Using data As Stream = response.GetResponseStream() Using reader = New StreamReader(data) sRespuesta = reader.ReadToEnd() End Using End Using Catch ex2 As Exception resultado = sbError.ToString End Try Else sbError.AppendLine("No hay objeto de tipo WebResponse.") End If If sRespuesta IsNot Nothing AndAlso sRespuesta.Length > 0 Then Dim xRespuesta As New XDocument Try xRespuesta = XDocument.Parse(sRespuesta) resultado = sRespuesta Catch ex3 As Exception 'Nada End Try If xRespuesta.ToString.Length < 1 Then resultado = sbError.ToString End If Else resultado = sbError.ToString End If sbError.AppendLine(String.Format("{0}", ex.ToString)) sbError.AppendLine("") resultado = sbError.ToString End Using If String.IsNullOrWhiteSpace(resultado) Then sbError.AppendLine(String.Format("{0}", ex.ToString)) sbError.AppendLine("") resultado = sbError.ToString End If End Try Dim unescapedString As String = UnescapeString(resultado.Trim) Try ResponseSOAP = XDocument.Parse(unescapedString.Trim) Catch ex As XmlException ResponseSOAP = XDocument.Parse(resultado.Trim) End Try PosInvoke() Me.ResultString = ResponseSOAP.ToString Me.ResultXML = ResponseSOAP Return ResponseSOAP End Function ''' ''' Realiza una petición a un servicio web usando un nombre de método, una cadena para la petición, y recogiendo la petición como un array de bytes. ''' ''' Nombre del método. ''' Cadena con la petición que se realizará al servicio web. ''' ''' Un array de bytes con el contenido de la respuesta realizada al servicio web. ''' Este método solo debería usarse con descargas que quepan en memoria RAM, teniendo en cuenta las posibles restricciones de memoria que el sistema operativo puda tener para procesos individuales. Public Function InvokeBinaryUsingRequestString(ByVal methodName As String, ByVal sRequest As String, Optional ByVal cert As System.Security.Cryptography.X509Certificates.X509Certificate2 = Nothing, Optional ByVal ignoreSSLErrors As Boolean = False) As Byte() PreInvoke() AssertCanInvoke(methodName) Dim req As HttpWebRequest = DirectCast(WebRequest.Create(Url), HttpWebRequest) If ignoreSSLErrors Then req.ServerCertificateValidationCallback() = Function(sender, certificate, chain, sslPolicyErrors) True End If req.ContentType = "text/xml;charset=""utf-8""" req.Accept = "text/xml" req.Method = "POST" If cert IsNot Nothing Then req.ClientCertificates.Add(cert) End If 'If Not String.IsNullOrWhiteSpace(sAuth) Then ' req.Headers.Add("Authorization", "Basic " + sAuth) 'End If If Not String.IsNullOrWhiteSpace(Me.Username) AndAlso Not String.IsNullOrWhiteSpace(Me.Password) Then req.Credentials = GetCredential() req.PreAuthenticate = True End If Using stm As Stream = req.GetRequestStream() Using stmw As New StreamWriter(stm) stmw.Write(sRequest) End Using End Using Dim respuesta As String = String.Empty Dim resultado As Byte() = New Byte(0) {} Dim sError As String = String.Empty Dim sb As New Text.StringBuilder Dim binaryBuffer As Byte() Using binaryReader As New BinaryReader(req.GetResponse().GetResponseStream()) binaryBuffer = binaryReader.ReadAllBytes End Using resultado = binaryBuffer PosInvoke() Return resultado End Function ''' ''' This method should be called before each Invoke(). ''' Friend Sub PreInvoke() CleanLastInvoke() ' feel free to add more instructions to this method End Sub ''' ''' This method should be called after each (successful OrElse unsuccessful) Invoke(). ''' Friend Sub PosInvoke() ' feel free to add more instructions to this method End Sub Private Shared Function InlineAssignHelper(Of T)(ByRef target As T, value As T) As T target = value Return value End Function #End Region End Class