Форум: "Основная";
Текущий архив: 2002.10.03;
Скачать: [xml.tar.bz2];

Вниз

Удалить двойные файлы   Найти похожие ветки 

← →
Алина   (2002-09-20 19:39) [0]

Использовала программу "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;

---

← →
Shadow   (2002-09-20 20:47) [1]

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

---

← →
Kibitzer   (2002-09-20 21:21) [2]

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

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

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

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

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

Result := BytesLeft=fs2.Size;

if Result then
begin
while BytesLeft>0 do
begin
if BytesLeft>MaxBuf then Count:=MaxBuf else Count:=BytesLeft;
fs1.Read(buf1[1], Count);
fs2.Read(buf2[1], Count);
for i := 1 to Count do
begin
Result := buf1[i]=buf2[i];
if not Result then Break;
end;
Dec(BytesLeft, Count);
end;
end;

fs1.Free;
fs2.Free;
end;

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

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

---

← →
Юрий Зотов   (2002-09-21 08:58) [3]

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

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;

---

← →
Алина   (2002-09-21 09:37) [4]

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

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.10.03;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.011 c