Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.02.2016, 12:37   #1
botan32
Пользователь
 
Регистрация: 26.11.2015
Сообщений: 52
По умолчанию Поиск дубликатов файлов

Добрый день! Очень нужна помощь. Написал процедуру, которая ищет файлы дубликаты по имени файла. Все работает норма, но теперь хочу добавить возможность проверки например по дате и размеру, причем с возможностью выбора через CheckBox. Например, если выбран CheckBox проверять по дате, то процедура должна проверять, а если не указан, то не проверять.
Как мне это реализовать?

Вот процедура поиска дублей

Код:
procedure dup(LV1, LV2: TListView);
var
I, J: Integer;
begin
  for I:=0 to LV1.Items.Count - 1 do
  begin
    for J:=0 to LV1.Items.Count - 1 do
    begin
      if I <> J then
      begin
        if LV1.Items[I].Caption = LV1.Items[J].Caption then
        begin
          LV2.Items.Add.Caption:=LV1.Items[j].Caption;
        end;
      end;
    end;
  end;
end;

Последний раз редактировалось Вадим Мошев; 10.02.2016 в 19:21.
botan32 вне форума Ответить с цитированием
Старый 10.02.2016, 12:59   #2
spirit-ua
Форумчанин
 
Аватар для spirit-ua
 
Регистрация: 04.06.2009
Сообщений: 351
По умолчанию

Код:
var
  FName : string;
  FHandle: integer;
  F: TFileStream;
begin
  FName := 'c:\1.txt';

  FHandle := FileOpen(FName, 0);
  Label1.Caption := 'Дата Создания: ' +  DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
  FileClose(FHandle);

  F:=TFileStream.Create(FName, fmOpenRead);
  Label2.Caption := 'Размер: ' +  IntToStr(F.Size) + ' байт';
  F.Free;
end;
Мне разрешено открывать только одну страницу - about :blank. Сперва было скучно, но потом я втянулся. Теперь у меня там живет 2 виртуальных друга, и я слышу голоса из розетки!

Последний раз редактировалось spirit-ua; 10.02.2016 в 13:13.
spirit-ua вне форума Ответить с цитированием
Старый 10.02.2016, 13:11   #3
spirit-ua
Форумчанин
 
Аватар для spirit-ua
 
Регистрация: 04.06.2009
Сообщений: 351
По умолчанию

Код:
var
  FName : string;
  F1: File of byte;
begin
  FName := 'c:\1.txt';

  AssignFile(F1, FName);
  Reset(F1);
  Label2.Caption :=  'Размер: ' +  IntToStr(Filesize(F1)) + ' байт';
  CloseFile(F1);
end;
Мне разрешено открывать только одну страницу - about :blank. Сперва было скучно, но потом я втянулся. Теперь у меня там живет 2 виртуальных друга, и я слышу голоса из розетки!
spirit-ua вне форума Ответить с цитированием
Старый 10.02.2016, 13:21   #4
botan32
Пользователь
 
Регистрация: 26.11.2015
Сообщений: 52
По умолчанию

Из приведенного кода я понимаю, что это получение атрибутов файла. А мне необходимо проверка на дубли с возможностью выбора типа. Например: проверять по имени и дате или проверять по дате и размеру или просто по имени.
botan32 вне форума Ответить с цитированием
Старый 10.02.2016, 13:23   #5
p51x
Старожил
 
Регистрация: 15.02.2010
Сообщений: 15,709
По умолчанию

А можно просто заюзать винапи из группы FindFirstFile и получить WIN32_FIND_DATA со всеми нужными параметрами.
p51x вне форума Ответить с цитированием
Старый 10.02.2016, 13:23   #6
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,526
По умолчанию

Код:
if checkboxSise.checked then ......
Код:
function MyCompareFile(const f1, f2: TfileName; checkname, checksize, checkdatetimecreate: boolean): boolean;
begin
   result:=true;
   if result and checkname then result:=(f1=f2);
   if result and checksize then result:=....
   if result and checkdatetimecreate then result:=...
end;
Код:
for j:=0 to ...
for i:=0 to ...
  if MycompareFile(........) then
программа — запись алгоритма на языке понятном транслятору

Последний раз редактировалось evg_m; 10.02.2016 в 13:34.
evg_m вне форума Ответить с цитированием
Старый 10.02.2016, 13:28   #7
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 18,922
По умолчанию

Не обязательно открывать каждый. FindFirst, FindNext тоже возвращают размер и время создания
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию
Аватар вне форума Ответить с цитированием
Старый 10.02.2016, 13:34   #8
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,629
По умолчанию

