Subversion Repositories checksum-tools

Rev

Rev 6 | Rev 8 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
6 daniel-mar 1
unit Unit3;
2
 
3
interface
4
 
5
uses
6
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
7
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
8
 
9
type
10
  TForm3 = class(TForm)
11
    Memo1: TMemo;
12
    Label1: TLabel;
13
    Memo2: TMemo;
14
    Label2: TLabel;
15
    Memo3: TMemo;
16
    Label3: TLabel;
17
    Memo4: TMemo;
18
    Label4: TLabel;
19
    Button1: TButton;
20
    OpenDialog1: TOpenDialog;
21
    procedure Button1Click(Sender: TObject);
22
    procedure FormShow(Sender: TObject);
7 daniel-mar 23
    procedure FormKeyPress(Sender: TObject; var Key: Char);
6 daniel-mar 24
  private
25
    FChecksumFile: string;
26
  public
27
    function ParamChecksumFile: string;
28
    procedure LoadSFV;
29
    procedure SaveSFV;
30
  end;
31
 
32
var
33
  Form3: TForm3;
34
 
35
implementation
36
 
37
{$R *.dfm}
38
 
39
uses
40
  Common, SFV, MD5, LongFilenameOperations;
41
 
42
procedure TForm3.Button1Click(Sender: TObject);
43
begin
44
  SaveSFV;
45
  LoadSFV;
46
end;
47
 
7 daniel-mar 48
procedure TForm3.FormKeyPress(Sender: TObject; var Key: Char);
49
begin
50
  if Key = #27 then Close;
51
end;
52
 
6 daniel-mar 53
procedure TForm3.FormShow(Sender: TObject);
54
begin
55
  Caption := ParamChecksumFile;
56
  LoadSFV;
57
end;
58
 
59
procedure TForm3.LoadSFV;
60
var
61
  FileName: string;
62
  ADirectory: string;
63
  slSFV: TStringList;
64
  SR: TSearchRec;
65
  IsFound: Boolean;
66
  i: Integer;
67
  TestFilename: string;
68
  SollChecksum: string;
69
  IstChecksum: string;
70
  existingFiles: TStringList;
71
  j: Integer;
72
  csman: TCheckSumFile;
73
begin
74
  FileName := ParamChecksumFile;
75
  ADirectory := ExtractFilePath(FileName);
76
 
77
  if not FileExists(FileName) then
78
  begin
79
    ShowMessageFmt('File not found: %s', [FileName]);
80
    Close;
81
  end;
82
 
83
  Memo1.Clear;
84
  Memo2.Clear;
85
  Memo3.Clear;
86
  Memo4.Clear;
87
 
88
  if SameText(ExtractFileExt(FileName), '.sfv') then
89
    csman := TCheckSumFileSFV.Create(FileName)
90
  else if SameText(ExtractFileExt(FileName), '.md5') then
91
    csman := TCheckSumFileMD5.Create(FileName)
92
  else
93
    Exception.Create('Unknown file extension. Only supporting MD5 and SFV.');
94
 
95
  slSFV := TStringList.Create;
96
  existingFiles := TStringList.Create;
97
  try
98
    // Read SFV/MD5 file
99
    csman.ToStringList(slSFV);
100
 
101
    // List existing files
7 daniel-mar 102
    IsFound := FindFirst(ADirectory + '*', faAnyFile xor faDirectory, SR) = 0;
6 daniel-mar 103
    while IsFound do
104
    begin
105
      if (SR.Name <> '.') and (SR.Name <> '..') then
106
      begin
107
        existingFiles.Add(LowerCase(SR.Name));
108
      end;
109
      IsFound := FindNext(SR) = 0;
110
    end;
111
    FindClose(SR);
112
 
113
    // Checksum mismatch or missing files
114
    for i := 0 to slSFV.Count-1 do
115
    begin
