v1.4.4
This commit is contained in:
Aria
commit
9c94d113d3
GPG key ID:
19AB7AA462B8AB3B
10260 changed files with 1237388 additions and 0 deletions
265
attic/SBDiagnose/CheckSum.pas
Normal file
265
attic/SBDiagnose/CheckSum.pas
Normal file
|
|
@ -0,0 +1,265 @@
|
|||
unit CheckSum;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Forms;
|
||||
|
||||
type
|
||||
TChecksumCRC32 = class
|
||||
public
|
||||
constructor Create;
|
||||
procedure Reset;
|
||||
procedure Provide(Data: PByte; Length: Integer);
|
||||
function Checksum: Integer;
|
||||
private
|
||||
FCrc: Integer;
|
||||
FCrcTable: array[0..255] of Integer;
|
||||
end;
|
||||
|
||||
TFile = class
|
||||
public
|
||||
FileName: String;
|
||||
Missing: Boolean;
|
||||
FileSize: Integer;
|
||||
Crc: Integer;
|
||||
end;
|
||||
|
||||
TChecksums = class
|
||||
public
|
||||
constructor Create(const PathName: String);
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Scan;
|
||||
procedure Load;
|
||||
procedure Save;
|
||||
|
||||
procedure Compare(BaseLine: TChecksums; Log: TStrings);
|
||||
private
|
||||
FFiles: TStringList;
|
||||
FCrc: TChecksumCRC32;
|
||||
FPathName: String;
|
||||
|
||||
procedure Process(const FileName: String);
|
||||
procedure InnerScan(const PathName: String);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses SysUtils, StrUtils;
|
||||
|
||||
constructor TChecksumCRC32.Create;
|
||||
var
|
||||
c, n, k: Integer;
|
||||
begin
|
||||
Reset;
|
||||
for n := 0 to 255 do begin
|
||||
c := n;
|
||||
for k := 0 to 7 do begin
|
||||
if c and 1 = 1 then
|
||||
c := Integer($edb88320) xor Integer(Cardinal(c) shr 1)
|
||||
else
|
||||
c := (c shr 1);
|
||||
end;
|
||||
FCrcTable[n] := c;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChecksumCRC32.Reset;
|
||||
begin
|
||||
FCrc := Integer($ffffffff);
|
||||
end;
|
||||
|
||||
procedure TChecksumCRC32.Provide(Data: PByte; Length: Integer);
|
||||
var
|
||||
c, n: Integer;
|
||||
begin
|
||||
c := FCrc;
|
||||
for n := 0 to Length-1 do
|
||||
c := FCrcTable[(c xor PByte(Integer(Data) + n)^) and $ff] xor Integer(Cardinal(c) shr 8);
|
||||
FCrc := c;
|
||||
end;
|
||||
|
||||
function TChecksumCRC32.Checksum: Integer;
|
||||
begin
|
||||
Result := FCrc xor Integer($ffffffff);
|
||||
end;
|
||||
|
||||
constructor TChecksums.Create(const PathName: String);
|
||||
begin
|
||||
FCrc := TChecksumCRC32.Create;
|
||||
FFiles := TStringList.Create;
|
||||
FFiles.Sorted := True;
|
||||
FFiles.Duplicates := dupIgnore;
|
||||
FFiles.CaseSensitive := False;
|
||||
FPathName := IncludeTrailingPathDelimiter(PathName);
|
||||
end;
|
||||
|
||||
destructor TChecksums.Destroy;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
for I := 0 to FFiles.Count -1 do
|
||||
FFiles.Objects[I].Free;
|
||||
FreeAndNil(FFiles);
|
||||
FreeAndNil(FCrc);
|
||||
end;
|
||||
|
||||
function FileSize(fileName : wideString) : Int64;
|
||||
var
|
||||
Sr : TSearchRec;
|
||||
begin
|
||||
Result := 0;
|
||||
if FindFirst(fileName, faAnyFile, Sr) = 0 then
|
||||
Result := Sr.FindData.nFileSizeLow;
|
||||
FindClose(Sr) ;
|
||||
end;
|
||||
|
||||
procedure TChecksums.Scan;
|
||||
begin
|
||||
InnerScan(FPathName);
|
||||
end;
|
||||
|
||||
procedure TChecksums.InnerScan(const PathName: String);
|
||||
var
|
||||
Sr : TSearchRec;
|
||||
begin
|
||||
Application.ProcessMessages;
|
||||
if FindFirst(PathName + '*', faAnyFile, Sr) = 0 then begin
|
||||
try
|
||||
repeat
|
||||
if not AnsiStartsStr('.', Sr.Name) and not AnsiEndsText('.checksum', Sr.Name) then begin
|
||||
if Sr.Attr and faDirectory <> 0 then begin
|
||||
InnerScan(IncludeTrailingPathDelimiter(PathName + Sr.Name));
|
||||
end else begin
|
||||
Process(PathName + Sr.Name);
|
||||
end;
|
||||
end;
|
||||
until FindNext(Sr) <> 0;
|
||||
finally
|
||||
FindClose(Sr);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChecksums.Process(const FileName: String);
|
||||
var
|
||||
FS: TFileStream;
|
||||
Len: Integer;
|
||||
Buffer: array[0..4095] of Byte;
|
||||
Entry: TFile;
|
||||
begin
|
||||
Entry := TFile.Create;
|
||||
Entry.FileName := AnsiLowerCase(FileName);
|
||||
Entry.Missing := not FileExists(Filename);
|
||||
|
||||
Entry.FileSize := 0;
|
||||
Entry.Crc := 0;
|
||||
|
||||
if not Entry.Missing then begin
|
||||
Entry.FileSize := FileSize(FileName);
|
||||
try
|
||||
FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
|
||||
try
|
||||
FCrc.Reset;
|
||||
while FS.Position <> FS.Size do begin
|
||||
Len := FS.Read(Buffer[0], 4096);
|
||||
FCrc.Provide(@Buffer[0], Len);
|
||||
end;
|
||||
Entry.Crc := FCrc.Checksum;
|
||||
finally
|
||||
FreeAndNil(FS);
|
||||
end;
|
||||
except
|
||||
end;
|
||||
end;
|
||||
FFiles.AddObject(Entry.FileName, Entry);
|
||||
end;
|
||||
|
||||
procedure Split(const S: String; Parts: TStringList);
|
||||
begin
|
||||
Parts.Clear;
|
||||
ExtractStrings(['|'], [], PChar(S), Parts);
|
||||
end;
|
||||
|
||||
procedure TChecksums.Load;
|
||||
var
|
||||
Data: TStringList;
|
||||
Parts: TStringList;
|
||||
I : Integer;
|
||||
Entry: TFile;
|
||||
begin
|
||||
if not FileExists(FPathName+'sb.checksum') then
|
||||
Exit;
|
||||
Data := TStringList.Create;
|
||||
Parts := TStringList.Create;
|
||||
Data.LoadFromFile(FPathName+'sb.checksum');
|
||||
for I := 0 to Data.Count -1 do begin
|
||||
Split(Data.Strings[I], Parts);
|
||||
if Parts.Count <> 3 then
|
||||
raise Exception.Create('Checksum file parse error');
|
||||
Entry := TFile.Create;
|
||||
Entry.FileName := FPathName + Parts[0];
|
||||
Entry.Missing := False;
|
||||
Entry.FileSize := StrToInt(Parts[1]);
|
||||
Entry.Crc := StrToInt(Parts[2]);
|
||||
FFiles.AddObject(Entry.FileName, Entry);
|
||||
end;
|
||||
Parts.Free;
|
||||
Data.Free;
|
||||
end;
|
||||
|
||||
procedure TChecksums.Save;
|
||||
var
|
||||
Data: TStringList;
|
||||
I : Integer;
|
||||
Entry: TFile;
|
||||
PathName: String;
|
||||
begin
|
||||
PathName := AnsiLowerCase(FPathName);
|
||||
Data := TStringList.Create;
|
||||
for I := 0 to FFiles.Count -1 do begin
|
||||
Entry := TFile(FFiles.Objects[I]);
|
||||
if not Entry.Missing then
|
||||
Data.Append(AnsiReplaceStr(Entry.FileName, PathName, '') + '|' + IntToStr(Entry.FileSize) + '|0x' + IntToHex(Entry.Crc, 8));
|
||||
end;
|
||||
Data.SaveToFile(FPathName+'sb.checksum');
|
||||
Data.Free;
|
||||
end;
|
||||
|
||||
procedure TChecksums.Compare(BaseLine: TChecksums; Log: TStrings);
|
||||
var
|
||||
I: Integer;
|
||||
L: TStringList;
|
||||
Base: TFile;
|
||||
Local: TFile;
|
||||
A: Integer;
|
||||
begin
|
||||
L := TStringList.Create;
|
||||
L.Sorted := True;
|
||||
L.Duplicates := dupIgnore;
|
||||
L.CaseSensitive := False;
|
||||
for I := 0 to FFiles.Count-1 do
|
||||
L.Add(FFiles.Strings[I]);
|
||||
for I := 0 to BaseLine.FFiles.Count-1 do
|
||||
L.Add(BaseLine.FFiles.Strings[I]);
|
||||
for I := 0 to L.Count-1 do begin
|
||||
Base := nil;
|
||||
Local := nil;
|
||||
if FFiles.Find(L[I], A) then
|
||||
Local := TFile(FFiles.Objects[A]);
|
||||
if BaseLine.FFiles.Find(L[I], A) then
|
||||
Base := TFile(BaseLine.FFiles.Objects[A]);
|
||||
|
||||
if Local = nil then
|
||||
Log.Append('File ' + L[I] + ' is missing.')
|
||||
else if Base = nil then
|
||||
Log.Append('File ' + L[I] + ' is not part of the baseline.')
|
||||
else if Base.FileSize <> Local.FileSize then
|
||||
Log.Append('File ' + L[I] + ' is the wrong size, expected ' +IntToStr(Base.FileSize) + ' but found ' + IntToStr(Local.FileSize) + '.')
|
||||
else if Base.Crc <> Local.Crc then
|
||||
Log.Append('File ' + L[I] + ' did not match checksum.');
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Loading…
Add table
Add a link
Reference in a new issue