problema con xmlhttp (RESUELTO)

[lunasoft]

Hola a todos.

Me encuentro con el siguiente problema:

estoy conectando "trello" con access a traves de su web API.

El código para introducir datos es el siguiente:

Código: Seleccionar todo

Public Function metodoPost(ByVal sReq As String) As String

'Crea tarjeta en trello
'llamar a la funcion con el http como parametro)
'
' metodoPost("https://api.trello.com/1/cards?name=Desde+api+2&idList=12345&key=123456&token=12345678")

    Dim byteData() As Byte
    Dim XMLHTTP As Object

    Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")

    XMLHTTP.Open "POST", sReq, False
    XMLHTTP.send
    byteData = XMLHTTP.responseBody

    Set XMLHTTP = Nothing

    metodoPost = StrConv(byteData, vbUnicode)
End Function

El problema es que cuando escribo caracteres especiales (alemanes) en el parametro name (ßöa), me devuelve un error el servidor.

He agregado la linea XMLHTTP.setRequestHeader "Content-Type", "text/html; charset=UTF-8" antes de XMLHTTP.send pero sigue dando error.

Alguna idea?

Muchas gracias

[emiliove]

Hola lunasoft

Tendrías que hacer pruebas, por ejemplo poniendo en alemán directo en la web y observando que letras cambia, pero si usa la codificación UTF8 lo mas probable es que tengas que modificar los acentos y las letras no comunes por su código utf8 adecuado por ejemplo el espacio en blanco en utf8 es %20 y así cada vocal acentuada y letra diferente al alfabeto español, yo por ejemplo para usar el google maps tuve que hacer mi función de sustitución

Código: Seleccionar todo

Function UTF8(strTexto As String) As String
strTexto = Replace(strTexto, " ", "%20")
strTexto = Replace(strTexto, "Ñ", "%C3%91")
strTexto = Replace(strTexto, "ñ", "%C3%B1")
strTexto = Replace(strTexto, "á", "%C3%A1")
strTexto = Replace(strTexto, "à", "%C3%A0")
strTexto = Replace(strTexto, "â", "%C3%A2")
strTexto = Replace(strTexto, "ã", "%C3%A3")
strTexto = Replace(strTexto, "ä", "%C3%A4")
strTexto = Replace(strTexto, "å", "%C3%A5")
'strTexto = Replace(strTexto, "ã", "ã")
strTexto = Replace(strTexto, "è", "%C3%A8")
strTexto = Replace(strTexto, "é", "%C3%A9")
strTexto = Replace(strTexto, "ê", "%C3%AA")
strTexto = Replace(strTexto, "ë", "%C3%AB")

strTexto = Replace(strTexto, "ì", "%C3%AC")
strTexto = Replace(strTexto, "í", "%C3%AD")
strTexto = Replace(strTexto, "î", "%C3%AE")
strTexto = Replace(strTexto, "ï", "%C3%AF")

strTexto = Replace(strTexto, "ð", "%C3%B0")
strTexto = Replace(strTexto, "ò", "%C3%B2")
strTexto = Replace(strTexto, "ó", "%C3%B3")
strTexto = Replace(strTexto, "ô", "%C3%B4")
strTexto = Replace(strTexto, "õ", "%C3%B5")
strTexto = Replace(strTexto, "ö", "%C3%B6")

strTexto = Replace(strTexto, "ù", "%C3%B9")
strTexto = Replace(strTexto, "ú", "%C3%BA")
strTexto = Replace(strTexto, "û", "%C3%BB")
strTexto = Replace(strTexto, "ü", "%C3%BC")

strTexto = Replace(strTexto, ",", "%2C")
strTexto = Replace(strTexto, "ý", "%C3%BD")
strTexto = Replace(strTexto, "þ", "%C3%BE")
strTexto = Replace(strTexto, "ÿ", "%C3%BF")

strTexto = Replace(strTexto, "÷", "%C3%B7")
'strTexto = Replace(strTexto, "ü", "u")
UTF8 = strTexto
End Function ' UTF8

Claro que en tu caso te faltan un buen de letras y símbolos que puedes agregar http://www.utf8-chartable.de/

Saludos.

[pitxiku]

Complementando lo dicho por emiliove, 2 funciones para codificar/descodificar:

