Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros entornos y lenguajes > Lazarus, FreePascal, Kylix, etc.
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

 
 
Herramientas Buscar en Tema Desplegado
  #2  
Antiguo 20-05-2014
WPascal WPascal is offline
Miembro
NULL
 
Registrado: oct 2010
Posts: 26
Poder: 0
WPascal Va por buen camino
Smile Función completa

Aquí les dejo la función completa, lo que hace es buscar una frase en documentos word que están en una carpeta y cada resultado lo inserta como un objeto TResultado en un TObjectList:

Código Delphi [-]
type
  Tresultado=class(TObject)
  NombreArchivo:String;
  TextoVistaPrevia:String;
  Relevancia,EncontradoEnLinea:integer;
end;  


function TFrmPrincipal.BuscarPalabra(carpeta,frase:String;TipoBusqueda:integer):TObjectList;
var
  aliasArchivo:Text;
  renglonTemporal,RutaArchivoActual:string;
  numeroRenglonActual,i,j,m,relevancia,CantidadPalabrasSeparadas,CantidadDeArchivos,numeroDeParrafos:i  nteger;
  resultado:TResultado;
  ListaDeArchivos,PalabrasSeparadas:TStringList;
  dw:Variant;
begin
  dw:=CreateOleObject('word.Application');


  result:=TObjectList.create(true);  //result va a contener la lista de objectos resultado
  ListaDeArchivos:=TStringList.Create;
  PalabrasSeparadas:=TStringList.Create;



  frase:=trim(frase);
  PalabrasSeparadas:=Dividir(frase,' '); //separamos la frase de busqueda en las palabras que la conforman
  CantidadPalabrasSeparadas:=PalabrasSeparadas.Count;

  ListaDeArchivos:=ListaArchivos(ExtractFilePath(Application.ExeName)+carpeta,'*.doc',false);
  CantidadDeArchivos:=ListaDeArchivos.Count;

  for i:=0 to CantidadDeArchivos-1  do
  begin
    RutaArchivoActual:=ExtractFilePath(Application.exename)+carpeta+'\'+ListaDeArchivos[i]+'.doc'; //cambio
    //dw.Documents.Open('D:\INFORMACION\Documentos\DOCUMENTOS\CODIGO.doc'); //De esta forma funciona correctamente
    dw.Documents.Open(RutaArchivoActual,null,false);  //esta es una de las formas que intenté
    numeroRenglonActual:=1;

    numeroDeParrafos:=dw.ActiveDocument.paragraphs.count;

    while numeroRenglonActual < numeroDeParrafos  do  //no sé por que el editor me deja pegado el 'do' de la palabra anterior
    begin
      numeroRenglonActual:=numeroRenglonActual+1;
      renglonTemporal:=dw.ActiveDocument.paragraphs.item(numeroRenglonActual).range.text;
      if TipoBusqueda=1 then   //si se busca una palabra
      begin
        relevancia:=0;

        for j:=0 to CantidadPalabrasSeparadas-1 do
        begin
          if AnsiContainsText(renglonTemporal,PalabrasSeparadas[j]) then
             relevancia+=1;
        end;

        if relevancia>0 then
        begin
          resultado:=TResultado.Create;  //creamos la instancia de la clase TResultado
          resultado.EncontradoEnLinea:=numeroRenglonActual;
          resultado.TextoVistaPrevia:=renglonTemporal;

          resultado.NombreArchivo:=RutaArchivoActual;
          resultado.Relevancia:=relevancia;

          result.Add(resultado); //agrego el resultado al TObjectList
        end;
      end
      else if TipoBusqueda=2 then     //si se busca una ley
      begin
        if AnsiPos(frase,renglonTemporal)<>0 then
        begin
          resultado:=TResultado.Create;  //creamos la instancia de la clase TResultado
          resultado.EncontradoEnLinea:=numeroRenglonActual;
          resultado.TextoVistaPrevia:=renglonTemporal;

          resultado.NombreArchivo:=RutaArchivoActual;
          result.Add(resultado);
        end;
      end;
    end;

    dw.quit;
    ShowMessage('termino la busqueda');
  end;
end;

Gracias por su atención

Última edición por Casimiro Noteví fecha: 20-05-2014 a las 14:57:37.
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Problema en Lazarus. gastontt Lazarus, FreePascal, Kylix, etc. 4 05-01-2011 02:21:38
[Lazarus] GTK+-devel en SUSE. problema instalar lazarus de esa libreria. sakuragi Lazarus, FreePascal, Kylix, etc. 3 28-09-2006 03:31:09
documento excel en blob de Firebird con automation apicito Servers 1 27-10-2004 12:29:43
Automation - Paleta Servers Alexander Servers 0 30-06-2004 16:57:34
proxy pattern en model com automation rorra Providers 0 02-06-2004 04:25:26


La franja horaria es GMT +2. Ahora son las 16:54:54.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi