Поиск информации по каталогу

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl, Gauges,ComObj, Grids, OleServer, ExcelXP,
  DB, DBGrids, ADODB, ComCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Gauge1: TGauge;
    StringGrid1: TStringGrid;
    ExcelApplication1: TExcelApplication;
    ADOTable1: TADOTable;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    ADOConnection1: TADOConnection;
    RichEdit1: TRichEdit;
    Edit1: TEdit;
    ADOQuery1: TADOQuery;
    Gauge2: TGauge;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure GetAllFiles( Path: string; Lb: TStringList);
var
 sRec: TSearchRec;
 isFound: boolean;
begin
 isFound := FindFirst( Path + '\*.*', faAnyFile, sRec ) = 0;
 while isFound do
  begin
   if ( sRec.Name <> '.' ) and ( sRec.Name <>  '..' ) then
    begin
     if ( sRec.Attr and faDirectory ) = faDirectory then
     GetAllFiles( Path + '\' + sRec.Name, Lb );
     Lb.Add( Path + '\' + sRec.Name );
    end;
   Application.ProcessMessages;
   isFound := FindNext( sRec ) = 0;
  end;
 FindClose( sRec );
end;
 
 
procedure GetFileXml;
var
SL , sl1, sl2,rezultat: TStringList;
  chosenDirectory,adress,sql,file_tip, strxls,straccses:String;
                           i,r,j,j1,n,c,x,xx,xxx,xxxx,x1:Integer;
                     wdApp, wdDocs, wdDoc,xlAPP, xlbook : Variant;
begin
   SL1:=TStringList.Create ;
   SL2:=TStringList.Create;
   rezultat:=TStringList.Create ;
  if SelectDirectory('Выберите папку c файлами xml', 'С:\,D:\', chosenDirectory)
  then
  begin
    SL:=TStringList.Create;  //Создаем TStringList
    GetAllFiles(chosenDirectory,SL); //Запускаем функцию сканирования папки
  end
  else
  begin
   exit; //Просто выход из процедуры: если пользователь ничего не выбрал, то не нужно продолжать выполнения процедуры
  end;
 if SL.Count>0  then // Это условие проверяет, есть ли в списке хоть одна ссылка (список не пустой)
 begin
    form1.Gauge1.MaxValue:=(SL.Count-1); //Так как обработка у нас пакетная, то хорошо бы отображать процесс в прогресс баре (здесь я использую TGauge, раздел Samples)
    for i:=0 to (SL.Count-1) do
    begin
    form1.Label1.Caption:='Идет анализ файлов';
    form1.Label1.Visible:=true;
 
    {----------------Если файл Ворд--------------------------}
     if (copy(sl[i],pos('.',sl[i])+1,length(sl[i]))='doc') or (copy(sl[i],pos('.',sl[i])+1,length(sl[i]))='docx') then
      begin
       try
         wdApp := CreateOleObject('Word.Application');
       except
         ShowMessage('Не удалось запустить MS Word. Действие отменено.');
        Exit;
       end;
         form1.Gauge1.Progress:=i;
         wdApp.Visible := false;
         wdDocs := wdApp.Documents;
         wdDoc := wdDocs.Open(FileName:=sl[i]);
         form1.RichEdit1.Text := wdDoc.Range.Text;
         form1.Gauge2.MaxValue:=form1.RichEdit1.Lines.Count-1;
          for x:=0 to form1.RichEdit1.Lines.Count-1 do
           begin
            if pos(form1.Edit1.Text, form1.RichEdit1.Lines[x])<>0 then
             rezultat.Add(form1.RichEdit1.Lines[x]);
             form1.Label2.Caption:=sl[i];
              form1.Gauge2.Progress:=x;
           end;
         wdApp.Quit; //Закрываем MS Word.
         wdApp := Unassigned;
      end;
      {--------если фаил XLS--------------}
        if (copy(sl[i],pos('.',sl[i])+1,length(sl[i]))='xls') or (copy(sl[i],pos('.',sl[i])+1,length(sl[i]))='xlsx') then
      begin
       try
         xlApp := CreateOleObject('Excel.Application');  //создаем объект Excel
       except
         ShowMessage('Не удалось запустить MS Excel. Действие отменено.');
        Exit;
       end;
         xlApp.Visible := false;    //скрываем Exel
         xlApp.Workbooks.Open(FileName:=sl[i]);  //открываем файл FileName:=sl[i]
         for xxx:=1 to xlApp.Sheets.Count do
         begin
         xlbook := xlApp.Workbooks[ExtractFileName(sl[i])].WorkSheets[xxx];   //создаем объект xlbook(страница) и указываем номер листа (xxx) в книге, с которого будем осуществлять чтение
         xlApp.Workbooks[ExtractFileName(sl[i])].WorkSheets[xxx].select;
         xlbook.Cells.SpecialCells( 11, EmptyParam).Activate;    //активируем последнюю ячейку на листе
         r := xlApp.ActiveCell.Row;    // Возвращает номер последней строки
         c := xlApp.ActiveCell.Column;    // Возвращает номер последнего столбца
         form1.StringGrid1.RowCount:= r;
         form1.StringGrid1.ColCount:=c;
         form1.Gauge2.MaxValue:= r;
          for j:= 1 to r do
           begin
            for n:= 1 to c do
             begin
              form1.StringGrid1.Cells[n-1,j-1]:= xlbook.cells[j,n]; //считываем значение из каждой ячейки и копируем в нашу таблицу
              if form1.StringGrid1.Cells[n-1,j-1]=form1.Edit1.Text then
              j1:= j-1;
             end;
             form1.Label2.Caption:=sl[i];
            form1.Gauge2.Progress:=j;
           end;
           {----поиск----}
           for j:= 1 to r do
           begin
            strxls:='';
            for n:= 1 to c do
             begin
              if form1.StringGrid1.Cells[n-1,j-1]=form1.Edit1.Text then
              for xx:=0 to c do
                begin
                 strxls:=strxls+' '+form1.StringGrid1.Cells[xx,j-1];
                end;
             end;
             if  strxls<>'' then
             rezultat.Add(strxls);
           end;
          end;
         {------------}
         form1.Gauge1.Progress:=i;   //отоброжаем прогресс оброботки программы
         xlApp.Quit;                 //закрываем приложение Excel
         xlApp := Unassigned;        //очищаем выделенную память
         xlbook:= Unassigned;
      end;
      {---------------access--------------}
      if copy(sl[i],pos('.',sl[i])+1,length(sl[i]))='accdb' then
      begin
       try
         form1.Gauge1.Progress:=i;
         form1.ADOConnection1.Connected:=false;
         form1.ADOConnection1.LoginPrompt:=false;
         form1.ADOConnection1.ConnectionString:='Provider=Microsoft.ACE.OLEDB.12.0;Data Source='+sl[i]+';Persist Security Info=False;'+'Jet OLEDB:Create System Database=true;';
         form1.ADOConnection1.Connected:=true;
         form1.ADOConnection1.GetTableNames(SL1, true);
         form1.ADOTable1.Connection:=form1.ADOConnection1;
         for  n:=0 to (SL1.Count-1) do
          begin
           if Pos('MSys',sl1[n])=0 then
            begin
             form1.ADOTable1.Active:=false;
             straccses:='';
             form1.ADOTable1.TableName:=sl1[n];
             form1.ADOTable1.Active:=true;
              {-----------поиск------------------------------------}
             form1.Gauge2.MaxValue:= form1.DBGrid1.DataSource.DataSet.RecordCount-1;
             for xxx:=0 to  form1.DBGrid1.DataSource.DataSet.RecordCount-1 do
              begin
              straccses:='';
               for xxxx:=0 to form1.DBGrid1.Columns.Count-1 do
                begin
                  if form1.DBGrid1.Columns[xxxx].Field.AsString=form1.Edit1.Text then
                   begin
                    for x1:=0 to  form1.DBGrid1.Columns.Count-1 do
                    straccses:=straccses+form1.DBGrid1.Columns[x1].Field.AsString+' ';
                   end;
                end;
               form1.Label2.Caption:=sl[i];
               form1.Gauge2.Progress:=xxx;
               form1.DBGrid1.DataSource.DataSet.Next;
               if  straccses<>'' then
               rezultat.Add(straccses);
              end;
              {----------------------------------------------------}
            end;
          end;
       except
         ShowMessage('Не удалось подключится к базе access. Действие отменено.');
        Exit;
       end;
      end
      {-----------------------------------}
      else
        form1.Gauge1.Progress:=i;
    end;
    form1.Label1.Caption:='Анализ завершен';
    showmessage(rezultat.GetText);
    sl.Free;
    sl1.Free;
    sl2.Free;
    rezultat.Free;
 end
 
 else
 begin
  ShowMessage('Не найдены файлы! Выберите другую папку.');
  exit;
 end;
end;
 
 
 
 
procedure TForm1.Button1Click(Sender: TObject);
var
 a,s:string;
begin
if form1.Edit1.Text='' then
 showmessage('Не заданы критерии поиска')
else
 GetFileXml;
end;
 
end.