Допустим в определенном каталоге производится поиск. В каком-то из подкаталогов (на определенном файле) поиск был прерван. Как продолжить поиск с определенного места.

Поиск реализую функциями FindFirst и FindNext. Ищу текст в HTML-страницах.

Код

//------------------------------------------------------------------------------------------ - function IsLineInFile(FileName, Substr:string):boolean; begin with TStringList.create do   try     LoadFromFile(FileName);     result:=pos(Substr, Text)>0;   finally     Free;   end; end; //------------------------------------------------------------------------------------------ procedure TProgSearch.SearchText(Dir: string); var  SearchRec : TSearchRec;  Separator : string; begin  if Copy(Dir,Length(Dir),1)='\' then Separator := ''  else Separator := '\';  if FindFirst(Dir+Separator+'*.*',faAnyFile,SearchRec) = 0 then     begin      if FileExists(Dir+Separator+SearchRec.Name) then         begin           DirBytes := DirBytes + SearchRec.Size;           Gauge1.Progress := DirBytes;           Gauge1.Update;           if (ExtractFileExt(SearchRec.Name) = '.html') or (ExtractFileExt(SearchRec.Name) = '.htm') then              begin                if IsLineInFile(Dir+Separator+SearchRec.Name, Form1.FindText) then                   begin                     Application.ProcessMessages;                     Form1.FindAddress(Dir+Separator+SearchRec.Name);   //загружаем HTML-страницу в TWebBrowser                     Form1.SearchInHtml(Form1.FindText);                //позиционируем найденный текст на HTML-странице                     Application.ProcessMessages;                   end;              end;         end      else if DirectoryExists(Dir+Separator+SearchRec.Name) then              begin                if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then                   SearchText(Dir+Separator+SearchRec.Name);              end;              while FindNext(SearchRec) = 0 do                begin                  if FileExists(Dir+Separator+SearchRec.Name) then                     begin                       DirBytes := DirBytes + SearchRec.Size;                       Gauge1.Progress := DirBytes;                       Gauge1.Update;                       if (ExtractFileExt(SearchRec.Name) = '.html') or (ExtractFileExt(SearchRec.Name) = '.htm') then                          begin                            if IsLineInFile(Dir+Separator+SearchRec.Name, Form1.FindText) then                               begin                                 Application.ProcessMessages;                                 Form1.FindAddress(Dir+Separator+SearchRec.Name);                                 Form1.SearchInHtml(Form1.FindText);                                 Application.ProcessMessages;                               end;                          end;                     end                  else if DirectoryExists(Dir+Separator+SearchRec.Name) then                          begin                            if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then                                SearchText(Dir+Separator+SearchRec.Name);                          end;                end;     end;  FindClose(SearchRec); end;

Сохраните содержимое переменной TSearchRec и потом передавайте её снова на FindNext() это теория, не вижу причины почему не должно получиться.

Могу предложить решение "в лоб" - сделать  SearchRec : TSearchRec; глобальным, и по надобности делать FindNext по этой самой переменной.

Если ты нашел что-то (текст в html), а потом что-то с этим текстом делаешь (грузишь в StringList), то это не есть "прерывание поиска", и даже если ты выйдешь из этой функции (поиска файла), не сделав FindClose, эта самая глобальная SearchRec у тебя останется на том самом месте, где он остановился. Только потом не забудь FindClose гле-нибудь сделать, а то винды ругаться будут. При выходе из программы.

Вот.

Гы... пока набивал уже того... опередили

Admin, предлагаю внести в "Историю форума VINGRAD.RU" как два ответа, отправленые одновременно:-)

Код

