Форум: "Потрепаться";
Текущий архив: 2004.09.19;
Скачать: [xml.tar.bz2];
ВнизМожет пригодится. (софтинка) Найти похожие ветки
← →
Mim1 © (2004-08-31 21:50) [0]Для сравнивания вайлов в полизвольном дереве, например я использывал ее для сравнения сожержимого CD с каталогом на жестком диске для выявления отличий.
Алгоритм
1) программа сканирует каталоги
2) выявляет какие файлы присутствуют в одном и отсутствуют в другом
3) сравнивает размер, если размер совподает сравнивает crc
*) на этапе 2,3 если находятся отличия выводятся на дисплей.
Все опирации выполняются в отдельном потоке, дабы не расходывать понопрасну ресурсы компа :)
недостатки
1) для вывода сообщений используйется sincronize что несколько замедляет работу программы
2) crc считается по всему буферу а не только по прочитанной части. (к сожалению обойти я этого не смог, так как функция просчета crc оказалась усвствительной к размеру буфера), однако это не сказывается на работе программы.
← →
Mim1 © (2004-08-31 21:50) [1]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Crc32, math;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TCompThread = class(TThread)
private
FLine:string;
FForm:TForm1;
Procedure PPut;
Procedure XFinish;
{ Private declarations }
protected
procedure Execute; override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
with TCompThread.Create(true) do
begin
FForm := Self;
FreeOnTerminate := true;
resume;
end;
end;
{ TCompThread }
procedure TCompThread.Execute;
Procedure PutLine(const s:string);
begin
fline := s;
Synchronize(PPut);
end;
Function GetFileSizeFN(fn:string):DWORD;
var z : DWORD;
begin
z := CreateFile(pchar(fn),GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE,
NIL,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
RESULT := GetFileSize(z,nil);
CloseHandle(z);
end;
procedure GetFiles(base,path:string; sl:TStrings);
var
sr: TSearchRec;
rz: integer;
_fullpath:string;
begin
base := IncludeTrailingPathDelimiter(base);
_fullpath := base + path;
rz := findfirst(_fullpath+ "*.*",faAnyFile,sr);
while rz = 0 do
begin
if (sr.name <> ".") and (sr.name <> "..") then
if (sr.Attr and faDirectory) = 0 then
sl.Add(path + sr.Name)
else
GetFiles(base,path + sr.name + "\",sl);
rz := findnext(sr);
end;
end;
Function FileCrc(fn:string):cardinal;
const bufsize = 1000000;
var buf:array [1..bufsize] of byte;
crc:cardinal;
cnt:integer;
begin
with TFileStream.create(fn,fmOpenRead) do
try
CRC := CRC32INIT;
repeat
FillChar(buf,bufsize,#0);
cnt := Read(buf,bufsize);
crc := CalculateBufferCRC32(crc,buf,bufsize);
until (cnt < bufsize);
CRC := CRC xor CRC32INIT;
finally
Free;
end;
Result := crc;
end;
var sl1,sl2,fl:TStringList;
pp1,pp2:string;
i,s1,s2:integer;
c1,c2:Cardinal;
begin
PutLine("поехали");
try
pp1 := "D:\vs.net\VSENARD1\";
pp2 := "e:\";
sl1 := TStringList.Create;
try
sl2 := TStringList.Create;
try
GetFiles(pp1,"",sl1);
GetFiles(pp2,"",sl2);
for i:= 0 to sl1.Count-1 do sl1[i] := LowerCase(sl1[i]);
for i:= 0 to sl2.Count-1 do sl2[i] := LowerCase(sl2[i]);
for i:= 0 to sl1.Count-1 do
if sl2.IndexOf(sl1[i])=-1 then
PutLine("Не найден "+sl1[i]+" в sl2");
fl := TStringList.Create;
try
for i:= 0 to sl2.Count-1 do
if sl1.IndexOf(sl2[i])=-1 then
PutLine("Не найден "+sl2[i]+" в sl1")
else
fl.Add(sl2[i]);
for i:= 0 to fl.Count-1 do
begin
s1 := GetFileSizeFN(pp1+fl[i]);
s2 := GetFileSizeFN(pp2+fl[i]);
if s1 <> s2 then
PutLine("Рамер различен "+fl[i]+" p1="+IntToStr(s1)+" p2 = "+IntToStr(s2))
else
begin
c1 := FileCrc(pp1+fl[i]);
c2 := FileCrc(pp2+fl[i]);
if c1 <> c2 then
PutLine("Crc различен "+fl[i]+" p1="+IntToStr(c1)+" p2 = "+IntToStr(c2))
end;
end;
finally
fl.free;
end;
finally
sl2.Free;
end;
finally
sl1.Free;
end;
Synchronize(XFinish);
except
on e:exception do
PutLine("Ошибка :("+e.ClassName);
end;
end;
procedure TCompThread.PPut;
begin
FForm.Memo1.Lines.Add(FLine);
end;
procedure TCompThread.XFinish;
begin
ShowMessage("Фсе :)");
end;
end.
← →
Mim1 © (2004-08-31 21:51) [2]
unit crc32;
interface
function CalculateBufferCRC32( CRC : Cardinal;
const Buffer;
Count : Cardinal ) : Cardinal;
const
CRC32INIT = $FFFFFFFF;
implementation
{----------------------------------------------------------------}
{ Buffer - массив байтов, для которого подсчитывается CRC }
{ CRC - начальное значение CRC }
{ Count - длина буфера }
{----------------------------------------------------------------}
{----------------------------------------------------------------}
{ Расчет 32-битовой CRC, алгоритм аналогичен применяемому в }
{ архиваторах ZIP, ARJ. При этом начальное значение CRC должно }
{ быть равно CRC32INIT, а после окончания подсчета окончательная }
{ CRC вычисляется по формуле : }
{ CRC := CRC xor CRC32INIT; }
{ Hапример : }
{ var }
{ Buffer : array[1..8192] of Char; }
{ CRC : Cardinal; }
{ Count : Cardinal; }
{ ....... }
{ CRC := CRC32INIT; }
{ repeat }
{ BlockRead(F, Buffer, SizeOf( Buffer ), Count); }
{ CRC := CalculateBufferCRC32( CRC, Buffer, Count ); }
{ until Eof(F); }
{ CRC := CRC xor CRC32INIT; }
{ ....... }
{----------------------------------------------------------------}
var
CRC32Table : array[0..255] of longint;
procedure makeCRC32table;
var
crc : Int64;
i,n : byte;
begin
for i := 0 to 255 do
begin
crc := i;
for n := 1 to 8 do
if odd(crc)
then crc := (crc shr 1) xor $EDB88320
else crc := (crc shr 1);
crc32table[i] := crc;
end;
end;
function CalculateBufferCRC32( CRC : Cardinal;
const Buffer;
Count : Cardinal ) : Cardinal;
assembler;
asm
PUSH ESI
PUSH EDI
MOV ESI, Buffer
// MOV ECX, Count // uncomment these strings
// MOV EAX, CRC // if not use REGISTER calling convention
CLD
@@Loop:
MOV EDI, EAX // copy CRC into DI
LODSB // load next byte into AL
XOR EDI, EAX // put array index into DL
SHR EAX, 8 // shift CRC one byte right
SHL DI, 2 // correct DI
XOR EAX, DWORD PTR CRC32Table[EDI] // calculate next CRC value
LOOP @@Loop
POP EDI
POP ESI
end;
initialization
makeCRC32table;
end.
← →
Mim1 © (2004-08-31 21:52) [3]Второй модуль не мой.
← →
KilkennyCat © (2004-08-31 21:53) [4]Спасибо, как раз на днях хотел заняться бардаком в своих файлах.
Страницы: 1 вся ветка
Форум: "Потрепаться";
Текущий архив: 2004.09.19;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.046 c