| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Удалить двойные файлы [D6, WinXP]

Алина ©   (2002-09-20 19:39:00) 

Использовала программу "Renamer" (переименовывает mp3 файлы по их тегам) и случайно сняла опцию "Удалять исходные файлы" из-за чего их стало почти в два раза больше.
Захотела написать программу на Дельфи для удаления двойников, написала, а она работает неправильно. Не можете подсказать в чём моя ошибка? (двойника определяю по дате файла и его размеру).


function GetFileDateTime(FileName: String): TDateTime;
Var
FStruct: TOFSTRUCT;
wndFile: Integer;
Begin
wndFile := OpenFile(PChar(FileName), FStruct, OF_SHARE_DENY_NONE);
try
Result:=FileDateToDateTime(FileGetDate(wndFile));
CloseHandle(wndFile);
except
CloseHandle(wndFile);
end;
End;

Function DoSearch(DateFile:TDateTime;AgeFile:Integer;S:String):Boolean;
Begin
Result:=(GetFileDatetime(S)=DateFile) and (FileAge(S)=AgeFile);
IF Result then DeleteFile(S);
End;

Procedure DoCompare(S:String);
Var
FileDate:TDateTime;
Age:Integer;
Name:TSearchRec;
Begin
Form1.Label1.Caption:=S;
FileDate:=GetFileDateTime(S);
Age:=FileAge(S);
IF FindFirst("E:\1\*.mp3",faAnyFile,Name)=0 then
try
IF "E:\1\"+Name.Name<>S then
IF DoSearch(FileDate,Age,"E:\1\"+Name.Name) then Exit;
While FindNext(Name)=0 Do
IF "E:\1\"+Name.Name<>S then
IF DoSearch(FileDate,Age,"E:\1\"+Name.Name) then Exit;
finally
FindClose(Name);
end;
Form1.ProgressBar1.StepIt;
Application.ProcessMessages;
End;

procedure TForm1.Button1Click(Sender: TObject);
Var FileName:TSearchRec;
begin
TButton(Sender).Enabled:=False;
IF FindFirst("E:\1\*.mp3",faAnyFile,FileName)=0 then
try
DoCompare("E:\1\"+FileName.Name);
While FindNext(FileName)=0 Do DoCompare("E:\1\"+FileName.Name);
finally
FindClose(FileName);
end;
TButton(Sender).Enabled:=True;
end;

---

Алина   (2002-09-21 09:37:00) [1]

Спасибо большое, Юрий.
Спаибо большое всем.
А насчёт размера просто перепутала FileAge и FileSize :-)

---

Юрий Зотов   (2002-09-21 08:58:00) [2]

Более простой и более скоростной вариант.

function FilesEqual(FileName1, FileName2: String): Boolean;
var
ms1: TMemoryStream;
begin
Result := False;
ms1 := TMemoryStream.Create;
try
ms1.LoadFromFile(FileName1);
with TMemoryStream.Create do
try
LoadFromFile(FileName2);
Result := (ms1.Size = Size) and CompareMem(ms1.Memory, Memory, Size)
finally
Free
end
finally
ms1.Free
end
end;

---

Kibitzer   (2002-09-20 21:21:00) [3]

А где ты сравниваешь размеры? Чтото я не заметил... :)

А вообще я очень бережно отношусь к информации и не удалил бы файл, считая что он дупликат основываясь только на размере и дате. Мне нужно что бы каждый байтик совпадал - тогда я поверю, что это дупликаты :)

Делаешь примерно также во внешнем цикле проходишься по каждому файлу каталога, а во внутреннем проверяешь его размеры со всеми по порядку (кроме его самого естественно :)) и только если размеры одинаковы сравниваешь их побайтно (кстати размер файла здесь: TSearchRec.Size).

Вот моя функция сравнения файлов (проверена временем):

functionFilesEqual(FileName1, FileName2: String): Boolean;
const
MaxBuf = $f000;
var
fs1, fs2: TFileStream;
buf1, buf2: packed array[1..MaxBuf] ofByte;
i, BytesLeft, Count: Integer;
begin
fs1:=TFileStream.Create(FileName1, fmOpenRead orfmShareDenyNone);
fs1.Position:=0;
fs2:=TFileStream.Create(FileName2, fmOpenRead orfmShareDenyNone);
fs2.Position:=0;
BytesLeft:=fs1.Size;

Result := BytesLeft=fs2.Size;

ifResult then
begin
whileBytesLeft>0 do
begin
ifBytesLeft>MaxBuf thenCount:=MaxBuf elseCount:=BytesLeft;
fs1.Read(buf1[1], Count);
fs2.Read(buf2[1], Count);
fori := 1 toCount do
begin
Result := buf1[i]=buf2[i];
if notResult thenBreak;
end;
Dec(BytesLeft, Count);
end;
end;

fs1.Free;
fs2.Free;
end;

Да. И CloseFileнужно делать всегда после FindFirst(даже если ничего не нашлось). Я делаю поиск так:

z:=FindFirst(aFileName, faAnyFile, sr);
whilez=NO_ERROR do
begin
...
z:=FindNext(sr);
end;
FindClose(sr);

---

Shadow   (2002-09-20 20:47:00) [4]

Ну.. Дык, Renamer дату переименовонного файла ставит дату, когда файл был переименновон. Или нет? Лучше сравнивай ID3 теги

---

Наверх