Модераторы: Poseidon, Snowy, bems, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> поиск файлов с проходом в директории, найти все файлы 
:(
    Опции темы
neweraser
Дата 7.3.2008, 00:30 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6
я просмотрел много тем, но так и не нашел, что мне нужно (мож плохо  искал  smile ), подскажите пожалуйста, как мне сделать поиск по директориям, допустим по диску D найти все архивные файлы (*.rar)


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
Данкинг
Дата 7.3.2008, 00:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Yersinia pestis
****


Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: 9
Всего: 130
В DRKB посмотри.


--------------------
There's nothing left but silent epitaphs.
PM MAIL WWW   Вверх
neweraser
Дата 7.3.2008, 01:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6
там тоже нет, у меня старая версия, нов качать не буду, интернет плохой



--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
Qu1nt
Дата 7.3.2008, 01:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 602
Регистрация: 13.1.2007

Репутация: 18
Всего: 50
Набросал примерчик:
Код

procedure FindFiles(Dir: string);
const
  EXT = '.rar';
var
  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
        FindFiles(Dir + SearchRec.Name)
      else
        if ExtractFileExt(Dir + SearchRec.Name) = EXT then
          ShowMessage(Dir + SearchRec.Name);
    until
      FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  PATH = 'C:\My Downloads\';
begin
  FindFiles(PATH);
end;
PM MAIL   Вверх
neweraser
Дата 7.3.2008, 02:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6
а как мне вместо ShowMessage(Dir + SearchRec.Name) сделать 
listbox1.items.add(Dir + SearchRec.Name) - выдает ошибку неизвестн. переменная


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
Данкинг
Дата 7.3.2008, 02:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Yersinia pestis
****


Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: 9
Всего: 130
Код

procedure FindFiles(StartFolder, Mask: string; List: TStrings;
  ScanSubFolders: Boolean = True);
var
  SearchRec: TSearchRec;
  FindResult: Integer;
begin
  List.BeginUpdate;
  try
    StartFolder := IncludeTrailingBackslash(StartFolder);
    FindResult := FindFirst(StartFolder + '*.*', faAnyFile, SearchRec);
    try
      while FindResult = 0 do
        with SearchRec do
        begin
          if (Attr and faDirectory) <> 0 then
          begin
            if ScanSubFolders and (Name <> '.') and (Name <> '..') then
              FindFiles(StartFolder + Name, Mask, List, ScanSubFolders);
          end
          else
          begin
            if MatchesMask(Name, Mask) then
              List.Add(StartFolder + Name);
            application.ProcessMessages;
              end;
          FindResult := FindNext(SearchRec);
        end;
    finally
      FindClose(SearchRec);
    end;
  finally
    List.EndUpdate;
  end;
end;


Использование:

Код

FindFiles ('d:\musor','*.dbf',memo1.Items, true);





--------------------
There's nothing left but silent epitaphs.
PM MAIL WWW   Вверх
Qu1nt
Дата 7.3.2008, 10:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 602
Регистрация: 13.1.2007

Репутация: 18
Всего: 50
neweraser, 
Код

Form1.ListBox1.Items.Add(Dir + SearchRec.Name);
PM MAIL   Вверх
Poseidon
Дата 7.3.2008, 11:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 53
Всего: 133
Цитата(neweraser @  7.3.2008,  01:11 Найти цитируемый пост)
там тоже нет, у меня старая версия, нов качать не буду, интернет плохой
В "старой", т.е. в 2.3 тоже это есть. Прошелся бы поиском "SearchRec" по ДРКБ и все нашел


--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
neweraser
Дата 7.3.2008, 20:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6
Цитата(Данкинг @  7.3.2008,  02:32 Найти цитируемый пост)
if MatchesMask(Name, Mask) then

пишет ошибку (неизв переменная), мож что в uses прописать?

Добавлено через 8 минут и 12 секунд
Цитата(Poseidon @  7.3.2008,  11:03 Найти цитируемый пост)
В "старой", т.е. в 2.3 тоже это есть. Прошелся бы поиском "SearchRec" по ДРКБ и все нашел 

у меня версия 2.2  smile 


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
lukas
Дата 7.3.2008, 21:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 771
Регистрация: 23.2.2007

Репутация: 3
Всего: 15
Код

function GetFiles(Path:String; Full: Boolean = False):TStrings;
   Var
   Rec:TSearchRec;
   TMP:TStrings;
   ls: String;
   i: integer;
begin
  Result:=TStringList.Create;
  if Path[Length(Path)]<>'\' Then Path:=Path+'\';
  //ChDir(Path);
  if FindFirst(Path+'\*.*',faAnyFile,Rec)=0 then
    begin
     if (Rec.Name<>'.')and(Rec.Name<>'..') then
       if (Rec.Attr and faDirectory) <> 0 then begin
       TMP:=GetFiles(Path+Rec.Name,True);
       Result.AddStrings(TMP);
       TMP.Free;
       end else Result.Add(Path+Rec.Name);

     while FindNext(Rec)=0 do
       begin
        if (Rec.Name<>'.')and(Rec.Name<>'..') then
         if (Rec.Attr and faDirectory) <> 0 then begin
         TMP:=GetFiles(Path+Rec.Name,True);
         Result.AddStrings(TMP);
         TMP.Free;
         end else Result.Add(Path+Rec.Name);
       end;
    end;

if not Full then
  for i:=0 to Result.Count-1 do
   begin
     ls := Result[i];
     Delete(ls,1,Length(Path));
     Result[i] := ls;
   end;
  FindClose(Rec);
end;


Это сообщение отредактировал(а) lukas - 7.3.2008, 21:07


--------------------
http://code.google.com/p/orionphp/ - opensource скриптовой язык Orion (аналог PHP) для freepascal/delphi.
PM MAIL WWW   Вверх
neweraser
Дата 7.3.2008, 21:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6
lukas, а как отсюда добавить все найденные файлы в lisbox?


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
lukas
Дата 7.3.2008, 22:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 771
Регистрация: 23.2.2007

Репутация: 3
Всего: 15
neweraser, 

Код

ListBox1.Items.Assign(GetFiles('C:\Windows\System32'));



--------------------
http://code.google.com/p/orionphp/ - opensource скриптовой язык Orion (аналог PHP) для freepascal/delphi.
PM MAIL WWW   Вверх
neweraser
Дата 7.3.2008, 22:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6
спасибо!


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
neweraser
Дата 10.3.2008, 15:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6
а как сделать в этой функции чтоб только *.rar искать и размер каждого файла?


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
Riply
Дата 10.3.2008, 16:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Комодератор
Сообщений: 572
Регистрация: 27.3.2007
Где: St. Petersburg

Репутация: 3
Всего: 32
Цитата(neweraser @  10.3.2008,  15:50 Найти цитируемый пост)
а как сделать в этой функции чтоб только *.rar искать и размер каждого файла? 


Хоть раз посмотреть на код, который тебе дали и попробовать понять что там происходит.
Это по поводу "чтоб только *.rar искать"

Насчет размера: поинтересоваться что же это за структура TSearchRec и что в ней есть.
Это можно выяснить в Help-е.




--------------------
Решение задач под заказ
PM MAIL   Вверх
neweraser
Дата 10.3.2008, 16:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6
Цитата(Riply @  10.3.2008,  16:18 Найти цитируемый пост)
Хоть раз посмотреть на код, который тебе дали и попробовать понять что там происходит.

в строчке
Код

if FindFirst(Path+'\*.*',faAnyFile,Rec)=0 then

меняю
Код

if FindFirst(Path+'\*.rar',faAnyFile,Rec)=0 then

даже так пробовал 
Код

if FindFirst(Path+'\*.*',faArchive,Rec)=0 then

и все одновременно, не работает ничего


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
VICTAR
Дата 10.3.2008, 16:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 37
Всего: 80
Может Path заканчивается слешем?
PM MAIL   Вверх
neweraser
Дата 10.3.2008, 16:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6
Добавлено @ 16:43
Цитата(VICTAR @  10.3.2008,  16:39 Найти цитируемый пост)
Может Path заканчивается слешем?

все равно не работает, уже все перепробовал


Это сообщение отредактировал(а) neweraser - 10.3.2008, 16:44


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
Riply
Дата 10.3.2008, 17:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Комодератор
Сообщений: 572
Регистрация: 27.3.2007
Где: St. Petersburg

Репутация: 3
Всего: 32
Цитата(neweraser @  10.3.2008,  16:35 Найти цитируемый пост)
и все одновременно, не работает ничего 


Честно говоря, сама не пробовала использовать фильтр, встроенный в FindFirst.
Так что ничего не могу сказать.
Попробуй фильтровать вручную.

P.S. 
  А в корне директории которую ты открываешь есть rar - ы ? smile 


--------------------
Решение задач под заказ
PM MAIL   Вверх
neweraser
Дата 10.3.2008, 17:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6
Цитата(Riply @  10.3.2008,  17:03 Найти цитируемый пост)
А в корне директории которую ты открываешь есть rar - ы ?  

да, конечно, ну там очень много и другого мусора, поэтому мне как то надо отфильтровывать...


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
Riply
Дата 10.3.2008, 17:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Комодератор
Сообщений: 572
Регистрация: 27.3.2007
Где: St. Petersburg

Репутация: 3
Всего: 32
neweraser, 

Ты используешь именно тот код, который дал тебе lukas ?

Я почему спрашиваю, если да, то мне имеет смысл его скопировать,
и попробовать найти прчину, иначе - это пустая трата времени.


--------------------
Решение задач под заказ
PM MAIL   Вверх
THandle
Дата 10.3.2008, 17:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Хранитель Клуба
Group Icon
Награды: 1



Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

Репутация: 65
Всего: 372
Тему ниасилил. Исходя из первого поста предлагаю простенький код. Работает вроде.

Код

procedure ListFilesInDirectory(const Dir : string; Strings : TStrings);
var
  rSearchRec : TSearchRec;
begin
  if FindFirst(Dir + '*.*', faAnyFile, rSearchRec) = 0 then
    repeat
      if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
      if rSearchRec.Attr = faDirectory then
           ListFilesInDirectory(Dir + '\' + rSearchRec.Name + '\', Strings)
      else
        if ExtractFileExt(rSearchRec.Name)='.rar' then
          Strings.Add(rSearchRec.Name);
    until FindNext(rSearchRec) <> 0;
end;



Вот пример вызова:

  По нажатию на кнопочку ищет все rar архивы в указанном в Edit пути. Указывать надо пути следующего типа:

Код


  C:\\
  C:Program Files\
  D:\\Games\
  и тд.


В Memo выводится список имен всех файлов.

Код

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListFilesInDirectory(Edit1.Text, Memo1.Lines);
end;
PM   Вверх
VICTAR
Дата 10.3.2008, 17:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 37
Всего: 80
THandle, небольшая оговорка, я бы добавил строчку
Код

if not Assigned(Strings) then
  Exit;
 
так сказать "защиту от дурака"
ЗЫ чтобы не было путаницей со слешем есть
Код

function IncludeTrailingBackslash ( const S: string ): string;
PM MAIL   Вверх
THandle
Дата 10.3.2008, 17:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Хранитель Клуба
Group Icon
Награды: 1



Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

Репутация: 65
Всего: 372
VICTAR, 
Цитата(VICTAR @  10.3.2008,  17:40 Найти цитируемый пост)
небольшая оговорка, я бы добавил строчку

ну это пример. тут это не критично smile 
Цитата(VICTAR @  10.3.2008,  17:40 Найти цитируемый пост)
ЗЫ чтобы не было путаницей со слешем есть

Спасибо. Не знал. smile 


Ну вот собственно говоря вот так вот будет пусть: smile 

Код

procedure ListFilesInDirectory(const Dir : string; Strings : TStrings);
var
  rSearchRec : TSearchRec;
begin
  if not Assigned(Strings) then
    Exit;
  if FindFirst(Dir + '*.*', faAnyFile, rSearchRec) = 0 then
    repeat
      if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
      if rSearchRec.Attr = faDirectory then
           ListFilesInDirectory( IncludeTrailingBackslash(Dir + '\' + rSearchRec.Name), Strings)
      else
        if ExtractFileExt(rSearchRec.Name) = '.rar' then
          Strings.Add(rSearchRec.Name);
    until FindNext(rSearchRec) <> 0;
end;


Код

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListFilesInDirectory(IncludeTrailingBackslash(Edit1.Text), Memo1.Lines);
end;


Это сообщение отредактировал(а) THandle - 10.3.2008, 17:54
PM   Вверх
VICTAR
Дата 10.3.2008, 18:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 37
Всего: 80
THandle, пример не совсем корректен. (почему?)
Я бы оставил как последний вариант
Код

procedure ListFilesInDirectory(Dir: string; Strings: TStrings);
var
  rSearchRec: TSearchRec;
begin
  if not Assigned(Strings) then
    Exit;
  Dir := IncludeTrailingBackslash(Dir);
  if FindFirst(Dir + '*.*', faAnyFile, rSearchRec) = 0 then
    repeat
      if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
        if (rSearchRec.Attr and faDirectory) <> 0 then
          ListFilesInDirectory(Dir + rSearchRec.Name, Strings)
        else if ExtractFileExt(rSearchRec.Name) = '.rar' then
          Strings.Add(rSearchRec.Name);
    until FindNext(rSearchRec) <> 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListFilesInDirectory(Edit1.Text, Memo1.Lines);
end;
PM MAIL   Вверх
Riply
Дата 10.3.2008, 18:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Комодератор
Сообщений: 572
Регистрация: 27.3.2007
Где: St. Petersburg

Репутация: 3
Всего: 32
Цитата(Riply @  10.3.2008,  17:17 Найти цитируемый пост)
Я почему спрашиваю, если да, то мне имеет смысл его скопировать,
и попробовать найти прчину


Лень было разбираться (ленивая я, что тут поделать).
Нашла у себя в старых проектах. 
Предупреждаю сразу: с тех пор как я этот код написала, я им не пользовалась.
Нуждается в доработке и тестировании.

Код

uses
 WideStrings;
// Alx enum const (usually - retern value of callback functions)
const
 ALX_SCAN_CURRENT                  =  0;
 ALX_SKIP_CURRENT                   =  ALX_SCAN_CURRENT + 1;
 ALX_STOP_SCAN_CURRENT       =  ALX_SCAN_CURRENT + 2;
 ALX_STOP_SCAN                        =  ALX_SCAN_CURRENT + 3;
 ALX_SUCCESS_SCAN                 =  ALX_SCAN_CURRENT + 4;

type
 PWIN32_FIND_DATAW = ^WIN32_FIND_DATAW;
 TFDFiles_CallBack = function(const pSeachW: PWIN32_FIND_DATAW; const wDirPath: WideString; const Index: integer; pParam: Pointer): DWord;

type
 TWideString_Array = array of WideString;

const
 SR_DIR_COUNT = 64;
 PathDelimW: WideString = '\';

function Ws_IsRoot(PW: PWideChar): Boolean;
begin
 if PW^ = '.' then
  begin
   Inc(PW);
   Result := (PW^ = #0) or ((PW^ = '.') and ((PW + 1)^ = #0));
  end
 else Result := False;
end;

function Enum_FilesFDW(const wDirName: WideString; CallBack: TFDFiles_CallBack; pParam: Pointer; Recurs: Boolean; const pLastErr: PDWord = nil): TPoint;
var
 ContinueScan : Boolean;

 procedure FindFilesRec(const wRootPath: WideString; Rcrs: Boolean);
 var
  FindDataW: WIN32_FIND_DATAW;
  FDHandle: THandle;
  i, DirCount: integer;
  DirArr: TWideString_Array;
 begin
  FDHandle := FindFirstFileW(PWideChar(wRootPath + '*.rar'), FindDataW);
  if FDHandle <> INVALID_HANDLE_VALUE then
   try
    DirCount := 0;
    while ContinueScan do
     begin
      with FindDataW do  { TODO -oSashka : Test attributes for FILE_ATTRIBUTE_REPARSE_POINT !!! }
       if (dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY then
        case CallBack(@FindDataW, wRootPath, Result.X + Result.Y, pParam) of
         ALX_STOP_SCAN: ContinueScan := False;
         ALX_STOP_SCAN_CURRENT: Break;
         ALX_SKIP_CURRENT: ;
         else inc(Result.x);
        end
       else
        if not Ws_IsRoot(@cFileName) then
         case CallBack(@FindDataW, wRootPath, - (Result.X + Result.Y), pParam) of
          ALX_STOP_SCAN: ContinueScan := False;
          ALX_STOP_SCAN_CURRENT: Break;
          ALX_SKIP_CURRENT: ;
          else
           begin
            if Rcrs and ContinueScan then
             begin
              if Length(DirArr) <= DirCount then SetLength(DirArr, Length(DirArr) + SR_DIR_COUNT);
              DirArr[DirCount] := FindDataW.cFileName;
              inc(DirCount);
             end;
            inc(Result.Y);
           end;
         end;
      if not FindNextFileW(FDHandle, FindDataW) then Break;
     end;

   finally
    Windows.FindClose(FDHandle);
   end
  else
   begin
    DirCount := 0;
    if (pLastErr <> nil) and (pLastErr^ = ERROR_SUCCESS) then pLastErr^ := GetLastError;
   end;

  if Rcrs then
   for i:= 0 to DirCount - 1 do
    if ContinueScan then FindFilesRec(WRootPath + DirArr[i] + PathDelimW, Rcrs) else Exit;
 end;

begin
 FillChar(Result, SizeOf(TPoint), 0);
 if pLastErr <> nil then pLastErr^ := ERROR_SUCCESS;
 ContinueScan := True;
 try
  FindFilesRec(IncludeTrailingPathDelimiter(wDirName), Recurs);
 finally
  CallBack(nil, '', Result.X + Result.Y, pParam);
 end;
end;


Ну и пример вызова:

Код

function Enum_CallBack(const pSeachW: PWIN32_FIND_DATAW; const wDirPath: WideString; const Index: integer; ListW: TWideStrings): DWord;
begin
 if pSeachW <> nil then ListW.Add(wDirPath + pSeachW.cFileName);
 Result := ALX_SCAN_CURRENT;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
 ListW: TWideStringList;
 ObjCount: TPoint;
 DirName: WideString;
 RetErr: DWord;
begin
 inherited;
 DirName := 'E:\Delete Files';
 ListW := TWideStringList.Create;
 try
  ObjCount := Enum_FilesFDW(DirName, @Enum_CallBack, ListW, True, @RetErr);
  ListW.Sort;
  ShowMessage(SysErrorMessage(RetErr) + sLineBreak + 'FileCount: ' + IntToStr(ObjCount.X) + ', ' +
              'DirCount: ' + IntToStr(ObjCount.y) + sLineBreak + ListW.Text);
 finally
  ListW.Free;
 end;
end;


Еще раз предупреждаю: требуется доработка.


--------------------
Решение задач под заказ
PM MAIL   Вверх
THandle
Дата 10.3.2008, 18:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Хранитель Клуба
Group Icon
Награды: 1



Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

Репутация: 65
Всего: 372
VICTAR, ладно согласен. Не буду спорить так как твой код(изначально все таки мой smile ) правильнее smile 

Riply, данный пример, ИМХО, сложнее для понимания. smile 

ЗЫ: Всё, всё... больше не флудю.
PM   Вверх
VICTAR
Дата 10.3.2008, 18:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 37
Всего: 80
Riply, выглядит конечно устрашающе  smile , но думаю здесь можно обойтись борландовсими обертками.

Добавлено через 3 минуты и 54 секунды
Цитата(THandle @  10.3.2008,  18:11 Найти цитируемый пост)
Не буду спорить так как твой код(изначально все таки мой smile ) правильнее smile 

вот и я кое что упустил =)
Код

ExtractFileExt(rSearchRec.Name) = '.rar' then

надо заменить на
Код

CompareText(ExtractFileExt(rSearchRec.Name) , '.rar') = 0
PM MAIL   Вверх
Riply
Дата 10.3.2008, 20:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Комодератор
Сообщений: 572
Регистрация: 27.3.2007
Где: St. Petersburg

Репутация: 3
Всего: 32
Цитата(VICTAR @  10.3.2008,  18:12 Найти цитируемый пост)
Riply, выглядит конечно устрашающе  


Ну, здесь я с Вами не могу согласиться.
Я очень даже сипатичная  smile 





--------------------
Решение задач под заказ
PM MAIL   Вверх
VICTAR
Дата 10.3.2008, 22:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 37
Всего: 80
Riply,  smile 
мда... попался.... smile 
PM MAIL   Вверх
neweraser
Дата 11.3.2008, 19:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6
Спасибо, воспользовался примером от VICTAR 


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
Страницы: (3) [Все] 1 2 3 
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.1288 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.