freepascal.ru

Код: Выделить всё

program find;

{$mode objfpc}
{$H+}

uses
  SysUtils, Classes;

procedure ViewDir(Dir: string; FileName: string);
var
  sr,sr1: TSearchRec;
  FileTime,FileSize: Integer;
  FileNames: TFileName;

begin
// Выводим список файлов
  if FindFirst(IncludeTrailingPathDelimiter(Dir) + FileName, not faDirectory, sr) = 0 then
  begin
    writeln(IncludeTrailingPathDelimiter(Dir) + sr.Name);
    while FindNext(sr) = 0 do
    begin
      writeln(IncludeTrailingPathDelimiter(Dir) + sr.Name);
    end;
  end;
  FindClose(sr);

  if FindFirst(IncludeTrailingPathDelimiter(Dir) + '*', faDirectory, sr) = 0 then
  begin
    if ((sr.Attr and faDirectory) <> 0) and (sr.Name <> '.') and (sr.Name <> '..') then
    begin
      ViewDir(IncludeTrailingPathDelimiter(Dir) + sr.Name, FileName);
    end;
    while FindNext(sr) = 0 do
    begin
      if ((sr.Attr and faDirectory) <> 0) and (sr.Name <> '.') and (sr.Name <> '..') then
      begin
        ViewDir(IncludeTrailingPathDelimiter(Dir) + sr.Name, FileName);
      end;
    end;
  end;
  FindClose(sr);
end;

begin
  if ParamStr(1)='/?' then writeln(ParamStr(0),' [patch] /r /?');
  if ParamStr(2)='/r' then ViewDir(copy(ParamStr(0),0,3), '*');
  if ParamStr(1)=''   then ViewDir('', '*');
  readln;
end.

Программа должна находить одинаковые файлы(имя, размер, дата создания).
Если она запускается без параметров то она должна найти одинаковые файлы с места где лежит прога.
Если запускается с параметром /r то с корневого каталога.
Помогите кто знает как реализовать поиск одинаковых файлов

Хм. а чего сложного?
построить список файлов и сравнить каждый с каждым...

PS: по опыту, при построении списка с учетом вложенности на больших каталогах с глубокой вложенностью, рекурсию лучше построить следующим образом:

Код: Выделить всё

function AddFilesToList(List: TStringList; Dir: string);
begin
  1. поместить список файлов и каталогов из каталога Dir во временный список
  2. пройтись циклом по списку, файлы добавлять в List, а для каталогов вызывать рекурсивно AddFilesToList
end;

На сколько я помню это решение быстрее чем решение в лоб без временного списка.
Или можно файлы сразу добавлять в список, а каталоги потом отдельно.

А поточнее если можно?

Код: Выделить всё

procedure SearchInDir(PathIn:String; St:TStringList);
var
   SearchRec: TSearchRec;
   i:integer;
   Attr:Integer;
begin
   Attr:=faAnyFile;
   PathIn:=PathIn+'\*.*';
   i:=FindFirst(PathIn,Attr,SearchRec);
   while i=0 do
      begin
         PathIn:=ExtractFilePath(PathIn)+SearchRec.Name;
         if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
         if (SearchRec.Attr and faDirectory)>0 then
            begin
               SearchInDir(PathIn,St);
            end else St.Add(PathIn);
         i:=FindNext(SearchRec);
      end;
   FindClose(SearchRec);
end;


Было написано для Делфи, но вроде и под fpc тоже должно работать

2 Padre_Mortius
St:TStringList - файл лист я сам должен заранее составить?

Создать TStringList нужно самостоятельно, а заполнение будет идти по мере выполнения процедуры SearchInDir

Код: Выделить всё

procedure TForm1.FirstBtnClick(Sender: TObject);
var
   Path:String;
   St:TStringList;
begin
   Path:='c:\windows';
   St:=TStringList.Create;
   SearchInDir(Path,St);
   St.SaveToFile('c:\text.txt');
   St.Free;
end;


А собственно как находить одинаковые? Ведь нужно не только имя файла сравнивать но и размер с датой создания.

а подумать ?

ЗЫ интересно ему напишут программу или поток желающих помогать рано или поздно иссякнет =)

Просто как я понимаю в файл лист записывается только имя файла не больше

Да. А кто мешает ее дописать? Вообще-то определять одинаковые файлы стоит не по одному параметру, а по нескольким (имя, размер и crc32). И тогда можешь получить 100% верный результат. А такой параметр как дата можно даже не учитывать (если файл пересохранили без изменений, то дата изменилась, а остальные параметры нет).

Добавлено спустя 2 часа 10 минут 56 секунд:
В принципе основные вопросы освещены. Осталось только все это реализовать)