для производственных нужд часто бывает необходима программа для выявления одинаковых файлов
написать подобную программу на самом деле не представляет особого труда
определимся какая структура данных нам будет нужна
type
Tfilelist=record
crcValue:Cardinal; // крк-а файла будет расчитывать функции в Unit2 данного модуля
filename:string; // имя первого файла
list:array of string; // список файла крк- которых сходна
count:integer; // кол-во файлов
end;
var
Filelist:array of Tfilelist; // массив файлов
FilelistCount:integer; // кол-во найденных файлов в папке
напишем не большую процедуру добавления файла в нашу структуру
Procedure AddFileToList(Filename:string);
var rs,x:integer;
crc:Cardinal;
begin
if Filename<>'' then
if fileage(Filename)>0 then begin // если это файл
rs:=-1;
crc:=FileCRC32(Filename); // расчитываем его CRC функция доступна в модули Unit2Crc.pas
for X:=0 to FilelistCount-1 do
if Filelist[x].crcValue=crc then begin // если файл уже есть то записываем в RS его номер
rs:=x;
break;
end;
if rs=-1 then begin // если инф. о файле нет то заносим информацию
FilelistCount:=FilelistCount+1;
Setlength(Filelist,FilelistCount);
rs:=FilelistCount-1;
Filelist[rs].count:=0;
Filelist[rs].crcValue:=crc;
Filelist[rs].filename:=ExtractFileName(Filename);
end;
Filelist[rs].count:=Filelist[rs].count+1;
Setlength(Filelist[rs].list,Filelist[rs].count);
Filelist[rs].list[Filelist[rs].count-1]:=Filename; // добавляем файл в список
end;
end;
берем стандартную заготовку вывода списка файлов
{
Path - путь поиска
maska - маска поиска
recur - true - искать и в подкаталогах
false - искать только в указанной папке
}
procedure FileFinder(Path: string;maska: string;recur: boolean);
var sr : TSearchRec;
begin
if (Path[Length(Path)]='\') then SetLength(Path,Length(Path)-1);
if FindFirst(Path+'\'+maska,faAnyFile,sr)=0
then
begin
if (sr.Attr or faDirectory)=sr.Attr then
begin
if (recur=true) then
begin
if (sr.name<>'.') and (sr.name<>'..') then
FileFinder(path+'\'+sr.Name,maska,recur);
end
end;
while FindNext(sr) = 0 do
if (sr.Attr or faDirectory)=sr.Attr then
begin
if (recur=true) then
begin
if (sr.name<>'.') and (sr.name<>'..') then
FileFinder(path+'\'+sr.Name,maska,recur);
end
end
else
AddFileToList(Path+'\'+sr.Name); // добавим нашу процедуру
end;
FindClose(sr);
end;
ну и самое интересное и простое
выводим список файлов которые уникальны в каталоге
var y,x:Integer;
begin
form1.ListBox1.Items.clear;
for X:=0 to FilelistCount-1 do begin
if Filelist[x].count=1 then begin
form1.ListBox1.Items.Add(inttostr(Filelist[x].crcValue)+':'+Filelist[x].filename);
for y:=0 to Filelist[x].count-1 do
form1.ListBox1.Items.Add(Filelist[x].list[y]);
end;
end;
end;
снимок программы
файл проекта
/07_fajly_kotorye_vstrechajutsja_n_raz.zip
|
