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

@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???

Новые блоги и статьи Все статьи Все блоги /
EmBitz, создание проекта, отладка, прошивка locm 15.07.2025 Создание проекта для Blue Pill (STM32F103C8T6) в EmBitz 2. 30, написания кода blink, запуск отладки в ОЗУ, заливка релизной прошивки во flash используя ST-Link и др. . . .	Трассировка корутин Kotlin с OpenTelemetry mobDevWorks 14.07.2025 Асинхронное программирование меняет правила игры, особенно когда речь заходит о трассировке операций. В Kotlin с его корутинами эта проблема приобретает особый оттенок, который я хотел бы детально. . .	Облачные приложения на Rust: руководство по архитектуре микросервисов golander 13.07.2025 Когда я впервые взялся за проектирование облачной платформы для одного из наших клиентов, выбор стоял между привычными Go и Java. Но после нескольких месяцев разработки микросервисной системы,. . .	Как Node.js выполняет асинхронные операции Reangularity 13.07.2025 Каждый раз, когда я рассказываю про Node. js, возникает один и тот же вопрос: "Как эта штука может быть быстрой, если JavaScript — однопоточный язык?" И это действительно кажется парадоксом. Ведь в. . .	Как писать чистый, тестируемый и качественный код на Python py-thonny 12.07.2025 Помню свой первый проект на Python. Работал тогда быстро, грязно, лишь бы работало. Код был похож на запутанный клубок - переменные по одной букве, функции на 200 строк, комментарии отсутствовали как. . .
Blazor и контроллер сервопривода IoT Meadow Maple Wired 11.07.2025 Я решил разобраться, как можно соединить современные веб-технологии с миром "железа". Интересная комбинация получилась из Blazor в качестве веб-интерфейса и микроконтроллера Meadow с его веб-сервером. . .	Генерация OpenQASM из кода Q# EggHead 10.07.2025 Летом 2024-го я начал эксперименты с библиотекой Q# Bridge, и знаете что? Она оказалась просто находкой для тех, кто работает на стыке разных квантовых экосистем. Основная фишка этой библиотеки -. . .	Изучаем новый шаблон ИИ-чата .NET AI Chat Web App stackOverflow 10.07.2025 В . NET появилось интересное обновление - новый шаблон ИИ-чата под названием . NET AI Chat Web App. Когда я впервые наткнулся на анонс этого шаблона, то сразу понял, что Microsoft наконец-то. . .	Результаты исследования от команды ARP (июль 2025 г.) Programma_Boinc 10.07.2025 Результаты исследования от команды ARP (июль 2025 г. ) Африканский проект по дождям (ARP) World Community Grid снова запущен! Мы рады поделиться обновленной информацией о нашем прогрессе с осени. . .	Angular vs Svelte - что лучше? Reangularity 09.07.2025 Сегодня рынок разделился на несколько четких категорий: тяжеловесы корпоративного уровня (Angular), гибкие универсалы (React), прогрессивные решения (Vue) и новая волна компилируемых фреймворков. . .

@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

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

Решение