Indy y sus problemas con acentos y otras letras

Hace un par de semanas trabajando en un nuevo proyecto en dónde por primera vez utilizo en gran medida los componente INDY encontré un problema muy grave al enviar datos al servidor. Los caracteres fuera de la tabla ASCII[áski] se perdían. O sea los caracteres cómo

Ñ, Á, É, Ö, Ü,

etc. Pasé días buscando en la red el origen y solución a este problema. Entre todo lo que busqué y leí, lamentablemente lo único que me sirvió es saber que en las nuevas versiones de éstos componentes el problemas ya estaba resuelto.

Sinceramente le huía a la idea de volver a instalar los componentes INDY en Delphi. Son bastantes! así que lo que hice es explorar el código más reciente de dichos componente y revisar los cambios hechos a la función POST de la clase TidHTTP. Se nota que se hicieron mejoras respecto a la versión incluida con Delphi 2009. En mi caso, lamentablemente no solo se trataba de interceptar la clase y reimplementar el procedimiento POST pues había dependencias a otros códigos que no estaban incluidos en la versión que acompaña a Delphi 2009.

Lo que hice entonces fue colocar en una sola unidad todo el código que necesitaba la nueva implementación de la función POST. He aquí el resultado:

unit indy_derived_functions;

{$DEFINE STRING_IS_UNICODE}

interface

uses
    Classes, StrUtils, idGlobal, SysUtils, IdException;

type
    TIdTextEncoding = SysUtils.TEncoding;
    TIdUnicodeString = String;
    IdAnsiEncodingType = (encIndyDefault, encOSDefault, encASCII, encUTF7, encUTF8, enc8Bit);
    EIdUTF16Exception = class(EIdException);
    EIdUTF16IndexOutOfRange = class(EIdUTF16Exception);
    EIdUTF16InvalidHighSurrogate = class(EIdUTF16Exception);
    EIdUTF16InvalidLowSurrogate = class(EIdUTF16Exception);
    EIdUTF16MissingLowSurrogate = class(EIdUTF16Exception);

var
    GIdDefaultAnsiEncoding: IdAnsiEncodingType = encASCII;

function WWWFormUrlEncode(const ASrc: string; AByteEncoding: TIdTextEncoding): string;
function SetRequestParams(ASource: TStrings; AByteEncoding: TIdTextEncoding): string;

implementation

function CalcUTF16CharLength(const AStr: {$IFDEF STRING_IS_UNICODE}string{$ELSE}TIdWideChars{$ENDIF};
  const AIndex: Integer): Integer;
{$IFDEF DOTNET}
var
  C: Integer;
{$ELSE}
  {$IFDEF HAS_TCharacter}
    {$IFDEF USE_INLINE}inline;{$ENDIF}
  {$ELSE}