//------------------------------------------------------------------------------------------ - function TForm1.SearchInHtml(Substr: String): boolean; var Text_Find: Boolean; begin  if (Substr = '') then result := false;  //Реализуем поиск:  Text_Find := oRange.findText(Substr, 1000000000, 0);  if Text_Find = True Then     begin       oRange.select;       oRange.scrollIntoView(false);       oRange.collapse(false);       result := true;     end  else    result := false; end; //------------------------------------------------------------------------------------------ - procedure TForm1.FindAddress(URLs_Text: String); var  Flags: OLEVariant; begin  Flags := 0;      Form1.WebBrowser1.Navigate(WideString(URLs_Text), Flags, Flags, Flags, Flags) end; //------------------------------------------------------------------------------------------ -

Разъяснения:

1. Пользователь вводит искомый текст и нажимает "Поиск".
2. Процедура "SearchText" производит поиск HTML-файлов в заданной директории.
3. Если такой файл найден - загружаем его в TwebBrowser (процедура "FindAddress") и показываем найденный текст (функция "SearchInHtml").
4. Если пользователь нажимает повторно "Поиск", то вышеперечисленные действия повторяются.

1. Делаешь глобальный Boolean, который будет показывать факт "запустили поиск / не запустили поиск". Допустим, по умолчанию он false.

2. Соответственно на обработчике кнопки делаешь if / else на этот Boolean, и если этот Boolean = false, запускаешь FindFirst / FindNext пока не нашел и ставишь этот boolean в true

3. Соответственно если true, то делаешь _только_ FindNext (без FindFirst).

Ну и дальше по обстоятельствам.

Могу еще предложить динамическое переназначение обработчиков, но это, я так понимаю, как-нибудь потом...

А как же рекурсивный поиск!

Есть каталог, у него есть подкаталоги.

Допустим поиск будет перерван в каком-то подкаталоге.

Чтобы продолжить поиск нужно «досканировать» этот подкаталог и начать поиск в других подкаталогах.

Так вот, прерывание поисковой функции вырубит всю рекурсию. И если затем опять вызвать функцию «SearchText», поиск будет произведен только в этом подкаталоге.

Когда HTML-страница найдена и загружена в TWebBrowser, нужно как-то приостановить работу по поиску, а потом возобновить его.

Мдя, сморозил я   ... Ща чего-нибудь сообразим...

Ха, сообразил. Потоки и события!

Итак, основная идея. Делаешь отдельный поток. Делаешь событие какое-нибудь. Поиск файлов организовываешь в этом самом отдельном потоке, и как только текст найден, передаешь управление в основной поток, а там (в поиске) ставишь WaitForSingleObject на это событие. Ка только чел нажал "поиск" опять, выставляешь событие, и поиск продолжается. И вся твоя рекурсия останется.

Если надо поподробнее, рубани еще разок, просто зря клавиши нажимать не хочется, вдруг ты с потоками работать умеешь, а я тут пораспишу дофига всего...

Посмотрел я примеры по синхронизации:

C:\Program Files\Borland\Delphi5\Demos\Threads\
C:\Program Files\Borland\Delphi5\Help\Examples\Prgrsbar\

В этих примерах особых аналогий, я не увидел.

Цитата

«…Итак, основная идея. Делаешь отдельный поток. Делаешь событие какое-нибудь. Поиск файлов организовываешь в этом самом отдельном потоке, и как только текст найден, передаешь управление в основной поток, а там (в поиске) ставишь WaitForSingleObject на это событие. Ка только чел нажал "поиск" опять, выставляешь событие, и поиск продолжается. И вся твоя рекурсия останется…»

1. Делаешь отдельный поток – Понятно.
2. Делаешь событие какое-нибудь – Не понятно.
3. Поиск файлов организовываешь в этом самом отдельном потоке – Как?
4. Передаешь управление в основной поток – Как передавать?
5. Cтавишь WaitForSingleObject на это событие – Как?

Eсли можно TwoK, покажи наглядный пример.

TwoK вот кое-что нашел из FAQ "Королевство Delphi":

ВОПРОС:

Как сделать так, чтобы следующая рекурсивная функция
(для поиска файлов) выполнялась в отдельном потоке:

Код

procedure SearchinDir (Mask, Dir : string; var List : TListBox); var  r: integer;  f: TSearchRec; begin  ChDir (Dir); { Перейти в каталог, в котором идёт поиск }  r := FindFirst ('*.*', faAnyFile, f); { Найти все файлы }  while r = 0 do  begin    if MatchesMask (f.Name, Mask) then { Маска совпала }      Form1.ListBox1.Items.add (ExpandFileName (f.Name));    if (f.Attr and faDirectory) = faDirectory then      if (f.Name <> '.') and (f.Name <> '..') then      begin        SearchInDir (Mask, ExpandFileName (f.Name), List); // РЕКУРСИЯ        ChDir (DirOwen); { Возврат в предыдущий (исходный) каталог }      end;    r := FindNext (f);  end;  FindClose (f); end;

ОТВЕТ:

Код

TMyThread = class (TThread) public  Mask,Dir: string;  List: TListBox;  AddStr: string; // это для итема  procedure Execute;override;  procedure AddItem; // для синхронизации end; procedure TMyThread.AddItem; begin  List.Items.Add(AddStr); end; procedure TMyThread.Execute; begin  // Вот здесь и реализуем процедуру поиска  // Только при добавлении итема вызываем  AddStr:=ExpandFileName(..);  Synchronize(AddItem); // Работать с компонентами VCL нужно в основном потоке  // ну и так далее end; В программе AThread:=TMyThread.Create(True); AThread.Mask:='*.*'; AThread.Dir:='C:\'; AThread.List:=...; AThread.FreeOnTerminate:=True; // Это чтоб не освобождать потом AThread.OnTerminate:=Form1.ThreadTerminate; // Чтобы узнать, когда завершено AThread.Resume;

Можно не использовать метод Synchronize, а создать еще одну компоненту
TempList: TListBox, заполнить ее, а затем сделать List.Assign(TempList)
(в основном потоке). Да, и не нужно менять текущий каталог, указывай
путь к нему в функциях FindXXX

Если кто желает, могу сбросить полностью проект поиска файлов (размер - 36.5 КБ). Пишите: [email protected]

Вот пример использования потока, при поиске нужных файлов:

Код

