Nueva función StringToHtml

[[José Luis Garcí]]

Hola compañeros, me gustaría colaborar como siempre con una nueva funcion, para convertir cadenas String a HTML

Código Delphi [-]
function StringToHtml(Tex:string):string;
//------------------------------------------------------------------------------
//********************************************************[ StringToHtml ]******
//  22/07/2011   Creada por J.L.G.T.  De uso Libre
//
//  Como siempre bajo la necesidad de crear este función para convertir una cadena
//  de texto en otra valida para HTML. Al darme problemas el lector de mi correo
//  en los mensajes que me enviaba. Por supuesto tiene un código sencillo y
//  estoy seguro de que los compañeros de Delphi lo podrán abreviar y mejorar.
//------------------------------------------------------------------------------
// Pasa un único parámetro que es una cadena string, devolviendo otra preparada
// para HTML, incluyendo los saltos de línea.
//----[Ejemplo]-----------------------------------------------------------------
//  var VarSTexPru:String
//  begin
//     VarSTextPru:='[Cadena de información con acento]';
//     showmessage(StringToHtml( VarSTextPru));  //Daria una cadena '[Cadena de información con acento]'
//     //Que en un entorno Html se ve  como   [Cadena de información con acento]
//  End;
//------------------------------------------------------------------------------
var VarSMiTex,VarSLet,VarSTexto:string;
    VarIa,VarIe,VarICon,VarI2Con:Integer;
begin
  VarSMiTex:='';
  VarSTexto:=StringReplace(Tex,#13#10,'[xSx]',[rfReplaceAll]);
  VarIa:=Length(VarSTexto);
  VarICon:=0;
  VarI2Con:=0;
  for VarIe := 1 to VarIa do
  begin
    if VarI2Con>0 then  VarI2Con:=VarI2Con-1 else
    begin
      if Copy(VarSTexto,varie,5)='[xSx]' then
      begin
        VarI2Con:=4;
        VarSMiTex:=VarSMiTex+'
';  //Pone  VarSMiTex:=VarSMiTex+'< b r >';    Donde < b r >  todo junto, salta de linea por que es un salto en HTML
      end else
      begin
        VarSLet:=VarSTexto[varie];
        if (Length(VarSLet)=1) and (VarSLet='á') then  VarSLet:='á';
        if (Length(VarSLet)=1) and (VarSLet='é') then  VarSLet:='é';
        if (Length(VarSLet)=1) and (VarSLet='í') then  VarSLet:='í';
        if (Length(VarSLet)=1) and (VarSLet='ó') then  VarSLet:='ó';
        if (Length(VarSLet)=1) and (VarSLet='ú') then  VarSLet:='ú';
        if (Length(VarSLet)=1) and (VarSLet='Á') then  VarSLet:='Á';
        if (Length(VarSLet)=1) and (VarSLet='É') then  VarSLet:='É';
        if (Length(VarSLet)=1) and (VarSLet='Í') then  VarSLet:='Í';
        if (Length(VarSLet)=1) and (VarSLet='Ó') then  VarSLet:='Ó';
        if (Length(VarSLet)=1) and (VarSLet='Ú') then  VarSLet:='Ú';
        if (Length(VarSLet)=1) and (VarSLet='ü') then  VarSLet:='ü';
        if (Length(VarSLet)=1) and (VarSLet='ñ') then  VarSLet:='ñ';
        if (Length(VarSLet)=1) and (VarSLet='Ü') then  VarSLet:='Ü';
        if (Length(VarSLet)=1) and (VarSLet='Ñ') then  VarSLet:='Ñ';
        if (Length(VarSLet)=1) and (VarSLet='¡') then  VarSLet:='¡';
        if (Length(VarSLet)=1) and (VarSLet='¿') then  VarSLet:='¿';
        if (Length(VarSLet)=1) and (VarSLet='<') then  VarSLet:='<';
        if (Length(VarSLet)=1) and (VarSLet='>') then  VarSLet:='>';
        if (Length(VarSLet)=1) and (VarSLet='"') then  VarSLet:='"e;';
        if (Length(VarSLet)=1) and (VarSLet='©') then  VarSLet:='©';
        if (Length(VarSLet)=1) and (VarSLet='®') then  VarSLet:='®';
        if (Length(VarSLet)=1) and (VarSLet='$') then  VarSLet:='$';
        if (Length(VarSLet)=1) and (VarSLet='%') then  VarSLet:='%';
        if (Length(VarSLet)=1) and (VarSLet='?') then  VarSLet:='?';
        if (Length(VarSLet)=1) and (VarSLet='=') then  VarSLet:='=';
        if (Length(VarSLet)=1) and (VarSLet='@') then  VarSLet:='@';
        if (Length(VarSLet)=1) and (VarSLet='¢') then  VarSLet:='¢';
        if (Length(VarSLet)=1) and (VarSLet='£') then  VarSLet:='£';
        if (Length(VarSLet)=1) and (VarSLet='€') then  VarSLet:='€';
        if (Length(VarSLet)=1) and (VarSLet='!') then  VarSLet:='!';
        if (Length(VarSLet)=1) and (VarSLet='#') then  VarSLet:='#';
        if (Length(VarSLet)=1) and (VarSLet='/') then  VarSLet:='/';
        if (Length(VarSLet)=1) and (VarSLet='\') then  VarSLet:='\';
        VarSMiTex:=VarSMiTex+VarSLet
      end;
    end;
  end;
  Result:=VarSMiTex;
end;

Ya sabéis sois libres de Criticarla, codificarla destruirla, etc.

[[Chris]]

De antemano se agradece tu aporte y tu buena voluntad de colaborar con el público José.

Pero no me queda claro el propósito de la función que has compartido. Mucho menos entiendo el código que has publicado. No veo que haga reemplazos. Por ejemplo no entiendo que hace este código:
if (Length(VarSLet)=1) and (VarSLet='á') then VarSLet:='á';
Me da la impresión que no hace ningún tipo de modificación sobre la cadena.

Talvez me podrías aclarar un poco el código porque sinceramente no lo entiendo

Saludos,
Chris

[[Chris]]

Por otro lado, sin querer menospreciar tu trabajo José, existen la funciones HTMLEncode y HTMLDecode en la unidad HttpApp. La primera tiene el mismo propósito que la que nos has compartido. El propósito de la segunda es revertir el trabajo de la primera o hacer algo así como HTMLToString.

Saludos,
Chris

[[José Luis Garcí]]

Cris Tienes toda la razón el tema es que claro no contaba con el propio HTML, por eso vez la conversión directamente adjunto un pdf con el código, para que se vea bien.

[[José Luis Garcí]]

Empezado por Chris

Por otro lado, sin querer menospreciar tu trabajo José, existen la funciones HTMLEncode y HTMLDecode en la unidad HttpApp. La primera tiene el mismo propósito que la que nos has compartido. El propósito de la segunda es revertir el trabajo de la primera o hacer algo así como HTMLToString.

Saludos,
Chris

Muchas gracias por la infomación, no las conocia, la verdad me podian aver ahorrado unas horas de código, pero bueno, lo tomo como lo que es un ejercicio y una nueva practica. Muchas Gracias.

[Casimiro Notevi]

Gracias, va a mi almacén de código útil