116
      TestFilename := IncludeTrailingPathDelimiter(ADirectory) + slSFV.Strings[i];
117
      SollChecksum := TCheckSum(slSFV.Objects[i]).checksum;
118
      if not FileExists(TestFilename) then
119
      begin
120
        Memo3.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
121
      end
122
      else
123
      begin
124
        IstChecksum  := CalcFileCRC32(TestFilename);
125
        if SameText(SollChecksum, IstChecksum) then
126
        begin
127
          Memo1.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
128
        end
129
        else
130
        begin
131
          Memo2.Lines.Add('; [CURRENT FILE CHECKSUM] ' + csman.MergeLine(slSFV.Strings[i], IstChecksum));
132
          Memo2.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
133
        end;
134
 
135
        j := existingFiles.IndexOf(LowerCase(slSFV.Strings[i]));
136
        if j >= 0 then existingFiles.Delete(j);
137
      end;
138
    end;
139
 
140
    // Check non-indexed files
141
    for i := 0 to existingFiles.Count-1 do
142
    begin
143
      TestFileName := existingFiles[i];
144
      if not SameText(ExtractFileExt(TestFileName), '.sfv') and
145
         not SameText(ExtractFileExt(TestFileName), '.md5') and
146
         not SameText(TestFileName, 'Thumbs.db') then
147
      begin
148
        IstChecksum  := CalcFileCRC32(IncludeTrailingPathDelimiter(ADirectory) + TestFilename);
149
        Memo4.Lines.Add(csman.MergeLine(TestFileName, IstChecksum));
150
      end;
151
    end;
7 daniel-mar 152
 
153
    if (Memo2.Text = '') and (Memo3.Text = '') and (Memo4.Text = '') then
154
      Color := clMoneyGreen
155
    else if (Memo2.Text <> '') then
156
      Color := clRed
157
    else
158
      Color := clYellow;
6 daniel-mar 159
  finally
160
    FreeAndNil(slSFV);
161
    FreeAndNil(existingFiles);
162
    FreeAndNil(csman);
163
  end;
164
end;
165
 
166
function TForm3.ParamChecksumFile: string;
167
begin
168
  if FChecksumFile <> '' then
169
  begin
170
    result := FChecksumFile;
171
  end
172
  else
173
  begin
174
    result := ParamStr(1);
175
    if result = '' then
176
    begin
177
      if not OpenDialog1.Execute then
178
      begin
179
        Close;
180
        Abort;
181
      end;
182
      result := OpenDialog1.FileName;
183
    end;
184
    FChecksumFile := result;
185
  end;
186
end;
187
 
188
procedure TForm3.SaveSFV;
189
var
190
  hFile: THandle;
191
  i: Integer;
192
begin
193
  MyAssignFile(hFile, ParamChecksumFile);
194
  MyRewrite(hFile); // clear File
195
  for i := 0 to memo1.Lines.Count-1 do
196
  begin
197
    if Trim(Memo1.Lines[i]) <> '' then
198
      MyWriteLn(hFile, AnsiString(utf8encode(Memo1.Lines[i])));
199
  end;
200
  for i := 0 to memo2.Lines.Count-1 do
201
  begin
202
    if Trim(Memo2.Lines[i]) <> '' then
203
      MyWriteLn(hFile, AnsiString(utf8encode(Memo2.Lines[i])));
204
  end;
205
  for i := 0 to memo3.Lines.Count-1 do
206
  begin
207
    if Trim(Memo3.Lines[i]) <> '' then
208
      MyWriteLn(hFile, AnsiString(utf8encode(Memo3.Lines[i])));
209
  end;
210
  for i := 0 to memo4.Lines.Count-1 do
211
  begin
212
    if Trim(Memo4.Lines[i]) <> '' then
213
      MyWriteLn(hFile, AnsiString(utf8encode(Memo4.Lines[i])));
214
  end;
215
  MyCloseFile(hFile);
216
end;
217
 
218
end.