- http://www.freevbcode.com/ShowCode.asp?ID=1512

[emiliove]

Yo inventando la rueda
Una pregunta pitxiku, ya que estamos en eso, ahí dice, que lo codifica a ISO Latin y no a UTF8 y veo que es diferente por ejemplo:
N= e%D1 en iso latino
N=%C3%91 en UTF8

¿De ambas formas funciona?

Saludos.

[pitxiku]

Supongo que eso depende del servidor a donde envíes la cadena de texto. Si admite UTF-8 e ISO Latino, da igual cómo lo codifiques. Si sólo admite uno de ellos...

Y como has dicho en un mensaje anterior, lo más sencillo y fiable es usar un navegador, enviar datos a la web que se va a usar, y ver cómo responde con las 2 codificaciones. Una vez hechas las pruebas, usas el método/codificación que más te guste/mejor funcione.

[pitxiku]

Enredando un poco más, y basándonos en este par de páginas:

- http://www.freevbcode.com/ShowCode.asp?ID=1512
- https://www.di-mgt.com.au/howto-convert ... -utf8.html

Podemos crear una función que codifique a UTF-8 o ISO, según nos interese:

Código: Seleccionar todo

'API para convertir entre códigos de páginas
Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpWideCharStr As Long, _
    ByVal cchWideChar As Long, _
    ByVal lpMultiByteStr As Long, _
    ByVal cbMultiByte As Long, _
    ByVal lpDefaultChar As Long, _
    ByVal lpUsedDefaultChar As Long) As Long

'Constante para convertir a UTF-8 usando la API
Private Const CP_UTF8 = 65001

'Enum para la función CodificarUrl
Public Enum PsCodificarUrlEnum
    psCodificarUtf8
    psCodificarISO8859_1
End Enum

'Codifica una cadena de texto para usarla como parte del parámetro de una url:
'http://www.unapagina.es/index.html?lacadena=esto+es+lo+que+codificamos
'Parámetros:
' - Texto: El texto a codificar.
' - Metodo: Cómo lo codificamos (UTF-8 o ISO-8859-1
' - EspacioEsMas: Determina si cambiamos los espacios por + (Verdadero) o
'   por el número %20 (Falso).
'Método creado gracias a esto:
' - http://www.freevbcode.com/ShowCode.asp?ID=1512
' - https://www.di-mgt.com.au/howto-convert-vba-unicode-to-utf8.html
Public Function CodificarUrl(Texto As String, Metodo As PsCodificarUrlEnum, _
        Optional EspacioEsMas As Boolean = True) As String
    'Variables para trocear el texto
    Dim lngPos As Long
    Dim strCar As String
   
    'Variable para el API
    Dim bytCodigos() As Byte
    Dim lngRes As Long
   
    'El texto resultante
    Dim strRes As String
   
    'Recorremos los caracteres del texto
    For lngPos = 1 To Len(Texto)
        strCar = Mid$(Texto, lngPos, 1)
       
        'Para cada carácter, revisamos su código
        Select Case Asc(strCar)
            Case 32         'Espacio
                'Lo que devolvemos depende del parámetro
                If EspacioEsMas Then
                    strRes = strRes & "+"
                Else
                    strRes = strRes & "%20"
                End If
            Case 48 To 57   'Números, se deja tal cual
                strRes = strRes & strCar
            Case 65 To 90   'Mayúsculas, se deja tal cual
                strRes = strRes & strCar
            Case 97 To 122  'Minúsculas, se deja tal cual
                strRes = strRes & strCar
            Case Else       'Resto: esto es lo que codificamos
                'Codificamos mediante el Método indicado
                'De momento sólo hay 2, pero podemos agregar más
                Select Case Metodo
                    Case psCodificarUtf8    'Convertir a UTF-8
                        'Primero se comprueba qué tamaño de matriz necesitamos
                        lngRes = WideCharToMultiByte(CP_UTF8, 0&, _
                            ByVal StrPtr(strCar), -1, vbNull, 0&, 0&, 0&)
                       
                        'Y redimensionamos la matriz
                        ReDim bytCodigos(lngRes - 2)
                       
                        'Ahora recogemos los códigos que representan la letra
                        lngRes = WideCharToMultiByte(CP_UTF8, 0&, _
                            ByVal StrPtr(strCar), -1, _
                            ByVal VarPtr(bytCodigos(0)), lngRes - 1, 0&, 0&)
                       
                        'Cada código está en una posición de la matriz, así
                        'que la recorremos y sólo tenemos que convertir el
                        'número a hexadecimal
                        For lngRes = LBound(bytCodigos) To UBound(bytCodigos)
                            strRes = strRes & "%" & Hex$(bytCodigos(lngRes))
                        Next
                       
                    Case psCodificarISO8859_1   'Convertir a ISO
                        'Este es más sencillo: con Asc recuperamos el número,
                        'con Hex convertimos a Hexadecimal y con Format siempre
                        'vamos a tener 2 números.
                        'Format sólo es necesario con códigos menores que 9, pero
                        'ya que estaba en el código original, lo dejo así.
                        strRes = strRes & "%" & Format$(Hex$(Asc(strCar)), "00")
                End Select
        End Select
    Next
   
    'Devolvemos el resultado
    CodificarUrl = strRes
