Ver Mensaje Individual
  #1  
Antiguo 29-07-2007
xaguilars xaguilars is offline
Miembro
 
Registrado: jul 2007
Posts: 22
Reputación: 0
xaguilars Va por buen camino
Funciones para limpiar y buscar una cadena en otra cadena o en un fichero

Os dejo 3 funciones muy útiles que he ido perfeccionando con el tiempo. La primera es para limpiar strings de caracteres especiales que no se admiten en nombres de ficheros y/o tildes.
Las dos otras funciones nos devuelven true o false dependiendo de si el texto que buscamos se ha encontrado o no. Nos da la opción de limpiar la cadena (strip) o hacer o no diferencia entre mayúsculas y minúsculas.
Por ejemplo, si buscamos "bece" en la palabra "abecedario", el resultado sería true.
Código Delphi [-]
uses Sysutils, Classes, FileCtrl, StdCtrls, ExtCtrls;
function Strip (s:string; tildes:boolean):string;
var
 i:byte;
 t:string;
begin
if s='' then result:='null'
else
 begin
  t:='';
  if tildes=true then
   for i:=1 to length(s) do
   begin
    case s[i] of
      'à','á': s[i]:='a';
      'Á','À': s[i]:='A';
      'è','é': s[i]:='e';
      'É','È': s[i]:='E';
      'ì','í': s[i]:='i';
      'Í','Ì': s[i]:='I';
      'ò','ó': s[i]:='o';
      'Ó','Ò': s[i]:='O';
      'ù','ú': s[i]:='u';
      'Ú','Ù': s[i]:='U';
      '\','/',':','*','?','"','|','<','>':s[i]:='_';
    end;
    t:=t+s[i];
   end
  else
   for i:=1 to length(s) do
   begin
    case s[i] of
      '\','/',':','*','?','"','|','<','>':s[i]:='_';
    end;
    t:=t+s[i];
   end;
  result:=t;
 end;
end;

function FindInStr (Text,Destination:String; CaseSensitive:Boolean):Boolean;
var D,T:PAnsiChar;
begin
  if CaseSensitive=true then
  begin
    D:=PAnsiChar(Destination);
    T:=PAnsiChar(Text);
  end
  else
  begin
    D:=StrLower(PAnsiChar(Strip(Destination,true)));
    T:=StrLower(PAnsiChar(Strip(Text,true)));
  end;
  if  AnsiStrPos(D,T)= nil then
    result:=false
  else
    result:=true;
end;

function FindInTextFile (Text,Filepath:String; CaseSensitive:Boolean):Boolean;
var
  S:String;
  F:Textfile;
begin
  if not FileExists(FilePath) then
  begin
    result:=false;
    exit;
  end;
  AssignFile(F,Filepath);
  Reset(F);
  while not eof(F) do
  begin
    Readln(F,S);
    if FindInStr(Text,S,CaseSensitive)=true then
    begin
      result:=true;
      closefile(F);
      exit;
    end;
  end;
  result:=false;
  closefile(F);
end;
Responder Con Cita