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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> поиск файлов с проходом в директории, найти все файлы 
:(
    Опции темы
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   Вверх
Страницы: (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.0989 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


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

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