16 respuestas en este tema

[Desart]

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

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+'<br>';  //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:='&aacute;';
        if (Length(VarSLet)=1) and (VarSLet='é') then  VarSLet:='&eacute;';
        if (Length(VarSLet)=1) and (VarSLet='í') then  VarSLet:='&iacute;';
        if (Length(VarSLet)=1) and (VarSLet='ó') then  VarSLet:='&oacute;';
        if (Length(VarSLet)=1) and (VarSLet='ú') then  VarSLet:='&uacute;';
        if (Length(VarSLet)=1) and (VarSLet='Á') then  VarSLet:='&Aacute;';
        if (Length(VarSLet)=1) and (VarSLet='É') then  VarSLet:='&Eacute;';
        if (Length(VarSLet)=1) and (VarSLet='Í') then  VarSLet:='&Iacute;';
        if (Length(VarSLet)=1) and (VarSLet='Ó') then  VarSLet:='&Oacute;';
        if (Length(VarSLet)=1) and (VarSLet='Ú') then  VarSLet:='&Uacute;';
        if (Length(VarSLet)=1) and (VarSLet='ü') then  VarSLet:='&uuml;';
        if (Length(VarSLet)=1) and (VarSLet='ñ') then  VarSLet:='&ntilde;';
        if (Length(VarSLet)=1) and (VarSLet='Ü') then  VarSLet:='&Uuml;';
        if (Length(VarSLet)=1) and (VarSLet='Ñ') then  VarSLet:='&Ntilde;';
        if (Length(VarSLet)=1) and (VarSLet='¡') then  VarSLet:='¡';
        if (Length(VarSLet)=1) and (VarSLet='¿') then  VarSLet:='¿';
        if (Length(VarSLet)=1) and (VarSLet='<') then  VarSLet:='&lt;';
        if (Length(VarSLet)=1) and (VarSLet='>') then  VarSLet:='&gt;';
        if (Length(VarSLet)=1) and (VarSLet='"') then  VarSLet:='&quote;';
        if (Length(VarSLet)=1) and (VarSLet='©') then  VarSLet:='&copy;';
        if (Length(VarSLet)=1) and (VarSLet='®') then  VarSLet:='&reg;';
        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;

[/size]Ya sabéis sois libres de Criticarla, codificarla destruirla, etc. [/size][size=13px]

[Desart]

Compañeros no contaba con el propio Html de la página por lo que no se ve bien, así que adjunto un archivo pdf para que lo podais ver bien

Archivos adjuntos

•  2576_62ed4ca93e6fe1113ca82e1ec04aa9578bd4605e.pdf   16,5KB   8 descargas

[enecumene]

Gracias amigo Desart

[egostar]

Compañeros no contaba con el propio Html de la página por lo que no se ve bien, así que adjunto un archivo pdf para que lo podais ver bien

Así es amigo, es parte de la seguridad del foro, de esa forma prevenimos de cierta manera algún "imprevisto" que se pudiera presentar

Salud OS

[poliburro]

Buenisima¡¡¡¡¡¡¡

Precisamente buscaba yo algo como esto.

Gracias amigo

[Delphius]

Hola Desart,
No he probado tu función, pero si me llama la atención.
No termino de comprender que es lo que hace la primera parte, en realidad, todo lo que está antes de los ifs no entiendo.

En lo que si quisiera detenerme es justo en los ifs, será que estoy acostumbrado a evitarlos, y de sobre manera cuando son muchos, que no me agrada demasiado ese código. Te soy franco, no me parece un buen código 

Yo propongo eliminarlos... y hacerlo más simple. Nota que todo ese código tiene un denominador común. Saquemoslo afuera, algo parecido a cmo si hiciéramos esto a*b + a*c + ... + a*z -> a * (b + c + ... + z).

Mantengo en un vector el texto HTML correspondiente a los carácteres especiales, y además una cadena a modo de constante con la representación en modo texto. Cómo todos estos caracteres en su representación textual ocupan un sólo lugar basta con evualuar si texto está localizado en esta constante. De darse el caso lo que hacemos es reemplazar el carácter i-ésimo del texto a convertir por el contenido de la posición i-ésima del array.

Para ilustrarlo, aquí una idea:
const
SpecialChars = 'áéíóúÁ....®';
HTMLChars: TArrayHTMLChars = ('á','é',...,'®');

Siendo TArrayHTMLChars el tipo de array:

type
TArrayHTMLChars = Array [1..MAX_CHARS] of string;

y MAX_CHARS una constante o directamente el valor fijo de cantidad de caracteres especiales.

Básicamente lo que haría es evaluar con Pos():

delphi

[i]Postxt = Pos(Texto,SpecialChars);
if Postxt > 0
   then HTMLtxt := HTMLtxt + HTMLChars[Postxt]
  else HTMLtxt := HTMLtxt + Texto;[/i]

