Рекурсивный поиск

@Xaker · Регистрация: 19.09.2009

Студворк — интернет-сервис помощи студентам

Собственно нашёл код

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Procedure ScanDir(StartDir: String; Mask:string; List:TStrings);
{ Процедура выводит список директории в список List, начиная с директории, указанной в StartDir. Mask - маска для получения файлов 
Источник delphi.mastak.ru
© А. Подгорецкий }
Var SearchRec : TSearchRec;
Begin
  IF Mask ='' then Mask:= '*.*';
  IF StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';
  IF FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
    Begin
     Repeat
        { Чтобы выполнение "не подвисало" }
      Application.ProcessMessages;
      IF (SearchRec.Attr and faDirectory) <> faDirectory then 
         List.Add(StartDir + SearchRec.Name) else 
          IF (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
        Begin
          List.Add(StartDir + SearchRec.Name + '\');
            { Рекурсивный вызов }
          ScanDir(StartDir + SearchRec.Name + '\',Mask,List);
        End;
     Until FindNext(SearchRec) <> 0;
     FindClose(SearchRec);
   End; {IF}
end;

Delphi
1
ScanDir('c:','',ListBox1.Items);

Проблема заключается в маске...я хочу чтобы в указанной папке и подпапках найти все файлы .exe , а если в маску поставить '*.exe;' то поиск будет только в папке(а в подпапках нет) подскажите как можно исправить чтобы и по подпапкам искало..?

@Mawrat · 19.01.2010, 12:54

Можно применять функцию ExtractFileExt() и сверять расширения.
---
Подправил код с учётом того, что надо искать исполняемые файлы в выбранной папке и во всех её подпапках:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Procedure ScanDir(StartDir: String; Mask:string; List:TStrings);
Var
  SearchRec : TSearchRec;
Begin
  IF Mask ='' then Mask:= '*.*';
  IF StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';
  IF FindFirst(StartDir+Mask, faAnyFile, SearchRec) <> 0 then
    FindClose(SearchRec);
    Exit;
  end;
  Repeat
    { Чтобы выполнение "не подвисало" }
    Application.ProcessMessages;
    IF (SearchRec.Attr and faDirectory) = faDirectory then begin
      List.Add('Папка: ' + StartDir + SearchRec.Name + '\');
      //Рекурсивный вызов выплоняем только для папок.
      ScanDir(StartDir + SearchRec.Name + '\',Mask,List);
    end else IF UpperCase(ExtractFileExt(SearchRec.Name)) = 'EXE' then begin
      List.Add('Исполняемый файл: ' + StartDir + SearchRec.Name);
    end;
  Until FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
end;

@Ferz-2009 · 19.01.2010, 23:56

Вот гляньте!

@Xaker · 20.01.2010, 06:05 **[ТС]**

Mawrat, код не компилирутся и если убрать End; или поставить begin всё равно работает не правильно(

Добавлено через 10 минут
Ferz-2009, спасибо работает) а что если нужно находить несколько форматов...?

@Mawrat · 20.01.2010, 09:19

Подправил:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Procedure ScanDir(StartDir: String; Mask:string; List:TStrings);
Var
  SearchRec : TSearchRec;
Begin
  IF Mask ='' then Mask:= '*.*';
  IF StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';
  IF FindFirst(StartDir+Mask, faAnyFile, SearchRec) <> 0 then Exit;
  Repeat
    { Чтобы выполнение "не подвисало" }
    Application.ProcessMessages;
    IF (SearchRec.Name = '.') or (SearchRec.Name = '..') then begin
      Continue;
    end else if (SearchRec.Attr and faDirectory) = faDirectory then begin
      List.Add('Папка: ' + StartDir + SearchRec.Name + '\');
      //Рекурсивный вызов выплоняем только для папок.
      ScanDir(StartDir + SearchRec.Name + '\',Mask,List);
    end else if UpperCase(ExtractFileExt(SearchRec.Name)) = '.EXE' then begin
      List.Add('Исполняемый файл: ' + StartDir + SearchRec.Name);
    end;
  Until FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
end;

Сообщение от Xaker

Ferz-2009, спасибо работает) а что если нужно находить несколько форматов...?

Xaker, бери за основу код, который Ferz-2009 написал. Адаптация для поиска по набору расширений будет выглядеть так:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
procedure FindIt(const aDir : String; aLog : TStrings);
const
  N = 4;
  ArrExt : array[1..N] of String = (
    '.EXE',
    '.COM',
    '.BAT',
    '.CMD'
  );
var
  StrExt : string;
  StrDir : String;
  SearchRec : TSearchRec;
  i : Integer;
begin
  StrDir := IncludeTrailingBackslash(aDir);
  aLog.Add('Папка: ' + StrDir);
  if FindFirst(StrDir + '*.*', faAnyFile, SearchRec) = 0 then
    repeat
      StrExt := UpperCase( ExtractFileExt(SearchRec.Name) );
      if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
        Continue;
      if (SearchRec.Attr and faDirectory) <> 0 then
        FindIt(StrDir + SearchRec.Name, aLog)
      else
        for i := 1 to N do begin
          if StrExt = ArrExt[i] then begin
            aLog.Add('Файл: ' + StrDir + SearchRec.Name);
            Break;
          end;
        end;
    until FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
end;

Вывод данных идёт в объект типа TStrings. Т. е:

Delphi
1
2
3
4
5
6
//Вывод в TМемо:
FindIt('C:\Example', Memo1.Lines);
//Вывод в TListBox:
FindIt('C:\Example', ListBox1.Items);
//Вывод в TStringList:
FindIt('C:\Example', StringList);

@taras atavin · 20.01.2010, 09:21

Ты вообще где ищешь? В дереве (каталогов, например)? Если нет, то поиск должне быть не рекурсивным, а явно-циклическим.

@Ferz-2009 · 20.01.2010, 21:51

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
procedure Tform1.FindIt(dir:string);
const
  EXT = '.mp3';
var
str:string;
  SearchRec: TSearchRec;
begin
  Dir := IncludeTrailingBackslash(Dir);
  if FindFirst(Dir + '*.*', faAnyFile, SearchRec) = 0 then
    repeat
      if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
        Continue;
      if (SearchRec.Attr and faDirectory) <> 0 then
        FindIt(Dir + SearchRec.Name)
      else
    if ExtractFileExt(Dir + SearchRec.Name) = EXT then
         l.Items.Add(Dir + SearchRec.Name);
         if ExtractFileExt(Dir + SearchRec.Name) = EXT then
 
            list.Items.Add(ChangeFileExt(searchrec.Name,''));
    until
      FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
  end;

Xaker
просто Добавьте в

Delphi
1
2
3
4
const
  EXT = '.mp3';
EXT1 = '.wav';
EXT2 = '.wma'

и так далее, сколько вам угодно, ну и соответсвенно добавьте проверку!

Delphi
1
2
3
4
5
    if ExtractFileExt(Dir + SearchRec.Name) = EXT1 then
         l.Items.Add(Dir + SearchRec.Name);
         if ExtractFileExt(Dir + SearchRec.Name) = EXT1 then
 
            list.Items.Add(ChangeFileExt(searchrec.Name,''));

ну вообщем я думаю разберётесь!

Добавлено через 23 минуты
Mawrat извините не обратил внимание на ваш пост!
так как у вас поудобнее будет!

@ja_far · 26.10.2015, 00:12

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
procedure FindIt(const aDir : String; aLog : TStrings);
const
  N = 4;
  ArrExt : array[1..N] of String = (
    '.EXE',
    '.COM',
    '.BAT',
    '.CMD'
  );
var
  StrExt : string;
  StrDir : String;
  SearchRec : TSearchRec;
  i : Integer;
begin
  StrDir := IncludeTrailingBackslash(aDir);
  aLog.Add('Папка: ' + StrDir);
  if FindFirst(StrDir + '*.*', faAnyFile, SearchRec) = 0 then
    repeat
      StrExt := UpperCase( ExtractFileExt(SearchRec.Name) );
      if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
        Continue;
      if (SearchRec.Attr and faDirectory) <> 0 then
        FindIt(StrDir + SearchRec.Name, aLog)
      else
        for i := 1 to N do begin
          if StrExt = ArrExt[i] then begin
            aLog.Add('Файл: ' + StrDir + SearchRec.Name);
            Break;
          end;
        end;
    until FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
end;

Отличный код с поиском по набору масок! Ничего лучше нигде не нашел. Хотя искал не только по этому форуму.
Один единственный минус с которым мне не удается справится - эта процедура не работает с юникодными именами файлов и папок. Полдня просидел но так и не смог её переделать. Буду очень благодарен за помощь!

@ja_far · 29.10.2015, 12:02

Из того что я понял - вместо FindFirst необходимо использовать FindFirstFileW, вместо string - widestring, char - widechar, TSearchRec - TWIN32FindDataW.

Но когда начал переписывать код - на каждом шагу начали вылазить затыки.
К примеру я не понял как получить имя найденного файла по аналогии с SearchRec.Name

Или же достаточно этот код скомпилить под Delphi 2009 чтобы он начал понимать, ну скажем китайский?

Добавлено через 10 минут
Вот вроде нашел пример таки:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
var H: THandle;
    D: TWIN32FindDataW;
    FileName: widestring;
begin
  ChDir(SendDir+'1\');
  H:= FindFirstFileW('*.*',D);
  repeat
   if (H<>INVALID_HANDLE_VALUE) and (D.cFileName <> widestring('.')) and(D.cFileName<>widestring('..')) then
    begin
      FileName:=d.cFileName;  // тут поидее правильное имя в юникоде
    end;
  until not FindNextFileW(H,D);
  Windows.FindClose(H);
end;

Добавлено через 4 часа 19 минут
Налепил вот такого "горбатого":

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
procedure Find(const aDir : String; aLog : TStrings);
const
  N = 4;
  ArrExt : array[1..N] of String = (
    '.EXE',
    '.COM',
    '.BAT',
    '.CMD'
  );
var H: THandle;
    D: TWIN32FindDataW;
  StrExt : string;
  StrDir, FileName : wideString;
  i: integer;
  
begin
  StrDir := IncludeTrailingBackslash(aDir);
  H:= FindFirstFileW(pwidechar(StrDir+'*.*'),D);
 
  repeat
 
   if (H<>INVALID_HANDLE_VALUE) and (D.cFileName <> widestring('.')) and (D.cFileName<>widestring('..'))
   then FileName:=d.cFileName;
 
      StrExt := UpperCase(ExtractFileExt(FileName));
      if faDirectory <> 0 then Find(StrDir + FileName, aLog)
        else
        for i := 1 to N do begin
          if StrExt = ArrExt[i] then begin
            aLog.Add(StrDir + FileName);
            Break;
          end;
    end;
 
  until not FindNextFileW(H,D);
  Windows.FindClose(H);
end;

Вылетает в OutOfMemory. Помогите подправить! Т.е. хочу чтобы всё было как у вас до этого но прикрутить юникодные имена файлов и папок.

Добавлено через 19 часов 51 минуту
Разобрался, огромное спасибо за помощь) Код не покажу :-Р

Добавлено через 8 часов 54 минуты
Разобрался с циклами и наваял следующее - этот код работает правильно:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
procedure Find(const aDir : String; aLog : TStrings);
const
  N = 2;
  ArrExt : array[1..N] of String = (
    'PSD',
    'JPG'
      );
var H: THandle;
    D: TWIN32FindDataW;
  StrExt : string;
  StrDir, FileName : wideString;
  i: integer;
 
begin
  StrDir := IncludeTrailingBackslash(aDir);
  H:= FindFirstFileW(pwidechar(StrDir+'*.*'),D);
 
   if (H<>INVALID_HANDLE_VALUE)
   then  repeat
   FileName:=d.cFileName;
   StrExt := UpperCase(ExtractFileExt(FileName));
 
if (D.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0) and
(D.cFileName <> widestring('.')) and (D.cFileName <> widestring('..'))
then Find(StrDir + FileName, aLog)
        else
        for i := 1 to N do begin
          if StrExt = '.'+ArrExt[i] then begin
            aLog.Add(StrDir + FileName);
            Break;
          end;
    end;
    until not FindNextFileW(H,D);
  Windows.FindClose(H);
end;

Однако, юникодные имена файлов как были в виде ?????? так и остались, хотя я сохранял список файлов в richedit вместо memo. Что я упустил в этот раз?

Добавлено через 13 часов 2 минуты
Тут есть вообще кто-нибудь живой на этом форуме?

Добавлено через 27 минут
Зря грешил на то что не работает юникод, китайский это не юникод выходит)) Как же тогда сделать универсальный код чтобы мог правильно читать имена любых файлов ?

@Mawrat · 07.11.2015, 09:22

ja_far, для поиска файлов с поддержкой имён в UNICODE (UTF-16) предлагаю взять код уже имеющихся обёрток FindFirst(), FindNext(), FindClose() и приспособить его для работы с UNICODE. Новые функции можно назвать так: FindFirstW(), FindNextW(), FindCloseW(). Для удобства разместить их можно в отдельном модуле. Тогда для доработки имеющегося кода изменения потребуются небольшие.

Вот, что получилось:
Модуль, экспортирующий функции FindFirstW(), FindNextW(), FindCloseW() (без кода поддержки LINUX):

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
unit UFindFileW;
 
{$WARN SYMBOL_PLATFORM OFF}
 
interface
 
uses
  SysUtils, Windows;
 
type
  TSearchRecW = record
    Time: Integer;
    Size: Integer;
    Attr: Integer;
    Name: WideString;
    ExcludeAttr: Integer;
    FindHandle: THandle;
    FindData: TWin32FindDataW;
  end;
 
function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
function FindNextW(var F: TSearchRecW): Integer;
procedure FindCloseW(var F: TSearchRecW);
 
implementation
 
function FindMatchingFileW(var F: TSearchRecW): Integer;
var
  LocalFileTime: TFileTime;
begin
  with F do
  begin
    while FindData.dwFileAttributes and ExcludeAttr <> 0 do
      if not FindNextFileW(FindHandle, FindData) then
      begin
        Result := GetLastError;
        Exit;
      end;
    FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
    FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi,
      LongRec(Time).Lo);
    Size := FindData.nFileSizeLow;
    Attr := FindData.dwFileAttributes;
    Name := FindData.cFileName;
  end;
  Result := 0;
end;
 
procedure FindCloseW(var F: TSearchRecW);
begin
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(F.FindHandle);
    F.FindHandle := INVALID_HANDLE_VALUE;
  end;
end;
 
function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
const
  faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
begin
  F.ExcludeAttr := not Attr and faSpecial;
  F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData);
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Result := FindMatchingFileW(F);
    if Result <> 0 then FindCloseW(F);
  end
  else
    Result := GetLastError;
end;
 
function FindNextW(var F: TSearchRecW): Integer;
begin
  if FindNextFileW(F.FindHandle, F.FindData) then
    Result := FindMatchingFileW(F)
  else
    Result := GetLastError;
end;
 
end.

Модуль формы:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
unit Unit1;
 
{$WARN SYMBOL_PLATFORM OFF}
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
  UFindFileW;
 
type
  //Тип, определяющий журнал.
  TLog = record
    ArrWs : array of WideString; //Массив строк.
    Cnt : Integer; //Количество элементов, добавленных в журнал (в массив).
  end;
 
//Процедура для добавления элемента в журнал.
procedure LogAdd(var aLog : TLog; aWs : WideString);
const
  Capacity = 10000; //Величина приращения длины динамического массива.
begin
  //Если в массиве нет свободного места, то увеличиваем его длину.
  if Length(aLog.ArrWs) = aLog.Cnt then
    SetLength(aLog.ArrWs, Length(aLog.ArrWs) + Capacity);
  //Добавление нового элемента в массив.
  aLog.ArrWs[aLog.Cnt] := aWs;
  Inc(aLog.Cnt);
end;
 
{Поиск файлов с поддержкой UNICODE (UTF-16).
Результаты поиска записываются в журнал aLog.
Поиск выполняется в поддереве директорий, начиная с заданного пути (aDir).
Ограничения на выборку файлов задаются по маске (aMask) и по набору расширений (aArrExt).
Если маска не задана, то используется маска = '*'.
Если набор расширений не задан (Length(aArrExt) = 0), то разрешены все расширения.}
procedure FindFilesW(const aDir, aMask : WideString;
  const aArrExt : array of WideString; var aLog : TLog);
var
  Dir, Mask, Ext : WideString;
  SearchRecW : TSearchRecW;
  i : Integer;
begin
  Dir := IncludeTrailingPathDelimiter(aDir); //Если в конце нет знака '\', то добавляем его.
  Mask := aMask;
  if Mask = '' then
    Mask := '*';
 
  if FindFirstW(Dir + Mask, faAnyFile, SearchRecW) = 0 then
  try
    repeat
      if (SearchRecW.Name = '.') or (SearchRecW.Name = '..') then //Ссылка на текущий или родительский директорий.
        Continue;
      if (SearchRecW.Attr and faDirectory) <> 0 then //Директорий.
        FindFilesW(Dir + SearchRecW.Name, Mask, aArrExt, aLog)
      else if Length(aArrExt) = 0 then //Файл. Если список расширений не задан.
        LogAdd(aLog, 'Файл: ' + SearchRecW.Name)
      else //Файл. Если задан список расширений.
      begin
        Ext := WideUpperCase(ExtractFileExt(SearchRecW.Name)); //Расширение файла в верхнем регистре.
        for i := 0 to High(aArrExt) do
          if Ext = WideUpperCase(aArrExt[i]) then
          begin
            LogAdd(aLog, Dir + SearchRecW.Name);
            Break;
          end;
      end;
    until FindNextW(SearchRecW) <> 0;
  finally
    FindCloseW(SearchRecW);
  end;
  //Приводим длину массива в соответствие с количеством добавленных в него элементов.
  if aLog.Cnt < Length(aLog.ArrWs) then
    SetLength(aLog.ArrWs, aLog.Cnt);
end;
 
//Пример. Поиск файлов и запись результатов в файл журнала.
procedure TForm1.Button1Click(Sender: TObject);
const
  LogFileName = 'Log.UTF-16LE.txt'; //Файл журнала.
var
  ArrExt : array of WideString;
  Path : WideString;
  Log : TLog;
  Fs : TFileStream;
  i : Integer;
begin
  //Путь директория в котором расположен исполняемый файл программы.
  Path := ExtractFilePath(ParamStr(0));
  //Если директорий 'Files\' отсутствует, то создаём его.
  ForceDirectories(Path + 'Files\');
 
  //Составляем список расширений. Если массив расширений оставить пустым,
  //то при поиске будут выбираться файлы с любыми расширениями (но удовлетворяющими заданной маске).
  SetLength(ArrExt, 4);
  ArrExt[0] := '.EXE';
  ArrExt[1] := '.COM';
  ArrExt[2] := '.BAT';
  ArrExt[3] := '.CMD';
  //Поиск файлов в поддереве директорий, начиная с пути 'Files\'.
  Log.Cnt := 0;
  FindFilesW(Path + 'Files\', '*', ArrExt, Log);
 
  //Если директорий 'Logs\' отсутствует, то создаём его.
  ForceDirectories(Path + 'Logs\');
  //Список найденных файлов записываем в файл журнала.
  Fs := TFileStream.Create(Path + 'Logs\Log.UTF-16LE.txt', fmCreate);
  try
    //В начало файла помещаем метку BOM в варианте #$FF#$FE - обозначает кодировку UTF-16LE.
    Fs.Write(#$FF#$FE, 2);
    //Запись в файл строк типа WideString (кодировка UTF-16LE).
    for i := 0 to Log.Cnt - 1 do
    begin
      //Если это не первая строка, то перед ней записываем знак перевода строки.
      if i > 0 then
        Fs.Write(#13#0#10#0, 4);
      //Запись строки типа WideString.
      Fs.Write(Log.ArrWs[i][1], Length(Log.ArrWs[i]) * SizeOf(WideChar));
    end;
  finally
    FreeAndNil(Fs);
  end;
 
  Memo1.Text := 'Выполнен поиск файлов по маске и по набору расширений.';
  Memo1.Lines.Add('Начальный директорий: ' + Path);
  Memo1.Lines.Add('Найдено файлов: ' + IntToStr(Log.Cnt));
  Memo1.Lines.Add('Результаты поиска записаны в файл (UTF-16LE): ' + 'Logs\Log.UTF-16LE.txt')
end;
 
end.

В архиве содержится проект и директорий "Files", который содержит файлы, в именах которых присутствуют славянские буквицы и китайские иероглифы.

@ja_far · 07.11.2015, 16:18

Благодарю! Я свои проблемы уже решил, но думаю многим пригодится.

@HREST · 06.03.2017, 21:03

Сообщение от Mawrat

Подправил:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Procedure ScanDir(StartDir: String; Mask:string; List:TStrings);
Var
  SearchRec : TSearchRec;
Begin
  IF Mask ='' then Mask:= '*.*';
  IF StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';
  IF FindFirst(StartDir+Mask, faAnyFile, SearchRec) <> 0 then Exit;
  Repeat
    { Чтобы выполнение "не подвисало" }
    Application.ProcessMessages;
    IF (SearchRec.Name = '.') or (SearchRec.Name = '..') then begin
      Continue;
    end else if (SearchRec.Attr and faDirectory) = faDirectory then begin
      List.Add('Папка: ' + StartDir + SearchRec.Name + '\');
      //Рекурсивный вызов выплоняем только для папок.
      ScanDir(StartDir + SearchRec.Name + '\',Mask,List);
    end else if UpperCase(ExtractFileExt(SearchRec.Name)) = '.EXE' then begin
      List.Add('Исполняемый файл: ' + StartDir + SearchRec.Name);
    end;
  Until FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
end;

Xaker, бери за основу код, который Ferz-2009 написал. Адаптация для поиска по набору расширений будет выглядеть так:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
procedure FindIt(const aDir : String; aLog : TStrings);
const
  N = 4;
  ArrExt : array[1..N] of String = (
    '.EXE',
    '.COM',
    '.BAT',
    '.CMD'
  );
var
  StrExt : string;
  StrDir : String;
  SearchRec : TSearchRec;
  i : Integer;
begin
  StrDir := IncludeTrailingBackslash(aDir);
  aLog.Add('Папка: ' + StrDir);
  if FindFirst(StrDir + '*.*', faAnyFile, SearchRec) = 0 then
    repeat
      StrExt := UpperCase( ExtractFileExt(SearchRec.Name) );
      if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
        Continue;
      if (SearchRec.Attr and faDirectory) <> 0 then
        FindIt(StrDir + SearchRec.Name, aLog)
      else
        for i := 1 to N do begin
          if StrExt = ArrExt[i] then begin
            aLog.Add('Файл: ' + StrDir + SearchRec.Name);
            Break;
          end;
        end;
    until FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
end;

Вывод данных идёт в объект типа TStrings. Т. е:

Delphi
1
2
3
4
5
6
//Вывод в TМемо:
FindIt('C:\Example', Memo1.Lines);
//Вывод в TListBox:
FindIt('C:\Example', ListBox1.Items);
//Вывод в TStringList:
FindIt('C:\Example', StringList);

а как с помощью данной процедуры загнать в listview???

Новые блоги и статьи Все статьи Все блоги /
Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .	SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .
Реалии Hrethgir 01.03.2026 Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .	Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .	SDL3 для Web (WebAssembly): Сборка библиотек: SDL3, Box2D, FreeType, SDL3_ttf, SDL3_mixer и SDL3_image из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .	SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .

@Ferz-2009 23 / 23 / 2 Регистрация: 26.12.2009 Сообщений: 51
	19.01.2010, 23:56
	Вот гляньте! 2

@Xaker 13 / 12 / 3 Регистрация: 19.09.2009 Сообщений: 179
	20.01.2010, 06:05 [ТС]
	Mawrat, код не компилирутся и если убрать End; или поставить begin всё равно работает не правильно( Добавлено через 10 минут Ferz-2009, спасибо работает) а что если нужно находить несколько форматов...? 0

@taras atavin 4226 / 1796 / 211 Регистрация: 24.11.2009 Сообщений: 27,562
	20.01.2010, 09:21
	Ты вообще где ищешь? В дереве (каталогов, например)? Если нет, то поиск должне быть не рекурсивным, а явно-циклическим. 0

@ja_far 1 / 1 / 0 Регистрация: 25.09.2015 Сообщений: 31
	07.11.2015, 16:18
	Благодарю! Я свои проблемы уже решил, но думаю многим пригодится. 0

Рекурсивный поиск

Решение