unit UTMyThread; interface uses  Classes, comctrls, Forms, Controls, Dialogs, FileCtrl, Windows, Sysutils; type  TMyThread = class(TThread)  private    CurPath: string;    DirBytes: Int64;            //переменная для отображения процесса поиска    IsLine: boolean;            //переменные для поиска    MyPos: Integer;             //фрагмента текста в файле    procedure LoadHtmlPage;    procedure InitProgressBar;    procedure SearchText(Dir: string);    function IsLineInFile(FileName, Substr:string):boolean;    function IsLineInFile1(FileName, Substr:string):boolean;          protected    procedure Execute; override;  published    constructor CreateIt();    destructor Destroy; override;  end; implementation uses Unit1, UProgressSearch; //------------------------------------------------------------------------------------------ - constructor TMyThread.CreateIt(); begin  inherited Create(true);  Priority := tpNormal;  FreeOnTerminate := true;  Synchronize(InitProgressBar);  Suspended := false; end; //------------------------------------------------------------------------------------------ - destructor TMyThread.Destroy; begin   PostMessage(Form1.Handle,wm_ThreadDoneMsg,self.ThreadID,0);   inherited destroy; end; //------------------------------------------------------------------------------------------ - procedure TMyThread.LoadHtmlPage; begin  ProgSearch.Close;                    //закрываем окно 'Индикации процесса поиска'  Application.ProcessMessages;  Form1.FindAddress(CurPath);          //загружаем HTML-страницу в TWebBrowser  Application.ProcessMessages;  Form1.SearchInHtml(Form1.FindText);  //позиционируем найденный текст на HTML-странице  Application.ProcessMessages;  Suspended := true;                   //останавливаем поток поиска end; //------------------------------------------------------------------------------------------ - //задаем настройки окна индикации поиска procedure TMyThread.InitProgressBar; begin  //задаем настройки ProgressPar  DirBytes := 0;  ProgSearch.Gauge1.Progress := 0;  ProgSearch.Gauge1.MinValue := 0;  ProgSearch.Gauge1.MaxValue := Form1.DirSize; end; //------------------------------------------------------------------------------------------ - procedure TMyThread.Execute; begin  SearchText(Form1.DirFind); end; //------------------------------------------------------------------------------------------ - //проверка фрагмента текста в файле без учета регистра function TMyThread.IsLineInFile(FileName, Substr:string):boolean; begin with TStringList.create do   try     LoadFromFile(FileName);     result:=pos(Substr, Text)>0;   finally     Free;   end; end; //------------------------------------------------------------------------------------------ - //проверка фрагмента текста в файле с учетом регистра function TMyThread.IsLineInFile1(FileName, Substr:string):boolean; begin with TStringList.create do   try     LoadFromFile(FileName);     MyPos := pos(Substr, Text);     if MyPos >0 then        begin          if AnsiStrComp(PChar(Substr), PChar(Copy(Text, MyPos, Length(Substr)))) = 0 then result:=true          else result:=false;        end     else        result:=false;   finally     Free;   end; end; //------------------------------------------------------------------------------------------ - //функция поиска HTML-файлов, на предмет наличия в них фрагмента текста (Form1.FindText) procedure TMyThread.SearchText(Dir: string); var  SearchRec : TSearchRec;  Separator : string; begin  if Copy(Dir,Length(Dir),1)='\' then Separator := ''  else Separator := '\';  if FindFirst(Dir+Separator+'*.*',faAnyFile,SearchRec) = 0 then     begin      if FileExists(Dir+Separator+SearchRec.Name) then         begin           DirBytes := DirBytes + SearchRec.Size;           PostMessage(ProgSearch.Handle, WM_MYMESSAGE, DirBytes, 0);           if (ExtractFileExt(SearchRec.Name) = '.html') or (ExtractFileExt(SearchRec.Name) = '.htm') then              begin                if (Form1.chbWithReg.Checked) then                   if IsLineInFile1(Dir+Separator+SearchRec.Name, Form1.FindText) then IsLine := true                   else IsLine := false                else                   if IsLineInFile(Dir+Separator+SearchRec.Name, Form1.FindText) then IsLine := true                   else IsLine := false;                if (IsLine) then                   begin                     CurPath := Dir+Separator+SearchRec.Name;                     Synchronize(LoadHtmlPage);                   end;              end;         end      else if DirectoryExists(Dir+Separator+SearchRec.Name) then              begin                if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then                   SearchText(Dir+Separator+SearchRec.Name);              end;              while FindNext(SearchRec) = 0 do                begin                  if FileExists(Dir+Separator+SearchRec.Name) then                     begin                       DirBytes := DirBytes + SearchRec.Size;                       PostMessage(ProgSearch.Handle, WM_MYMESSAGE, DirBytes, 0);                       if (ExtractFileExt(SearchRec.Name) = '.html') or (ExtractFileExt(SearchRec.Name) = '.htm') then                          begin                           if (Form1.chbWithReg.Checked) then                              if IsLineInFile1(Dir+Separator+SearchRec.Name, Form1.FindText) then IsLine := true                              else IsLine := false                           else                              if IsLineInFile(Dir+Separator+SearchRec.Name, Form1.FindText) then IsLine := true                              else IsLine := false;                          if (IsLine) then                               begin                                 CurPath := Dir+Separator+SearchRec.Name;                                 Synchronize(LoadHtmlPage);                               end;                          end;                     end                  else if DirectoryExists(Dir+Separator+SearchRec.Name) then                          begin                            if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then                                SearchText(Dir+Separator+SearchRec.Name);                          end;                end;     end;  FindClose(SearchRec); end; //------------------------------------------------------------------------------------------ - end.

>Если кто желает, могу сбросить полностью проект поиска файлов (размер - >36.5 КБ). Пишите: [email protected]
А лучше выложить в инете.