Y simplemente recorro el texto original desde el primer caracteres hasta el último evualuando. ¿Que te parece? 

[Desart]

Gracias a todos, Delphius me parece perfecto tu comentario, lo que pasa es que siempre me peleo con los arrays, por eso los evito, si quieres modifica el código y ex-ponlo como tu dices, seguro que tú código es mucho mejor que el mio, no es coña. en cuanto al tema del principio, lo que hago es comprobar carácter a carácter si esta dentro del código y antes de esto convierto los saltos de linea en un conjunto de caracteres que no suele estar junto '[xSx]', para luego convertirlos en saltos de linea en HTML.

[Delphius]

Hola,
Espero que no hayas tomado a mal mi comentario. Disculpa si he parecido bruto en mi manera de expresarme.  Si no hay demasiado apuro, en un momento libre que pueda darme escribo una función equivalente a como la pienso yo.

Si que quisiera preguntar antes que nada, para ver si te entiendo... ¿básicamente dices que transformas a cada #10#13 (retorno de línea) por un < br > (sin los espacios, obviamente)?

No recuerdo bien el HTML (tengo que reconocer que no es mi fuerte, y lo que hace el desapego al desarrollo web), a ver si me aclaran... ¿el br no tiene fin de etiqueta /br no es asi?

Saludos,

[felipe]

La etiqueta existe, solo que al tratarse de un salto de linea no es necesario recurrir a ella, con el solo <br> basta para hacerlo.



Saludos!

[Desart]

No Delphius, no me ha molestado, si miras mi primer  mensaje puse

Ya sabéis sois libres de Criticarla, codificarla destruirla, etc.   [/size]

Suelo ser una persona, que quiere aprender, dar lo que puede y acepta que esta equivocada, defiendo lo mio, pero no de una manera suicida y yo lo que se de delphi lo se de una manera autodidacta, estudie un cursillo de Dbase III y de turbo C, con sus diplomas y todo, luego una amigo me dio unas horas de Clipper y el resto han sido libros horas y sobre todo la gente de los clubs de Delphi. No me considero un buen programador (debería decir ni programador), lo que pasa es que he hecho varios programas, algunos de los cuales hace más de diez años y siguen funcionando, por todas las islas y parte de la península, pero reconozco que me queda mucho que aprender.


Ahora mismo, mi prioridad en la empresa es el nuevo programa de la empresa (monstruosamente grande) y el de envió de emails (ambos los hago cuando tengo un rato libre, o estoy saturado con el papeleo de la empresa). En mi Casa estoy con el programa Creatablas y con uno TPV, El creatablas, aunque ya lo he explicado es una herramienta para crear la b.d. y tablas de Firebird, además de crear un ini por tabla para mi otro programa Autoabm, donde permitirá crear los form con los campos ya incluidos, hints, y displaylabes.

[Delphius]

Hola Desart,
Vaya... compartimos algo en común: yo tampoco me considero buen programador, ni siquiera me considero programador  . Pero de vez en cuando hago el intento por aprender y mejorar.
Aún así, la experiencia y la práctica que uno va viviendo con los años le va aportando más seguridad y confianza en lo que haces, y es lo que te llevó a ser una muy buena persona programando ¡aún cuando tu no te consideres muy bueno! 

Más que nada el porqué digo que el código puede mejorarse, y sobre todo respecto a los ifs, se debe a un concepto que se llama complejidad ciclomática. Cada vez que se añade un if la complejidad aumenta en 2, y si bien desarrollar un plan de prueba para esta función no va a ser demasiado costoso si es engorroso, y en cierto modo aparatoso y repitente.

El 2do motivo del porqué eliminarlos es que en realidad, si nos fijamos bien, todos los ifs hacen lo mismo en términos de lógica:
Si Algo = x
entonces Algo = representación de x
AlgoHTML = AlgoHTML + Algo

Yo directamente lo que hago es sacar ese x y su representación afuera y hacer una correspondencia directa. Y Directamente busco cada carácter original en este arreglo. Como tengo la correspondencia directa entre "x" y su representación me independizo de los ifs para ir evaluando uno a uno de los posibles casos, y la conversión es directa: si x está en la posición i-ésima entonces en la misma posición i-ésima está su equivalente HTML.

Y lo mejor del todo es que no se necesita de evaluar y buscarlos a todos esos que tienes en la lista. Nota que en casi la mitad de ellos haces esto:
Si Algo = x
entonces Algo = x

En términos lógicos esto es redundante. Cómo todos los IFs están al mismo nivel, todos hacen lo mismo, y algunos son innecesarios es que me prende el foco y saco el denominador común afuera.
Como dato extra: además, ya antes pasé por un algoritmo se serie de IFs y se lo que se venía. 

