[k_slava11]

Здравствуйте, по работе столкнулся с такой проблемой: нужно из 10 папок в которых 100000 файлов отобрать определенные файлы по назвах. В некоторых папках есть одиннаковые файлы, тоесть файлы, которые изменяльсь. В список мемо я вывел все файлы, теперь нужно отобрать одинаковые имена, сравнить по дате создания и скопировать самые последние.

[einstein]

Тут посмотри www.delphisources.ru/forum/forumdisplay.php?f=53

[poli-smen]

Сообщение от k_slava11

Здравствуйте, по работе столкнулся с такой проблемой: нужно из 10 папок в которых 100000 файлов отобрать определенные файлы по назвах. В некоторых папках есть одиннаковые файлы, тоесть файлы, которые изменяльсь. В список мемо я вывел все файлы, теперь нужно отобрать одинаковые имена, сравнить по дате создания и скопировать самые последние.

Алгоритм примерно такой:
1) сортируешь список по имени файла (без пути, но путь не теряешь),
2) проходишься в цикле по списку и если встречаются подряд 2 одинаковых имени сравниваешь их даты и более старый удаляешь из списка,
3) и наконец опять проходишься в цикле по списку и копируешь все файлы из него в папку назначения.
В принципе пункты 2 и 3 можно объединить в один цикл вместо двух.

[SCrat.ORS]

Актуально или нет - не знаю то тем не менее


функции для получения дат создания файла, и дат изменения файла

Код:

Function GetDateCreate(SR:TSearchRec):String;
Var
  DT: TFileTime;
  ST: TSystemTime;
DD,MM,YY,H,M,S:string;
Begin
Result:='';
FileTimeToLocalFileTime( SR.FindData.ftCreationTime, DT );
FileTimeToSystemTime( DT, ST );
If st.wDay<10 then DD:='0'+inttostr(st.wDay) else DD:=inttostr(st.wDay);
If st.wMonth<10 then MM:='0'+inttostr(st.wMonth) else MM:=inttostr(st.wMonth);
YY:=inttostr(st.wYear);
H:=inttostr(st.wHour);
If st.wMinute<10 then M:='0'+inttostr(st.wMinute) else M:=inttostr(st.wMinute);
If st.wSecond<10 then S:='0'+inttostr(st.wSecond) else S:=inttostr(st.wSecond);
Result := DD+'.'+MM+'.'+YY+' '+H+':'+M+':'+S;
end;

...

Дата создания := GetDateCreate(SR);
Дата изменения := DateTimetostr(FileDateToDateTime(SR.Time));

использовать в цикле поиска фалов

Код:

Var
  SR:TSearchRec;
  FindRes,exten,Name,Dir{путь где ищем все что есть}:string;
  k:Integer;
