Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Видеокурс программиста и крэкера 5D 2O17
(актуальность: август 2O17)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Ищем файл рекурсивно

Встречаются двое юзеров. Один говорит:
- Я тут свежий антивирус достал, не хочешь себе установить?
- Нет, мне это не нужно.
- Почему?
- Да мой комп так глючит, что на нем ни один вирус не запустится.


 procedure GetAllFiles(mask: string);
 var
   search: TSearchRec;
   directory: string;
 begin
   directory := ExtractFilePath(mask);
 
   // find all files 
   if FindFirst(mask, $23, search) = 0 then
   begin
     repeat
       // add the files to the listbox 
       Form1.ListBox1.Items.Add(directory + search.Name);
       Inc(Count);
     until FindNext(search) <> 0;
   end;
 
   // Subdirectories/ Unterverzeichnisse 
   if FindFirst(directory + '*.*', faDirectory, search) = 0 then
   begin
     repeat
       if ((search.Attr and faDirectory) = faDirectory) and (search.Name[1] <> '.') then
         GetAllFiles(directory + search.Name + '\' + ExtractFileName(mask));
     until FindNext(search) <> 0;
     FindClose(search);
   end;
 end;
 
 procedure TForm1.Button2Click(Sender: TObject);
 var
   directory: string;
   mask: string;
 begin
   Count := 0;
   Listbox1.Items.Clear;
 
   directory := 'C:\temp\';
   mask := '*.*';
 
   Screen.Cursor := crHourGlass;
   try
     GetAllFiles(directory + mask);
   finally
     Screen.Cursor := crDefault;
   end;
   ShowMessage(IntToStr(Count) + ' Files found');
 end;
 
 
 {**************************************}
 { Code from P. Below: }
 
 // recursively scanning all drives 
 
   { excerpt from form declaration, form has a listbox1 for the
     results, a label1 for progress, a button2 to start the scan,
     an edit1 to get the search mask from, a button3 to stop
     the scan. }
   private
     { Private declarations }
     FScanAborted: Boolean;
 
   public
     { Public declarations }
 
 function ScanDrive(root, filemask: string; hitlist: TStrings): Boolean;
 
 implementation
 
 function TForm1.ScanDrive(root, filemask: string; hitlist: TStrings): Boolean;
   function ScanDirectory(var path: string): Boolean;
   var
     SRec: TSearchRec;
     pathlen: Integer;
     res: Integer;
   begin
     label1.Caption := path;
     pathlen := Length(path);
     { first pass, files }
     res := FindFirst(path + filemask, faAnyfile, SRec);
     if res = 0 then
       try
         while res = 0 do
         begin
           hitlist.Add(path + SRec.Name);
           res := FindNext(SRec);
         end;
       finally
         FindClose(SRec)
       end;
     Application.ProcessMessages;
     Result := not (FScanAborted or Application.Terminated);
     if not Result then Exit;
 
     {second pass, directories}
     res := FindFirst(path + '*.*', faDirectory, SRec);
     if res = 0 then
       try
         while (res = 0) and Result do
         begin
           if ((Srec.Attr and faDirectory) = faDirectory) and
             (Srec.Name <> '.') and
             (Srec.Name <> '..') then
           begin
             path := path + SRec.Name + '\';
             Result := ScanDirectory(path);
             SetLength(path, pathlen);
           end;
           res := FindNext(SRec);
         end;
       finally
         FindClose(SRec)
       end;
   end;
 begin
   FScanAborted := False;
   Screen.Cursor := crHourglass;
   try
     Result := ScanDirectory(root);
   finally
     Screen.Cursor := crDefault
   end;
 end;
 
 procedure TForm1.Button2Click(Sender: TObject);
 var
   ch: Char;
   root: string;
 begin
   root := 'C:\';
   for ch := 'A' to 'Z' do
   begin
     root[1] := ch;
     case GetDriveType(PChar(root)) of
       DRIVE_FIXED, DRIVE_REMOTE:
         if not ScanDrive(root, edit1.Text, listbox1.Items) then
           Break;
     end;
   end;
 end;
 
 procedure TForm1.Button3Click(Sender: TObject);
 begin // aborts scan 
   FScanAborted := True;
 end;
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS