1 |
unit FileReadCheckerMain; |
2 |
|
3 |
interface |
4 |
|
5 |
uses |
6 |
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
7 |
Dialogs, StdCtrls, ComCtrls, ExtCtrls, FileCtrl, Math; |
8 |
|
9 |
type |
10 |
TForm1 = class(TForm) |
11 |
Button1: TButton; |
12 |
Edit1: TEdit; |
13 |
Memo1: TMemo; |
14 |
Label1: TLabel; |
15 |
Label2: TLabel; |
16 |
ProgressBar1: TProgressBar; |
17 |
procedure Button1Click(Sender: TObject); |
18 |
procedure FormClose(Sender: TObject; var Action: TCloseAction); |
19 |
private |
20 |
procedure FindFiles(FilesList: TStrings; StartDir, FileMask: string; errorSL: TStrings=nil); |
21 |
procedure EnableDisableControls(enabled: boolean); |
22 |
function Readable(filename: string): boolean; |
23 |
end; |
24 |
|
25 |
var |
26 |
Form1: TForm1; |
27 |
|
28 |
implementation |
29 |
|
30 |
{$R *.dfm} |
31 |
|
32 |
// Recursive procedure to build a list of files |
33 |
procedure TForm1.FindFiles(FilesList: TStrings; StartDir, FileMask: string; errorSL: TStrings=nil); |
34 |
var |
35 |
SR: TSearchRec; |
36 |
DirList: TStrings; |
37 |
IsFound: Boolean; |
38 |
i: integer; |
39 |
begin |
40 |
if StartDir[length(StartDir)] <> PathDelim then |
41 |
StartDir := StartDir + PathDelim; |
42 |
|
43 |
IsFound := FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0; |
44 |
while IsFound do |
45 |
begin |
46 |
Application.ProcessMessages; |
47 |
if Application.Terminated then Abort; |
48 |
FilesList.Add(StartDir + SR.Name); |
49 |
IsFound := FindNext(SR) = 0; |
50 |
end; |
51 |
FindClose(SR); |
52 |
|
53 |
// Build a list of subdirectories |
54 |
DirList := TStringList.Create; |
55 |
IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0; |
56 |
if DirectoryExists(StartDir) and not IsFound then |
57 |
begin |
58 |
// Every directory has always at least 2 items ('.' and '..') |
59 |
// If not, we have an ACL problem. |
60 |
if Assigned(errorSL) then errorSL.Add(StartDir); |
61 |
end; |
62 |
while IsFound do begin |
63 |
if ((SR.Attr and faDirectory) <> 0) and |
64 |
(SR.Name[1] <> '.') then |
65 |
begin |
66 |
Application.ProcessMessages; |
67 |
if Application.Terminated then Abort; |
68 |
DirList.Add(StartDir + SR.Name); |
69 |
end; |
70 |
IsFound := FindNext(SR) = 0; |
71 |
end; |
72 |
FindClose(SR); |
73 |
|
74 |
// Scan the list of subdirectories |
75 |
for i := 0 to DirList.Count - 1 do |
76 |
begin |
77 |
FindFiles(FilesList, DirList[i], FileMask, errorSL); |
78 |
end; |
79 |
|
80 |
DirList.Free; |
81 |
end; |
82 |
|
83 |
function TForm1.Readable(filename: string): boolean; |
84 |
var |
85 |
ss: TFileStream; |
86 |
begin |
87 |
result := false; |
88 |
if not FileExists(filename) then exit; |
89 |
try |
90 |
ss := TFileStream.Create(filename, fmOpenRead or fmShareDenyNone); |
91 |
ss.Free; |
92 |
result := true; |
93 |
except |
94 |
exit; |
95 |
end; |
96 |
end; |
97 |
|
98 |
procedure TForm1.Button1Click(Sender: TObject); |
99 |
var |
100 |
sl: TStringList; |
101 |
fil: string; |
102 |
cnt: integer; |
103 |
c1, c2, f: Int64; |
104 |
elapsedSecs: Int64; |
105 |
begin |
106 |
if not DirectoryExists(edit1.Text) then |
107 |
begin |
108 |
raise Exception.CreateFmt('Directory %s does not exist!', [Edit1.Text]); |
109 |
end; |
110 |
|
111 |
QueryPerformanceFrequency(f); |
112 |
QueryPerformanceCounter(c1); |
113 |
|
114 |
EnableDisableControls(false); |
115 |
try |
116 |
Memo1.Lines.Clear; |
117 |
cnt := 0; |
118 |
sl := TStringList.Create; |
119 |
try |
120 |
sl.BeginUpdate; |
121 |
Label2.Caption := 'Scan folders ...'; |
122 |
|
123 |
FindFiles(sl, edit1.text, '*', Memo1.Lines); |
124 |
Inc(cnt, Memo1.Lines.Count); // failed folders |
125 |
|
126 |
ProgressBar1.Max := sl.Count; |
127 |
ProgressBar1.Min := 0; |
128 |
ProgressBar1.Position := 0; |
129 |
|
130 |
for fil in sl do |
131 |
begin |
132 |
ProgressBar1.Position := ProgressBar1.Position + 1; |
133 |
|
134 |
if not Readable(fil) then |
135 |
begin |
136 |
Memo1.Lines.Add(fil); |
137 |
inc(cnt); |
138 |
end; |
139 |
|
140 |
Label2.Caption := MinimizeName(fil, Label2.Canvas, Label2.Width); |
141 |
|
142 |
Application.ProcessMessages; |
143 |
if Application.Terminated then Abort; |
144 |
end; |
145 |
sl.EndUpdate; |
146 |
finally |
147 |
sl.Free; |
148 |
end; |
149 |
|
150 |
if not Application.Terminated then |
151 |
begin |
152 |
QueryPerformanceCounter(c2); |
153 |
elapsedSecs := Ceil((c2-c1)/f); |
154 |
|
155 |
ShowMessageFmt('Finished. Found %d error(s). Time: %.2d:%.2d:%.2d', [cnt, elapsedSecs div 3600, elapsedSecs mod 3600 div 60, elapsedSecs mod 3600 mod 60]); |
156 |
end; |
157 |
finally |
158 |
EnableDisableControls(true); |
159 |
end; |
160 |
end; |
161 |
|
162 |
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); |
163 |
begin |
164 |
Application.Terminate; |
165 |
end; |
166 |
|
167 |
procedure TForm1.EnableDisableControls(enabled: boolean); |
168 |
begin |
169 |
Button1.Enabled := enabled; |
170 |
Label1.Enabled := enabled; |
171 |
Edit1.Enabled := enabled; |
172 |
Memo1.Enabled := enabled; |
173 |
end; |
174 |
|
175 |
end. |