End Function

[lunasoft]

Gracias a los dos.

Me alegra haber llegado a la misma solución que "emiliove".

Por si le sirve a alguien el código queda así con los caracteres alemanes y el euro incluidos:

Código: Seleccionar todo

Function UTF8(strTexto As String) As String

strTexto = Replace(strTexto, "ä", "%C3%A4")
strTexto = Replace(strTexto, "ö", "%C3%B6")
strTexto = Replace(strTexto, "ü", "%C3%BC")
strTexto = Replace(strTexto, "ß", "%C3%9F")
strTexto = Replace(strTexto, "Ä", "%C3%84")
strTexto = Replace(strTexto, "Ö", "%C3%96")
strTexto = Replace(strTexto, "Ü", "%C3%9C")
strTexto = Replace(strTexto, "€", "%E2%82%AC")

strTexto = Replace(strTexto, " ", "%20")
strTexto = Replace(strTexto, "Ñ", "%C3%91")
strTexto = Replace(strTexto, "ñ", "%C3%B1")
strTexto = Replace(strTexto, "á", "%C3%A1")
strTexto = Replace(strTexto, "à", "%C3%A0")
strTexto = Replace(strTexto, "â", "%C3%A2")
strTexto = Replace(strTexto, "ã", "%C3%A3")
strTexto = Replace(strTexto, "ä", "%C3%A4")
strTexto = Replace(strTexto, "å", "%C3%A5")
strTexto = Replace(strTexto, "è", "%C3%A8")
strTexto = Replace(strTexto, "é", "%C3%A9")
strTexto = Replace(strTexto, "ê", "%C3%AA")
strTexto = Replace(strTexto, "ë", "%C3%AB")

strTexto = Replace(strTexto, "ì", "%C3%AC")
strTexto = Replace(strTexto, "í", "%C3%AD")
strTexto = Replace(strTexto, "î", "%C3%AE")
strTexto = Replace(strTexto, "ï", "%C3%AF")

strTexto = Replace(strTexto, "ð", "%C3%B0")
strTexto = Replace(strTexto, "ò", "%C3%B2")
strTexto = Replace(strTexto, "ó", "%C3%B3")
strTexto = Replace(strTexto, "ô", "%C3%B4")
strTexto = Replace(strTexto, "õ", "%C3%B5")
strTexto = Replace(strTexto, "ö", "%C3%B6")

strTexto = Replace(strTexto, "ù", "%C3%B9")
strTexto = Replace(strTexto, "ú", "%C3%BA")
strTexto = Replace(strTexto, "û", "%C3%BB")
strTexto = Replace(strTexto, "ü", "%C3%BC")

strTexto = Replace(strTexto, ",", "%2C")
strTexto = Replace(strTexto, "ý", "%C3%BD")
strTexto = Replace(strTexto, "þ", "%C3%BE")
strTexto = Replace(strTexto, "ÿ", "%C3%BF")

strTexto = Replace(strTexto, "÷", "%C3%B7")
UTF8 = strTexto
End Function ' UTF8

La solución de pitxiku no me ha servido ya que también convierte ":" y "/" en la dirección http enviada, generando así un error en la API.

Gracias a los dos.