Код:
type
  TDupCheckKind = (dckTime, dckCRC32, dckMD5); // к примеру
  TDupCheckKinds = set of TDupCheckKind;
  // можно сделать вместо множество битовую маску и OR-ить в вызове функции
  
// это только пример, в реальной жизни никогда так не делай!!!
// размер, время, суммы, хэши и пр. инфа должна быть получена
// для каждого файла только 1 раз и храниться где-то в памяти.
// Функции GetXXXFunc(const AFileName: string): RESULT_TYPE; - условные.
function IsDuplicateFiles(const AFileName0, AFileName1: string;
  const AKinds: TDupCheckKinds): Boolean;
begin
  // если размеры не совпали, дальнейшее бесмысленно.
  Result:= GetSizeFunc(AFileName0) = GetSizeFunc(AFileName1);
    
  if Result and (dckTime in AKinds) // глупо искать дубликаты только по размеру и времени
    then Result:= GetTimeFunc(AFileName0) = GetTimeFunc(AFileName1);
    
  if Result and (dckCRC32 in AKinds) // по 32-битной контрольной сумме
    then Result:= GetCRC32Func(AFileName0) = GetCRC32Func(AFileName1);
    
  if Result and (dckMD5 in AKinds) // по 128-битному хэшу
    then Result:= GetMD5Func(AFileName0) = GetMD5Func(AFileName1);
end;
  
  
procedure TMyForm.Button100500Click(Sender: TObject);
var
  idx0, idx1: Integer;
  duplicated: Boolean;
  kinds: TDupCheckKinds;
begin
  kinds:= [];
  // здесь лучше юзать не несколько TCheckBox, а компонент TCheckGroup.
  if CheckBoxTime.Checked
    then Include(kinds, dckTime);
  if CheckBoxCRC32.Checked
    then Include(kinds, dckCRC32);
  if CheckBoxMD5.Checked
    then Include(kinds, dckMD5);

  for idx0:= 0 to FileList0.Count - 1 do
    begin

      for idx1:= 0 to FileList1.Count - 1 do
        begin
          duplicated:= IsDuplicateFiles(FileList0.Items[idx0], FileList1.Items[idx1], kinds);
          if duplicated
            then Break;
        end;
        
      if not duplicated
        then FileList1.AddItem(FileList0.Items[idx0], { указатель на полезную инфу, например });
    end;
end;
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...

Последний раз редактировалось min@y™; 10.02.2016 в 13:38.
min@y™ вне форума Ответить с цитированием
Старый 10.02.2016, 14:41   #9
Filka
Форумчанин
 
Регистрация: 29.10.2015
Сообщений: 273
По умолчанию

http://www.vr-online.ru/forum/fajly-...#comment-17117
Filka вне форума Ответить с цитированием
Старый 11.02.2016, 08:39   #10
botan32
Пользователь
 
Регистрация: 26.11.2015
Сообщений: 52
По умолчанию

Из приведенных примеров реализовал следующим образом, но программа не работает. Выдает ошибку. Вот кот:

Код:
function MyCompareFile(const f1, f2: PChar; checkname, checksize, checkdatetimecreate: boolean): boolean;
begin
   result:=true;
   if result and checkname then result:=(f1=f2);
   if result and checksize then result:=(GetFileType(f1)=GetFileType(f2));
   if result and checkdatetimecreate then result:=(GetHashMD5(f1)=GetHashMD5(f2));
end;

procedure dup1(LV1, LV2: TListView);
var
I, J: Integer;
begin
  for I:=0 to LV1.Items.Count - 1 do
  begin
    for J:=0 to LV1.Items.Count - 1 do
    begin
      if I <> J then
      begin
        if MycompareFile(PChar(LV1.Items[j].Caption), PChar(LV2.Items[i].Caption), true,true,false) then
        begin
          LV2.Items.Add.Caption:=LV1.Items[j].Caption;
        end;
      end;
    end;
  end;
end;

Последний раз редактировалось Аватар; 11.02.2016 в 08:58.
botan32 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск дубликатов olegoriginal Microsoft Office Excel 3 12.05.2015 12:58
Поиск дубликатов файлов. kholoshchak Общие вопросы Delphi 3 05.10.2013 08:51
Поиск дубликатов в массиве. Mister_Originalnos Помощь студентам 0 09.12.2010 20:13
поиск дубликатов файлов(имя, тип, размер). Вывод дубликатов на экран с отображением их пути faraon1792 Помощь студентам 4 19.03.2010 23:46
Поиск дубликатов Студент-снова Microsoft Office Excel 10 16.01.2010 18:57