var
  C: WideChar;
  {$ENDIF}
{$ENDIF}
begin
  {$IFDEF DOTNET}

  C := System.Char.ConvertToUtf32(AStr, AIndex-1);
  if (C >= #$10000) and (C     Result := 2;
  end else begin
    Result := 1;
  end;
  {$ELSE}
    {$IFDEF HAS_TCharacter}
  //for D2009+, we use TCharacter.ConvertToUtf32() as-is
  TCharacter.ConvertToUtf32(AStr, AIndex, Result);
    {$ELSE}
  if (AIndex < {$IFDEF STRING_IS_UNICODE}1{$ELSE}0{$ENDIF}) or      (AIndex > (Length(AStr){$IFNDEF STRING_IS_UNICODE}-1{$ENDIF})) then
  begin
    raise EIdUTF16IndexOutOfRange.Create('EIdUTF16IndexOutOfRange');//.CreateResFmt(@RSUTF16IndexOutOfRange, [AIndex, Length(AStr)]);
  end;
  C := AStr[AIndex];
  if (C >= #$D800) and (C  #$DBFF then begin
      raise EIdUTF16InvalidHighSurrogate.Create('EIdUTF16InvalidHighSurrogate');//.CreateResFmt(@RSUTF16InvalidHighSurrogate, [AIndex]);
    end;
    if AIndex = (Length(AStr){$IFNDEF STRING_IS_UNICODE}-1{$ENDIF}) then begin
      raise EIdUTF16MissingLowSurrogate.Create('EIdUTF16MissingLowSurrogate');//.CreateRes(@RSUTF16MissingLowSurrogate);
    end;
    C := AStr[AIndex+1];
    if (C < #$DC00) or (C > #$DFFF) then begin
      raise EIdUTF16InvalidLowSurrogate.Create('EIdUTF16MissingLowSurrogate');//.CreateResFmt(@RSUTF16InvalidLowSurrogate, [AIndex+1]);
    end;
    Result := 2;
  end else begin
    Result := 1;
  end;

    {$ENDIF}
  {$ENDIF}
end;

function GetUTF16Codepoint(const AStr: {$IFDEF STRING_IS_UNICODE}string{$ELSE}TIdWideChars{$ENDIF};
  const AIndex: Integer): Integer;
{$IFDEF DOTNET}
  {$IFDEF USE_INLINE}inline;{$ENDIF}
{$ELSE}
  {$IFDEF HAS_TCharacter}
    {$IFDEF USE_INLINE}inline;{$ENDIF}
  {$ELSE}
var
  C: WideChar;
  LowSurrogate, HighSurrogate: Integer;
  {$ENDIF}
{$ENDIF}
begin
  {$IFDEF DOTNET}
  Result := System.Char.ConvertToUtf32(AStr, AIndex-1);
  {$ELSE}
    {$IFDEF HAS_TCharacter}
  //for D2009+, we use TCharacter.ConvertToUtf32() as-is
  Result := TCharacter.ConvertToUtf32(AStr, AIndex);
    {$ELSE}

  if (AIndex < {$IFDEF STRING_IS_UNICODE}1{$ELSE}0{$ENDIF}) or      (AIndex > (Length(AStr){$IFNDEF STRING_IS_UNICODE}-1{$ENDIF})) then
  begin
    raise EIdUTF16IndexOutOfRange.Create('EIdUTF16IndexOutOfRange');//.CreateResFmt(@RSUTF16IndexOutOfRange, [AIndex, Length(AStr)]);
  end;

  C := AStr[AIndex];
  if (C >= #$D800) and (C  $DBFF then begin
      raise EIdUTF16InvalidHighSurrogate.Create('EIdUTF16InvalidHighSurrogate');//.CreateResFmt(@RSUTF16InvalidHighSurrogate, [AIndex]);
    end;
    if AIndex = (Length(AStr){$IFNDEF STRING_IS_UNICODE}-1{$ENDIF}) then begin
      raise EIdUTF16MissingLowSurrogate.Create('EIdUTF16MissingLowSurrogate');//.CreateRes(@RSUTF16MissingLowSurrogate);
    end;
    LowSurrogate := Integer(AStr[AIndex+1]);
    if (LowSurrogate < $DC00) or (LowSurrogate > $DFFF) then begin
      raise EIdUTF16InvalidLowSurrogate.Create('EIdUTF16InvalidLowSurrogate');//.CreateResFmt(@RSUTF16InvalidLowSurrogate, [AIndex+1]);
    end;
    Result := ((HighSurrogate - $D800) shl 10) or (LowSurrogate - $DC00) + $10000;
  end else begin
    Result := Integer(C);
  end;

    {$ENDIF}
  {$ENDIF}
end;

function WideCharIsInSet(const ASet: TIdUnicodeString; const AChar: WideChar): Boolean;
var
  I: Integer;
begin
  // RLebeau 5/8/08: Calling Pos() with a Char as input creates a temporary
  // String.  Normally this is fine, but profiling reveils this to be a big
  // bottleneck for code that makes a lot of calls to CharIsInSet(), so need
  // to scan through ASet looking for the character without a conversion...
  //
  // Result := IndyPos(AString[ACharPos], ASet);
  //
  Result := False;
  for I := 1 to Length(ASet) do begin
    if ASet[I] = AChar then begin
      Result := True;
      Exit;
    end;
  end;
end;

procedure EnsureEncoding(var VEncoding : TIdTextEncoding; ADefEncoding: IdAnsiEncodingType = encIndyDefault);
{$IFDEF USEINLINE}inline;{$ENDIF}
begin
  if VEncoding = nil then
  begin
    if ADefEncoding = encIndyDefault then begin
      ADefEncoding := GIdDefaultAnsiEncoding;
    end;
    case ADefEncoding of
      encASCII: VEncoding := TIdTextEncoding.ASCII;
      encUTF7:  VEncoding := TIdTextEncoding.UTF7;
      encUTF8:  VEncoding := TIdTextEncoding.UTF8;
      enc8Bit:  VEncoding := TIdTextEncoding.ASCII;//TIdTextEncoding.GetEncoding('ISO-8859-1');
    else
      VEncoding := TIdTextEncoding.Default;
    end;
  end;
end;

function WWWFormUrlEncode(const ASrc: string; AByteEncoding: TIdTextEncoding): string;
const
  // HTML 4.01 Section 17.13.4 ("Form content types") says:
  //
  //   application/x-www-form-urlencoded
  //
  //   Control names and values are escaped. Space characters are replaced by `+',
  // and then reserved characters are escaped as described in [RFC1738], section
  // 2.2: Non-alphanumeric characters are replaced by `%HH', a percent sign and
  // two hexadecimal digits representing the ASCII code of the character. Line
  // breaks are represented as "CR LF" pairs (i.e., `%0D%0A').
  //
  // On the other hand, HTML 5 Section 4.10.16.4 ("URL-encoded form data") says:
  //
  //   If the character isn't in the range U+0020, U+002A, U+002D, U+002E,
  // U+0030 .. U+0039, U+0041 .. U+005A, U+005F, U+0061 .. U+007A then replace
  // the character with a string formed as follows: Start with the empty string,
  // and then, taking each byte of the character when expressed in the selected
  // character encoding in turn, append to the string a U+0025 PERCENT SIGN
  // character (%) followed by two characters in the ranges U+0030 DIGIT ZERO (0)
  // to U+0039 DIGIT NINE (9) and U+0041 LATIN CAPITAL LETTER A to
  // U+005A LATIN CAPITAL LETTER Z representing the hexadecimal value of the
  // byte zero-padded if necessary).
  //
  //   If the character is a U+0020 SPACE character, replace it with a single
  // U+002B PLUS SIGN character (+).
  //
  // So, lets err on the side of caution and use the HTML 5.x definition, as it
  // encodes some of the characters that HTML 4.01 allows unencoded...
  //
  SafeChars: TIdUnicodeString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789*-._'; {do not localize}
var
  I, J, CharLen, ByteLen: Integer;
  Buf: TIdBytes;
  {$IFDEF STRING_IS_ANSI}
  LChars: TIdWideChars;
  {$ENDIF}
  LChar: WideChar;
  Encoded: Boolean;
begin
  Result := '';    {Do not Localize}

  // keep the compiler happy
  Buf := nil;
  {$IFDEF STRING_IS_ANSI}
  LChars := nil;
  {$ENDIF}

  if ASrc = '' then begin
    Exit;
  end;

  EnsureEncoding(AByteEncoding, encUTF8);
 (* {$IFDEF STRING_IS_ANSI}
  EnsureEncoding(ASrcEncoding, encOSDefault);
  LChars := ASrcEncoding.GetChars(RawToBytes(ASrc[1], Length(ASrc)));
  {$ENDIF}  *)

  // 2 Chars to handle UTF-16 surrogates
  SetLength(Buf, AByteEncoding.GetMaxByteCount(2));

  I := 0;
  while I < Length({$IFDEF STRING_IS_UNICODE}ASrc{$ELSE}LChars{$ENDIF}) do   begin     LChar := {$IFDEF STRING_IS_UNICODE}ASrc[I+1]{$ELSE}LChars[I]{$ENDIF};     // RLebeau 1/7/09: using Ord() for #128-#255 because in D2009 and later, the     // compiler may change characters >= #128 from their Ansi codepage value to
    // their true Unicode codepoint value, depending on the codepage used for
    // the source code. For instance, #128 may become #$20AC...

    if Ord(LChar) = 32 then {do not localize}
    begin
      Result := Result + '+'; {do not localize}
      Inc(I);
    end
    else if WideCharIsInSet(SafeChars, LChar) then
    begin
      Result := Result + Char(LChar);
      Inc(I);
    end else
    begin
      // HTML 5 Section 4.10.16.4 says:
      //
      // For each character ... that cannot be expressed using the selected character
      // encoding, replace the character by a string consisting of a U+0026 AMPERSAND
      // character (&), a U+0023 NUMBER SIGN character (#), one or more characters in
      // the range U+0030 DIGIT ZERO (0) to U+0039 DIGIT NINE (9) representing the
      // Unicode code point of the character in base ten, and finally a U+003B
      // SEMICOLON character (;).
      //
      CharLen := CalcUTF16CharLength(
        {$IFDEF STRING_IS_UNICODE}ASrc, I+1{$ELSE}LChars, I{$ENDIF}
        ); // calculate length including surrogates
      ByteLen := AByteEncoding.GetBytes(
        {$IFDEF STRING_IS_UNICODE}ASrc, I+1{$ELSE}LChars, I{$ENDIF},
        CharLen, Buf, 0); // explicit Unicode->Ansi conversion

      Encoded := (ByteLen > 0);
      if Encoded and (LChar <> '?') then begin  {do not localize}
        for J := 0 to ByteLen-1 do begin
          if Buf[J] = Ord('?') then begin  {do not localize}
            Encoded := False;
            Break;
          end;
        end;
      end;

      if Encoded then begin
        for J := 0 to ByteLen-1 do begin
          Result := Result + '%' + IntToHex(Ord(Buf[J]), 2);  {do not localize}
        end;
      end else begin
        J := GetUTF16Codepoint(
          {$IFDEF STRING_IS_UNICODE}ASrc, I+1{$ELSE}LChars, I{$ENDIF});
        Result := Result + '&#' + IntToStr(J) + ';';  {do not localize}
      end;

      Inc(I, CharLen);
    end;
  end;
end;

function SetRequestParams(ASource: TStrings; AByteEncoding: TIdTextEncoding): string;
var
  i: Integer;
  LPos: integer;
  LStr: string;
  LTemp: TStringList;

  function EncodeLineBreaks(AStrings: TStrings): String;
  begin
    if AStrings.Count > 1 then begin
      // break trailing CR&LF
      Result := StringReplace(Trim(AStrings.Text), sLineBreak, '&', [rfReplaceAll]); {do not localize}
    end else begin
      Result := Trim(AStrings.Text);
    end;
  end;

begin
  if Assigned(ASource) then begin
    if {hoForceEncodeParams in FOptions} True then begin
      // make a copy of ASource so the caller's TStrings object is not modified
      LTemp := TStringList.Create;
      try
        LTemp.Assign(ASource);
        for i := 0 to LTemp.Count - 1 do begin
          LStr := LTemp[i];
          LPos := IndyPos('=', LStr); {do not localize}
          if LPos > 0 then begin
            LTemp[i] := WWWFormUrlEncode(LTemp.Names[i], AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF})
                        + '=' {do not localize}
                        + WWWFormUrlEncode(
                            {$IFDEF HAS_TStrings_ValueFromIndex}
                            LTemp.ValueFromIndex[i]
                            {$ELSE}
                            Copy(LStr, LPos+1, MaxInt)
                            {$ENDIF}
                            , AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
                          );
          end else begin
            LTemp[i] := WWWFormUrlEncode(LStr, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
          end;
        end;
        Result := EncodeLineBreaks(LTemp);
      finally
        LTemp.Free;
      end;
    end else begin
      Result := EncodeLineBreaks(ASource);
    end;
  end else begin
    Result := '';
  end;
end;

end.

Por último, tuve que cambiar ligeramente el código de la rutina dónde utilizo POST para que codificará los datos del formulario HTML utilizando las rutinas anteriores:

function PostData(const RequestURL: String; PostFormData: TStringlist): String; overload;
var
    HTTPRequestURL: String;
    lParams: TMemoryStream;
    Encoding: TIdTextEncoding;
begin
    with idHTTPRequestComponent do
    try
        HTTPRequestURL := URL.URLEncode(Format(GetAppServer + '%s', [RequestURL]));
        Request.ContentType := 'application/x-www-form-urlencoded';
        Request.ContentEncoding := 'utf-8';
        Response.KeepAlive := True;
        try
            lParams := TMemoryStream.Create;
            // codificar los datos :)
            WriteStringToStream(LParams, SetRequestParams(PostFormData, TIdTextEncoding.UTF8));
            LParams.Position := 0;
            result := Post(HTTPRequestURL, LParams);
        finally
            FreeAndNil(lParams);
        end;
    except on E: EIdHTTPProtocolException do
        begin
            ShowMessage(IntToStr(E.ErrorCode));
            Abort;
        end;
    end;
end;

La implementación de la función anterior es muy similar a la interna utiliza por POST en las nuevas versiones de los componentes INDY.

A pesar de todo lo dicho y expuesto anteriormente, siempre es mejor que instales la última versión de los componentes INDY. Todo lo que hice anteriormente fue por una simple pereza de no querer instalarlos :-)

Espero que mi experiencia sirva para otros para encontrar un camino para encontrar solución a este grave problema. Me encantaría que los lectores comentaran sus experiencias y claro, ¡Estoy a su disposición de contestar cualquier comentario!

Saludos,

Chris