| 0,0 → 1,175 |
|---|
| unit FileReadCheckerMain; |
| |
| interface |
| |
| uses |
| Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
| Dialogs, StdCtrls, ComCtrls, ExtCtrls, FileCtrl, Math; |
| |
| type |
| TForm1 = class(TForm) |
| Button1: TButton; |
| Edit1: TEdit; |
| Memo1: TMemo; |
| Label1: TLabel; |
| Label2: TLabel; |
| ProgressBar1: TProgressBar; |
| procedure Button1Click(Sender: TObject); |
| procedure FormClose(Sender: TObject; var Action: TCloseAction); |
| private |
| procedure FindFiles(FilesList: TStrings; StartDir, FileMask: string; errorSL: TStrings=nil); |
| procedure EnableDisableControls(enabled: boolean); |
| function Readable(filename: string): boolean; |
| end; |
| |
| var |
| Form1: TForm1; |
| |
| implementation |
| |
| {$R *.dfm} |
| |
| // Recursive procedure to build a list of files |
| procedure TForm1.FindFiles(FilesList: TStrings; StartDir, FileMask: string; errorSL: TStrings=nil); |
| var |
| SR: TSearchRec; |
| DirList: TStrings; |
| IsFound: Boolean; |
| i: integer; |
| begin |
| if StartDir[length(StartDir)] <> PathDelim then |
| StartDir := StartDir + PathDelim; |
| |
| IsFound := FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0; |
| while IsFound do |
| begin |
| Application.ProcessMessages; |
| if Application.Terminated then Abort; |
| FilesList.Add(StartDir + SR.Name); |
| IsFound := FindNext(SR) = 0; |
| end; |
| FindClose(SR); |
| |
| // Build a list of subdirectories |
| DirList := TStringList.Create; |
| IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0; |
| if DirectoryExists(StartDir) and not IsFound then |
| begin |
| // Every directory has always at least 2 items ('.' and '..') |
| // If not, we have an ACL problem. |
| if Assigned(errorSL) then errorSL.Add(StartDir); |
| end; |
| while IsFound do begin |
| if ((SR.Attr and faDirectory) <> 0) and |
| (SR.Name[1] <> '.') then |
| begin |
| Application.ProcessMessages; |
| if Application.Terminated then Abort; |
| DirList.Add(StartDir + SR.Name); |
| end; |
| IsFound := FindNext(SR) = 0; |
| end; |
| FindClose(SR); |
| |
| // Scan the list of subdirectories |
| for i := 0 to DirList.Count - 1 do |
| begin |
| FindFiles(FilesList, DirList[i], FileMask, errorSL); |
| end; |
| |
| DirList.Free; |
| end; |
| |
| function TForm1.Readable(filename: string): boolean; |
| var |
| ss: TFileStream; |
| begin |
| result := false; |
| if not FileExists(filename) then exit; |
| try |
| ss := TFileStream.Create(filename, fmOpenRead or fmShareDenyNone); |
| ss.Free; |
| result := true; |
| except |
| exit; |
| end; |
| end; |
| |
| procedure TForm1.Button1Click(Sender: TObject); |
| var |
| sl: TStringList; |
| fil: string; |
| cnt: integer; |
| c1, c2, f: Int64; |
| elapsedSecs: Int64; |
| begin |
| if not DirectoryExists(edit1.Text) then |
| begin |
| raise Exception.CreateFmt('Directory %s does not exist!', [Edit1.Text]); |
| end; |
| |
| QueryPerformanceFrequency(f); |
| QueryPerformanceCounter(c1); |
| |
| EnableDisableControls(false); |
| try |
| Memo1.Lines.Clear; |
| cnt := 0; |
| sl := TStringList.Create; |
| try |
| sl.BeginUpdate; |
| Label2.Caption := 'Scan folders ...'; |
| |
| FindFiles(sl, edit1.text, '*', Memo1.Lines); |
| Inc(cnt, Memo1.Lines.Count); // failed folders |
| |
| ProgressBar1.Max := sl.Count; |
| ProgressBar1.Min := 0; |
| ProgressBar1.Position := 0; |
| |
| for fil in sl do |
| begin |
| ProgressBar1.Position := ProgressBar1.Position + 1; |
| |
| if not Readable(fil) then |
| begin |
| Memo1.Lines.Add(fil); |
| inc(cnt); |
| end; |
| |
| Label2.Caption := MinimizeName(fil, Label2.Canvas, Label2.Width); |
| |
| Application.ProcessMessages; |
| if Application.Terminated then Abort; |
| end; |
| sl.EndUpdate; |
| finally |
| sl.Free; |
| end; |
| |
| if not Application.Terminated then |
| begin |
| QueryPerformanceCounter(c2); |
| elapsedSecs := Ceil((c2-c1)/f); |
| |
| ShowMessageFmt('Finished. Found %d error(s). Time: %.2d:%.2d:%.2d', [cnt, elapsedSecs div 3600, elapsedSecs mod 3600 div 60, elapsedSecs mod 3600 mod 60]); |
| end; |
| finally |
| EnableDisableControls(true); |
| end; |
| end; |
| |
| procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); |
| begin |
| Application.Terminate; |
| end; |
| |
| procedure TForm1.EnableDisableControls(enabled: boolean); |
| begin |
| Button1.Enabled := enabled; |
| Label1.Enabled := enabled; |
| Edit1.Enabled := enabled; |
| Memo1.Enabled := enabled; |
| end; |
| |
| end. |