Rev 6 | Go to most recent revision | Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
2 | daniel-mar | 1 | unit MD5; |
2 | |||
3 | interface |
||
4 | |||
5 | uses |
||
6 | Classes; |
||
7 | |||
8 | function md5file(const filename: string): string; |
||
9 | procedure MD5FileToStringList(amd5file: string; slOut: TStringList); |
||
10 | |||
11 | implementation |
||
12 | |||
13 | uses |
||
14 | SysUtils, IdHashMessageDigest, idHash, Common, LongFilenameOperations; |
||
15 | |||
16 | function md5file(const filename: string): string; |
||
17 | var |
||
18 | IdMD5: TIdHashMessageDigest5; |
||
19 | FS: TFileStream; |
||
20 | begin |
||
21 | IdMD5 := TIdHashMessageDigest5.Create; |
||
22 | FS := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite); |
||
23 | try |
||
24 | {$IFDEF UNICODE} // I actually do not know at which version of Delphi/Indy, this has changed. |
||
25 | Result := IdMD5.HashStreamAsHex(FS); |
||
26 | {$ELSE} |
||
27 | Result := IdMD5.AsHex(IdMD5.HashValue(FS)); |
||
28 | {$ENDIF} |
||
29 | finally |
||
30 | FS.Free; |
||
31 | IdMD5.Free; |
||
32 | end; |
||
33 | end; |
||
34 | |||
35 | procedure MD5FileToStringList(amd5file: string; slOut: TStringList); |
||
36 | var |
||
37 | sLine: string; |
||
38 | originalFilename: string; |
||
39 | expectedChecksum: string; |
||
40 | fil: THandle; |
||
41 | csum: TChecksum; |
||
42 | firstLinePassed: boolean; |
||
43 | forceUTF8: boolean; |
||
44 | begin |
||
45 | if not FileExists(amd5file) then |
||
46 | exit; |
||
47 | |||
48 | MyAssignFile(fil, amd5file); |
||
49 | try |
||
50 | MyReset(fil); |
||
51 | firstLinePassed := false; |
||
52 | forceUTF8 := false; |
||
53 | while not MyEOF(fil) do |
||
54 | begin |
||
55 | MyReadLn(fil, sLine); |
||
56 | |||
57 | {$REGION 'Try UTF8 decode'} |
||
58 | if not firstLinePassed and (length(sLine)>2) and (sLine[1]=#$EF) and (sLine[2]=#$BB) and (sLine[3]=#$BF) then |
||
59 | begin |
||
60 | delete(sLine,1,3); // Remove BOM |
||
61 | forceUTF8 := true; |
||
62 | end; |
||
63 | firstLinePassed := true; |
||
64 | |||
65 | if forceUTF8 or (Pos(#$FFFD, Utf8ToString(RawByteString(sLine))) = 0) then |
||
66 | sLine := Utf8ToString(RawByteString(sLine)); |
||
67 | {$ENDREGION} |
||
68 | |||
69 | if Copy(Trim(sLine),1,1) = ';' then continue; |
||
70 | // 25bfdef2651071efdd08bb3404797384 *Example.doc |
||
71 | sLine := Trim(sLine); |
||
72 | if sLine = '' then |
||
73 | continue; |
||
74 | expectedChecksum := Copy(sLine, 1, 32); |
||
75 | Delete(sLine, 1, 32); |
||
76 | sLine := Trim(sLine); |
||
77 | if Copy(sLine, 1, 1) = '*' then |
||
78 | Delete(sLine, 1, 1); |
||
79 | sLine := Trim(sLine); |
||
80 | originalFilename := sLine; |
||
81 | |||
82 | //slOut.Values[originalFilename] := expectedChecksum; // <-- with this, files cannot have an equal sign |
||
83 | slOut.OwnsObjects := true; |
||
84 | csum := TChecksum.Create; |
||
85 | csum.checksum := expectedChecksum; |
||
86 | slOut.AddObject(originalFilename, csum); |
||
87 | end; |
||
88 | finally |
||
89 | MyCloseFile(fil); |
||
90 | end; |
||
91 | end; |
||
92 | |||
93 | end. |