begin
FindRes:=FindFirst(Dir+'*.*',faAnyFile,SR);
While FindRes=0 do
  begin Name:=Dir; 
  if ((SR.Attr and faDirectory)=faDirectory) and
  ((SR.Name='.')or(SR.Name='..')) then
  begin
  FindRes:=FindNext(SR);
  Continue;
  end;

  if ((SR.Attr and faDirectory)=faDirectory) then /// если найден каталог, то
  begin
  FindFile(Dir+SR.Name+'\'); // входим в процедуру поиска с параметрами текущего каталога + каталог, что мы нашли
  FindRes:=FindNext(SR); // после осмотра вложенного каталога мы продолжаем поиск в этом каталоге
  Continue; // продолжить цикл
  end;
  Name:=Name+SR.Name;
  k:=length(SR.Name); exten:=copy(SR.Name,k-2,3);
  //if exten='txt' then
  try

  end;

... и т.д

[poli-smen]

Сообщение от SCrat.ORS

функции для получения дат создания файла, и дат изменения файла

Код:

Function GetDateCreate(SR:TSearchRec):String;
Var
  DT: TFileTime;
  ST: TSystemTime;
DD,MM,YY,H,M,S:string;
Begin
Result:='';
FileTimeToLocalFileTime( SR.FindData.ftCreationTime, DT );
FileTimeToSystemTime( DT, ST );
If st.wDay<10 then DD:='0'+inttostr(st.wDay) else DD:=inttostr(st.wDay);
If st.wMonth<10 then MM:='0'+inttostr(st.wMonth) else MM:=inttostr(st.wMonth);
YY:=inttostr(st.wYear);
H:=inttostr(st.wHour);
If st.wMinute<10 then M:='0'+inttostr(st.wMinute) else M:=inttostr(st.wMinute);
If st.wSecond<10 then S:='0'+inttostr(st.wSecond) else S:=inttostr(st.wSecond);
Result := DD+'.'+MM+'.'+YY+' '+H+':'+M+':'+S;
end;

Почему так сложно то? Это же можно сделать проще:

Код:

function GetDateCreate(SR: TSearchRec): String;
var
  FT: TFileTime;
  ST: TSystemTime;
  DT: TDateTime;
begin
  FileTimeToLocalFileTime(SR.FindData.ftCreationTime, FT);
  FileTimeToSystemTime(FT, ST);
  DT := SystemTimeToDateTime(ST);
  Result := DateTimeToStr(DT);

  // Или так:
  Result := FormatDateTime('dd.mm.yyyy hh:nn:ss,zzz', DT);
end;

Сообщение от SCrat.ORS

использовать в цикле поиска фалов

Код:

Var
  SR:TSearchRec;
  FindRes,exten,Name,Dir{путь где ищем все что есть}:string;
  k:Integer;
begin
FindRes:=FindFirst(Dir+'*.*',faAnyFile,SR);
While FindRes=0 do
  begin Name:=Dir; 
  if ((SR.Attr and faDirectory)=faDirectory) and
  ((SR.Name='.')or(SR.Name='..')) then
  begin
  FindRes:=FindNext(SR);
  Continue;
  end;

  if ((SR.Attr and faDirectory)=faDirectory) then /// если найден каталог, то
  begin
  FindFile(Dir+SR.Name+'\'); // входим в процедуру поиска с параметрами текущего каталога + каталог, что мы нашли
  FindRes:=FindNext(SR); // после осмотра вложенного каталога мы продолжаем поиск в этом каталоге
  Continue; // продолжить цикл
  end;
  Name:=Name+SR.Name;
  k:=length(SR.Name); exten:=copy(SR.Name,k-2,3);
  //if exten='txt' then
  try

  end;

... и т.д

И здесь тоже всё сложно и запутанно. Вот так попроще будет:

Код:

procedure FindFile(Path: String);
var
  SR: TSearchRec;
  ext: String;
begin
//  Path := IncludeTrailingPathDelimiter(Path);

  if FindFirst(Path + '*.*', faAnyFile, SR) = NO_ERROR then
  try
    repeat
      if (SR.Attr and faDirectory) = faDirectory then // Это каталог
      begin
        if (SR.Name <> '.') and (SR.Name <> '..') then // Если это не системные каталоги
          FindFile(Path + sr.Name + '\'); // то обрабатываем рекурсивно и подкаталоги
      end else // Это файл
      begin
        ext := AnsiLowerCase(ExtractFileExt(SR.Name));
        if ext = '.txt' then
        begin
//          ...
        end;
      end;
    until FindNext(SR) <> NO_ERROR;
  finally
    FindClose(sr); // И не забывать освобождать ресурсы - они не безграничные
  end;
end;

[SCrat.ORS]

сложно, потому что это отдельные части кода, моей одной программки, ... в 1 части, да,.. возможно и можно проще, но не во второй

[poli-smen]

Сообщение от SCrat.ORS

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

Что-то я не увидел связи между тем "почему так сложно" и тем что это "части кода твоей программки". Или ты намекаешь на то, что тебе платят пропорционально количеству строк в твоей программе и поэтому где только можно ты пытаешься увеличить их количество?

Сообщение от SCrat.ORS

в 1 части, да,.. возможно и можно проще, но не во второй

Что значит "но не во второй"? Мой второй код тоже проще и короче твоего. У меня законченный и рабочий код, а твой до конца не дописан: нет завершения цикла while, нет освобождения ресурса FindClose(SR). Кроме того дважды используется FindNext (и нужен ещё третий), хотя достаточно одного, и ещё дважды используется Continue (которое имеет свойство ухудшать читабельность кода, правда не настолько сильно как goto, но всё же). И напоследок ошибки: переменная FindRes у тебя почему-то строкового типа - это ошибка, такое не скомпилируется; и у тебя в программе ошибочно предполагается, что расширение файла всегда трёхсимвольное и всегда маленькими буквами.

Если дописать твою версию до рабочего варианта, получим следующее:

Код:

procedure FindFile(Dir: string);
var
  SR: TSearchRec;
  exten, Name: string;
  FindRes, k: Integer;
begin
  FindRes := FindFirst(Dir + '*.*', faAnyFile, SR);
  if FindRes = 0 then
  try
    while FindRes = 0 do
    begin
      Name := Dir;
      if ((SR.Attr and faDirectory) = faDirectory) and ((SR.Name = '.') or (SR.Name = '..')) then
      begin
        FindRes := FindNext(SR);
        Continue;
      end;
      if ((SR.Attr and faDirectory) = faDirectory) then /// если найден каталог, то
      begin
        FindFile(Dir + SR.Name + '\');
        FindRes := FindNext(SR);
        Continue;
      end;
      Name := Name + SR.Name;
      k := length(SR.Name);
      exten := copy(SR.Name, k - 2, 3);
      if exten = 'txt' then
      begin

      end;
      FindRes := FindNext(SR);
    end;
  finally
    FindClose(SR);
  end;
end;

Теперь сравни с моей версией:

Код:

procedure FindFile(Path: string);
var
  SR: TSearchRec;
  FullFileName, FileExt: string;
begin
  if FindFirst(Path + '*.*', faAnyFile, SR) = NO_ERROR then
  try
    repeat
      FullFileName := Path + sr.Name;
      if (SR.Attr and faDirectory) = faDirectory then // Это каталог
      begin
        if (SR.Name <> '.') and (SR.Name <> '..') then FindFile(FullFileName + '\');
      end else // Это файл
      begin
        FileExt := AnsiLowerCase(ExtractFileExt(FullFileName));
        if FileExt = '.txt' then
        begin

        end;
      end;
    until FindNext(SR) <> NO_ERROR;
  finally
    FindClose(sr);
  end;
end;