Процедура поиска НЕ ищет файлы вне "своей" папки

[Человек_Борща]

Всем снова привет!

Суть проблемы:

Есть процедура, которая ищет файлы в указанной папке, чекает хеш-суммы, и формирует результат.:

procedure ListFileAndHash(StartDir: string; Mask: string; List: TStrings);
var
  SearchRec: TSearchRec;
  Buff: string;
  Dir: string;
begin
  Dir := ExtractFilePath(ParamStr(0));
  //извлепкаем путь до данного exe-файла независимо от того где ое лежит
  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
      begin
        if StartDir + SearchRec.Name <> ParamStr(0) then
        begin
          case FilesListGenForm.HashGr.ItemIndex of     //Hash type^ MD5 or CRC?
            0: Buff := StartDir + SearchRec.Name + ':' + UpperCase(MD5Print(MD5File(StartDir + SearchRec.Name))); //MD5
            1: Buff := StartDir + SearchRec.Name + ':' + FileCRC(StartDir + SearchRec.Name); //CRC
          end;
          Delete(Buff, 1, Pos(Dir, Buff) + Length(Dir) - 1);
          List.Add(Buff);
        end;
      end
      else if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
      begin
        ListFileAndHash(StartDir + SearchRec.Name + '\', Mask, List);
      end;
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
end;

если сканировать родную папку где лежит исполняемый файл, то выдает норм результат вида:

delphi\bin\brcc.exe:HASH

если указать папку которая не является родной то выдаёт кучу бреда:

brcc.exe:HASH
:HASH
HASH
пустая строка

пробовал

Dir := ExtractFilePath(ParamStr(0));

изменить на

Dir := StartDir;

это исправило ситуаци.. теперь выводит имена файлов и хеши...
Игнорирует написание папок где лежат файлы...

т.е.
Есть папка f:\1 с подпапками.

1\Текстовый документ.txt
1\
1\Текстовый документ.txt
1\2\Текстовый документ.txt
1\2\
1\2\3\Текстовый документ.txt
1\2\3\
1\2\3\4\Текстовый документ.txt
1\2\3\4\

все файлы txt находит(их 4) и суммы вычисляет но игнорирует пути к файлам:

Текстовый документ.txt:D41D8CD98F00B204E9800998ECF8427E
Текстовый документ.txt:D41D8CD98F00B204E9800998ECF8427E
Текстовый документ.txt:D41D8CD98F00B204E9800998ECF8427E
\Текстовый документ.tx:D41D8CD98F00B204E9800998ECF8427E

а нормальной работой процедуры считается вот такой вывод:

\Текстовый документ.txt:D41D8CD98F00B204E9800998ECF8427E
\2\Текстовый документ.txt:D41D8CD98F00B204E9800998ECF8427E
\2\3\Текстовый документ.txt:D41D8CD98F00B204E9800998ECF8427E
\2\3\4\Текстовый документ.txt:D41D8CD98F00B204E9800998ECF8427E

процедура правельно работает если StartDir , присвоить ExtractFilePath(ParamStr(0))/

Если указать другую папку то выводит всякий бред.. как показыно где-то выше=)
Помогите подкорректировать. =)

[Serge_Bliznykov]

не проверял, но, если Вы уберёте вот эту строчку:

 Delete(Buff, 1, Pos(Dir, Buff) + Length(Dir) - 1);

то выводится будет ПОЛНЫЙ ПУТЬ к файлу.

[Человек_Борща]

это строка обрезает все что выше каталога StartDir

К примеру если я укажу папку
f:\papka1\papka2\
то мне выводит все что есть в papka2

Вид будет такой:

\papka2\1.xt
\papka2\papka3\3.txt

все что выше papka2 указано не будет(в том числе и буква диска).
Так надо для работы программы.

так что проблема не сдесь=)

[Serge_Bliznykov]

поможет кто-нибуть?

да.

1) удалите из процедуры ListFileAndHash
var Dir: string;
и, соответственно
Dir := ExtractFilePath(ParamStr(0));

2) добавьте глобальную переменную Dir (например, в описание формы, или просто, через VAR

3) измените вызов ListFileAndHash (там, где Вы её вызываете - (по какому-о событию...)
вызов осуществите так:

   Dir := 'ТутВАшаПапка с файлами';
   ListFileAndHash(Dir, .... <дальше как у Вас было>)

[Человек_Борща]

нет , проверил не работает...

[eoln]

Вполне работает такой метод. Можно ещё свести задачу лишь к удалению N первых символов. Например, можно заменить процедуру на

procedure ListFileAndHash(count: integer; StartDir: string; Mask: string; List: TStrings);

Переменную Dir убрать, а из процедуры рекурсивно вызывать

ListFileAndHash(count, StartDir + SearchRec.Name + '\', Mask, List);

далее заменить удаление из Buf на

Delete(Buff, 1, count);

А при первоначальном вызове процедуры писать

ListFileAndHash(length('f:\1'),'f:\1', '*', ListBox1.Items);

[KPEKEPok]

подкажите пожалуйста. В Листинге программы есть вот такая процедура, которая дальше используется соответственно практически везде.
procedure error(msg:string);
begin
raise exception.create(msg);
end;
препод мне задал вопрос что такое exception.
Я ему отвелил что в данной ситуации я при помощи raise вызываю exception это вызов исключительной ситуации.
он мне задает следующий вопрос:"а что делает exception" почему ты использовал в своей курсовой а я ее не делал.

[Человек_Борща]

о теперь работает .. но был баг..
у файлов указанных через путь всегда оставался слеш в начале:

\1.txt:HASH

избавился вот так:

procedure ListFileAndHash(Count:Integer;StartDir: string; Mask: string; List: TStrings);
var
  SearchRec: TSearchRec;
  Buff: string;
begin
  //извлепкаем путь до данного exe-файла независимо от того где ое лежит
  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
      begin
        if StartDir + SearchRec.Name <> StartDir then
        begin
          case FilesListGenForm.HashGr.ItemIndex of     //Hash type^ MD5 or CRC?
            0: Buff := StartDir + SearchRec.Name + ':' + UpperCase(MD5Print(MD5File(StartDir + SearchRec.Name)));
            1: Buff := StartDir + SearchRec.Name + ':' + FileCRC(StartDir + SearchRec.Name);
          end;
          Delete(Buff, 1,count);
          if Buff[1]='\' then
           Delete(buff, 1, 1);
          List.Add(Buff);
        end;
      end
      else if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
      begin
        ListFileAndHash(count, StartDir + SearchRec.Name + '\', Mask, List);
      end;
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
end;

[Человек_Борща]

KPEKEPok
по видимому запостил в первую попавшуюся тему.
создай свою тему и там пости.. правило "1 вопрос - 1 тема."

[eoln]

Сообщение от Человек_Борща

о теперь работает .. но был баг..
у файлов указанных через путь всегда оставался слеш в начале:

\1.txt:HASH

Странно

Сообщение от Человек_Борща

а нормальной работой процедуры считается вот такой вывод:

\Текстовый документ.txt:D41D8CD98F00B204E9800998ECF8427E
\2\Текстовый документ.txt:D41D8CD98F00B204E9800998ECF8427E
\2\3\Текстовый документ.txt:D41D8CD98F00B204E9800998ECF8427E
\2\3\4\Текстовый документ.txt:D41D8CD98F00B204E9800998ECF8427E