Subversion Repositories checksum-tools

Rev

Rev 6 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 daniel-mar 1
unit MD5;
2
 
3
interface
4
 
5
uses
6 daniel-mar 6
  Classes, Common;
2 daniel-mar 7
 
6 daniel-mar 8
type
9
  TCheckSumFileMD5 = class(TCheckSumFile)
10
  protected
11
    Fmd5File: string;
12
  public
13
    constructor Create(AFileName: string); override;
14
    procedure ToStringList(slOut: TStringList); override;
15
    function SingleFileChecksum(AFileName: string): string; override;
16
    function MergeLine(AFileName, ACheckSum: string): string; override;
17
  end;
18
 
2 daniel-mar 19
function md5file(const filename: string): string;
20
procedure MD5FileToStringList(amd5file: string; slOut: TStringList);
21
 
22
implementation
23
 
24
uses
6 daniel-mar 25
  SysUtils, IdHashMessageDigest, idHash, LongFilenameOperations;
2 daniel-mar 26
 
27
function md5file(const filename: string): string;
28
var
29
  IdMD5: TIdHashMessageDigest5;
30
  FS: TFileStream;
31
begin
32
  IdMD5 := TIdHashMessageDigest5.Create;
33
  FS := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite);
34
  try
35
{$IFDEF UNICODE} // I actually do not know at which version of Delphi/Indy, this has changed.
36
    Result := IdMD5.HashStreamAsHex(FS);
37
{$ELSE}
38
    Result := IdMD5.AsHex(IdMD5.HashValue(FS));
39
{$ENDIF}
40
  finally
41
    FS.Free;
42
    IdMD5.Free;
43
  end;
44
end;
45
 
46
procedure MD5FileToStringList(amd5file: string; slOut: TStringList);
47
var
48
  sLine: string;
49
  originalFilename: string;
50
  expectedChecksum: string;
51
  fil: THandle;
52
  csum: TChecksum;
53
  firstLinePassed: boolean;
54
  forceUTF8: boolean;
55
begin
56
  if not FileExists(amd5file) then
57
    exit;
58
 
59
  MyAssignFile(fil, amd5file);
60
  try
61
    MyReset(fil);
62
    firstLinePassed := false;
63
    forceUTF8 := false;
64
    while not MyEOF(fil) do
65
    begin
66
      MyReadLn(fil, sLine);
67
 
68
      {$REGION 'Try UTF8 decode'}
69
      if not firstLinePassed and (length(sLine)>2) and (sLine[1]=#$EF) and (sLine[2]=#$BB) and (sLine[3]=#$BF) then
70
      begin
71
        delete(sLine,1,3); // Remove BOM
72
        forceUTF8 := true;
73
      end;
74
      firstLinePassed := true;
75
 
76
      if forceUTF8 or (Pos(#$FFFD, Utf8ToString(RawByteString(sLine))) = 0) then
77
        sLine := Utf8ToString(RawByteString(sLine));
78
      {$ENDREGION}
79
 
80
      if Copy(Trim(sLine),1,1) = ';' then continue;
81
      // 25bfdef2651071efdd08bb3404797384 *Example.doc
82
      sLine := Trim(sLine);
83
      if sLine = '' then
84
        continue;
85
      expectedChecksum := Copy(sLine, 1, 32);
86
      Delete(sLine, 1, 32);
87
      sLine := Trim(sLine);
88
      if Copy(sLine, 1, 1) = '*' then
89
        Delete(sLine, 1, 1);
90
      sLine := Trim(sLine);
91
      originalFilename := sLine;
92
 
93
      //slOut.Values[originalFilename] := expectedChecksum; // <-- with this, files cannot have an equal sign
94
      slOut.OwnsObjects := true;
95
      csum := TChecksum.Create;
96
      csum.checksum := expectedChecksum;
97
      slOut.AddObject(originalFilename, csum);
98
    end;
99
  finally
100
    MyCloseFile(fil);
101
  end;
102
end;
103
 
6 daniel-mar 104
{ TCheckSumFileMD5 }
105
 
106
constructor TCheckSumFileMD5.Create(AFileName: string);
107
begin
108
  inherited;
109
  fmd5File := AFileName;
8 daniel-mar 110
  if not SameText(ExtractFileExt(AFileName),'.md5') then
6 daniel-mar 111
    raise Exception.Create('Invalid checksum file extension.');
112
end;
113
 
114
function TCheckSumFileMD5.MergeLine(AFileName, ACheckSum: string): string;
115
begin
116
  result := ACheckSum + ' *' + AFileName;
117
end;
118
 
119
function TCheckSumFileMD5.SingleFileChecksum(AFileName: string): string;
120
begin
8 daniel-mar 121
  result := LowerCase(md5file(AFileName));
6 daniel-mar 122
end;
123
 
124
procedure TCheckSumFileMD5.ToStringList(slOut: TStringList);
125
begin
126
  inherited;
127
  MD5FileToStringList(fmd5File, slOut);
128
end;
129
 
2 daniel-mar 130
end.