Ver Mensaje Individual
  #1  
Antiguo 22-07-2011
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
 
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Reputación: 25
José Luis Garcí Va camino a la fama
Post Nueva función StringToHtml

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.
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"

Última edición por José Luis Garcí fecha: 22-07-2011 a las 17:08:58.
Responder Con Cita