Yo tengo mi cabeza programada para evitar en lo posible ir más hallá del 3er IF, aunque se que en ocasiones no puede evitarse. En cuanro llego a 4to me activo en modo alerta, y gracias a la ayuda de CnPack que lo tengo configurado para señalar con colores los niveles de anidamiento... el 4to nivel me lo pinta de rojo.

Saludos,

[Desart]

Muy interesante Delphius, estoy deseando ver como  lo expones en código, para aplicarlo a algunas ideas.

[Khronos]

Modifiqué un poco tu versión en 2 minutos, a ver que te parece:

delphi

function StringToHtml(const Tex: string): string;
const TVarsLet1: array [0..32] of AnsiChar = ('á', 'é',
                 'í', 'ó', 'ú', 'Á', 'É', 'Í',
                 'Ó', 'Ú', 'ü', 'ñ', 'Ü', 'Ñ',
                 '¡', '¿', '<', '>', '"', '©',
                 '®', '$', '%', '?', '=', '@',
                 '¢', '£', '€', '!', '#', '/', '\');
const TVarsLet2: array [0..32] of PAnsiChar = ('&aacute;',
                 '&eacute;', '&iacute;', '&oacute;', '&uacute;',
                 '&Aacute;', '&Eacute;', '&Iacute;', '&Oacute;', '&Uacute;',
                 '&uuml;', '&ntilde;', '&Uuml;', '&Ntilde;', '¡', '¿', '&lt;', '&gt;',
                 '&quote;', '&copy;', '&reg;', '$', '%', '?', '=',
                 '@', '¢', '£', '€', '!', '#', '/', '\');
var
    VarSMiTex,VarSLet,VarSTexto: string;
    VarI2Con, i, u: Integer;
begin
  VarSMiTex:= '';
  VarSTexto:= StringReplace(Tex, #13#10, '[xSx]', [rfReplaceAll]);
  VarI2Con:= 0;
 
 
  for i := 1 to Length(VarSTexto) do
    begin
      if VarI2Con > 0 then
        Dec(VarI2Con)
      else
        begin
          if Copy(VarSTexto, i ,5) = '[xSx]' then
            VarI2Con:= 4
          else
            begin
              VarSLet:=VarSTexto[i];
              if Length(VarSLet) = 1 then
                for u := 0 to 32 do
                  if (TVarsLet1[u] = VarSLet) then
                    VarSLet:= TVarsLet2;
              VarSMiTex:=VarSMiTex+VarSLet
            end;
        end;
    end;
 
 
Result:= VarSMiTex;
end;
[/u][/i]

Saludos.

[Desart]

Muchas gracias Khronos, Se ve mucho mejor, lo unico es en la parte de

[pre]const TVarsLet2: array [0..32] of PAnsiChar = ('&aacute;',
                '&eacute;', '&iacute;', '&oacute;', '&uacute;',
                '&Aacute;', '&Eacute;', '&Iacute;', '&Oacute;', '&Uacute;',
                '&uuml;', '&ntilde;', '&Uuml;', '&Ntilde;', '¡', '¿', '&lt;', '&gt;',
                '&quote;', '&copy;', '&reg;', '$', '%', '?', '=',
                '@', '¢', '£', '€', '!', '#', '/', '\');[/pre]

te pasa como a mí que hay partes que el html lo traduce directamente, por eso pongo el adjunto de mi funcion con tu modificación. un saludo y muchas gracias.

Archivos adjuntos

•  2588_88f7320885a8766d27c4aabc7581f2605d8196ef.pdf   11,41KB   6 descargas

[Desart]

Khronos estoy probando la funcion y me da un error

Error

[DCC Error] FunInternet.pas(87): E2010 Incompatible types: 'string' and 'Array'

La Linea del error

VarSLet:= TVarsLet2;

[egostar]

Hola amigo Desart,

Ese error es por la etiqueta de Delphi, me he dado cuenta que se está modificando el código cuando existen etiquetas válidas dentro del código,

por ejemplo [nobbc] VarSLet:= TVarsLet2; en realidad debe ser VarSLet:= TVarsLet2[i];[/nobbc]

Perdón, ya estamos trabajando para corregir este asunto.

Salud OS

[Wilson]

Hola amigo Desart,

Ese error es por la etiqueta de Delphi, me he dado cuenta que se está modificando el código cuando existen etiquetas válidas dentro del código,

por ejemplo [nobbc] VarSLet:= TVarsLet2; en realidad debe ser VarSLet:= TVarsLet2[i];[/nobbc]

Perdón, ya estamos trabajando para corregir este asunto.

Salud OS

De momento cuando se desee postear código, hay que evitar los nombres  (i,u) para variables que después necesitemos colocar como índices, puesto que se será tomado como parte del formato.


Saludos