Текущий архив: 2004.09.19;
Скачать: CL | DM;

Вниз

Может пригодится. (софтинка)   Найти похожие ветки 

← →
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;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.023 c