| /trunk/Create Shortcut/Shortcut.dproj |
|---|
| 0,0 → 1,69 |
| <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> |
| <PropertyGroup> |
| <ProjectGuid>{6c2b34ae-708e-4b24-9e94-764b14cbf435}</ProjectGuid> |
| <MainSource>Shortcut.dpr</MainSource> |
| <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration> |
| <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform> |
| <DCC_DCCCompiler>DCC32</DCC_DCCCompiler> |
| <DCC_DependencyCheckOutputName>Shortcut.exe</DCC_DependencyCheckOutputName> |
| </PropertyGroup> |
| <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' "> |
| <Version>7.0</Version> |
| <DCC_DebugInformation>False</DCC_DebugInformation> |
| <DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols> |
| <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo> |
| <DCC_Define>RELEASE</DCC_Define> |
| </PropertyGroup> |
| <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' "> |
| <Version>7.0</Version> |
| <DCC_Define>DEBUG</DCC_Define> |
| </PropertyGroup> |
| <ProjectExtensions> |
| <Borland.Personality>Delphi.Personality</Borland.Personality> |
| <Borland.ProjectType /> |
| <BorlandProject> |
| <BorlandProject xmlns=""> <Delphi.Personality> <Parameters> |
| <Parameters Name="UseLauncher">False</Parameters> |
| <Parameters Name="LoadAllSymbols">True</Parameters> |
| <Parameters Name="LoadUnspecifiedSymbols">False</Parameters> |
| </Parameters> |
| <VersionInfo> |
| <VersionInfo Name="IncludeVerInfo">False</VersionInfo> |
| <VersionInfo Name="AutoIncBuild">False</VersionInfo> |
| <VersionInfo Name="MajorVer">1</VersionInfo> |
| <VersionInfo Name="MinorVer">0</VersionInfo> |
| <VersionInfo Name="Release">0</VersionInfo> |
| <VersionInfo Name="Build">0</VersionInfo> |
| <VersionInfo Name="Debug">False</VersionInfo> |
| <VersionInfo Name="PreRelease">False</VersionInfo> |
| <VersionInfo Name="Special">False</VersionInfo> |
| <VersionInfo Name="Private">False</VersionInfo> |
| <VersionInfo Name="DLL">False</VersionInfo> |
| <VersionInfo Name="Locale">1031</VersionInfo> |
| <VersionInfo Name="CodePage">1252</VersionInfo> |
| </VersionInfo> |
| <VersionInfoKeys> |
| <VersionInfoKeys Name="CompanyName"></VersionInfoKeys> |
| <VersionInfoKeys Name="FileDescription"></VersionInfoKeys> |
| <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="InternalName"></VersionInfoKeys> |
| <VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys> |
| <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys> |
| <VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys> |
| <VersionInfoKeys Name="ProductName"></VersionInfoKeys> |
| <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="Comments"></VersionInfoKeys> |
| </VersionInfoKeys> |
| <Source> |
| <Source Name="MainSource">Shortcut.dpr</Source> |
| </Source> |
| </Delphi.Personality> </BorlandProject></BorlandProject> |
| </ProjectExtensions> |
| <ItemGroup /> |
| <ItemGroup> |
| <DelphiCompile Include="Shortcut.dpr"> |
| <MainSource>MainSource</MainSource> |
| </DelphiCompile> |
| </ItemGroup> |
| <Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" /> |
| </Project> |
| /trunk/FileReadChecker/FileReadChecker.dpr |
|---|
| 0,0 → 1,14 |
| program FileReadChecker; |
| uses |
| Forms, |
| FileReadCheckerMain in 'FileReadCheckerMain.pas' {Form1}; |
| {$R *.res} |
| begin |
| Application.Initialize; |
| Application.MainFormOnTaskbar := True; |
| Application.CreateForm(TForm1, Form1); |
| Application.Run; |
| end. |
| /trunk/FileReadChecker/FileReadChecker.dproj |
|---|
| 0,0 → 1,71 |
| <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> |
| <PropertyGroup> |
| <ProjectGuid>{fa875844-55f1-4067-a222-35a0700ffa41}</ProjectGuid> |
| <MainSource>FileReadChecker.dpr</MainSource> |
| <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration> |
| <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform> |
| <DCC_DCCCompiler>DCC32</DCC_DCCCompiler> |
| <DCC_DependencyCheckOutputName>FileReadChecker.exe</DCC_DependencyCheckOutputName> |
| </PropertyGroup> |
| <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' "> |
| <Version>7.0</Version> |
| <DCC_DebugInformation>False</DCC_DebugInformation> |
| <DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols> |
| <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo> |
| <DCC_Define>RELEASE</DCC_Define> |
| </PropertyGroup> |
| <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' "> |
| <Version>7.0</Version> |
| <DCC_Define>DEBUG</DCC_Define> |
| </PropertyGroup> |
| <ProjectExtensions> |
| <Borland.Personality>Delphi.Personality</Borland.Personality> |
| <Borland.ProjectType>VCLApplication</Borland.ProjectType> |
| <BorlandProject> |
| <BorlandProject xmlns=""> <Delphi.Personality> <Parameters> |
| <Parameters Name="UseLauncher">False</Parameters> |
| <Parameters Name="LoadAllSymbols">True</Parameters> |
| <Parameters Name="LoadUnspecifiedSymbols">False</Parameters> |
| </Parameters> |
| <VersionInfo> |
| <VersionInfo Name="IncludeVerInfo">True</VersionInfo> |
| <VersionInfo Name="AutoIncBuild">False</VersionInfo> |
| <VersionInfo Name="MajorVer">1</VersionInfo> |
| <VersionInfo Name="MinorVer">2</VersionInfo> |
| <VersionInfo Name="Release">0</VersionInfo> |
| <VersionInfo Name="Build">0</VersionInfo> |
| <VersionInfo Name="Debug">False</VersionInfo> |
| <VersionInfo Name="PreRelease">False</VersionInfo> |
| <VersionInfo Name="Special">False</VersionInfo> |
| <VersionInfo Name="Private">False</VersionInfo> |
| <VersionInfo Name="DLL">False</VersionInfo> |
| <VersionInfo Name="Locale">1033</VersionInfo> |
| <VersionInfo Name="CodePage">1252</VersionInfo> |
| </VersionInfo> |
| <VersionInfoKeys> |
| <VersionInfoKeys Name="CompanyName">ViaThinkSoft</VersionInfoKeys> |
| <VersionInfoKeys Name="FileDescription">File Read Checker</VersionInfoKeys> |
| <VersionInfoKeys Name="FileVersion">1.2.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="InternalName">FileReadChecker</VersionInfoKeys> |
| <VersionInfoKeys Name="LegalCopyright">(C) 2016-2019 ViaThinkSoft</VersionInfoKeys> |
| <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys> |
| <VersionInfoKeys Name="OriginalFilename">FileReadChecker.exe</VersionInfoKeys> |
| <VersionInfoKeys Name="ProductName">Small Delphi Tools</VersionInfoKeys> |
| <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys> |
| <VersionInfoKeys Name="Comments">www.viathinksoft.de</VersionInfoKeys> |
| </VersionInfoKeys> |
| <Source> |
| <Source Name="MainSource">FileReadChecker.dpr</Source> |
| </Source> |
| </Delphi.Personality> </BorlandProject></BorlandProject> |
| </ProjectExtensions> |
| <Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" /> |
| <ItemGroup> |
| <DelphiCompile Include="FileReadChecker.dpr"> |
| <MainSource>MainSource</MainSource> |
| </DelphiCompile> |
| <DCCReference Include="FileReadCheckerMain.pas"> |
| <Form>Form1</Form> |
| </DCCReference> |
| </ItemGroup> |
| </Project> |
| /trunk/FileReadChecker/FileReadChecker.exe |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /trunk/FileReadChecker/FileReadChecker.res |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /trunk/FileReadChecker/FileReadCheckerMain.dfm |
|---|
| 0,0 → 1,83 |
| object Form1: TForm1 |
| Left = 0 |
| Top = 0 |
| Caption = 'File readability checker' |
| ClientHeight = 472 |
| ClientWidth = 756 |
| Color = clBtnFace |
| Font.Charset = DEFAULT_CHARSET |
| Font.Color = clWindowText |
| Font.Height = -11 |
| Font.Name = 'Tahoma' |
| Font.Style = [] |
| OldCreateOrder = False |
| Position = poScreenCenter |
| OnClose = FormClose |
| DesignSize = ( |
| 756 |
| 472) |
| PixelsPerInch = 96 |
| TextHeight = 13 |
| object Label1: TLabel |
| Left = 16 |
| Top = 45 |
| Width = 66 |
| Height = 13 |
| Caption = 'Found errors:' |
| end |
| object Label2: TLabel |
| Left = 201 |
| Top = 446 |
| Width = 537 |
| Height = 13 |
| Anchors = [akLeft, akRight, akBottom] |
| AutoSize = False |
| Caption = 'Ready.' |
| ExplicitTop = 445 |
| ExplicitWidth = 497 |
| end |
| object Button1: TButton |
| Left = 16 |
| Top = 423 |
| Width = 169 |
| Height = 33 |
| Anchors = [akLeft, akBottom] |
| Caption = 'Start' |
| Default = True |
| TabOrder = 0 |
| OnClick = Button1Click |
| ExplicitTop = 422 |
| end |
| object Edit1: TEdit |
| Left = 16 |
| Top = 16 |
| Width = 722 |
| Height = 21 |
| Anchors = [akLeft, akTop, akRight] |
| TabOrder = 1 |
| Text = 'C:\' |
| ExplicitWidth = 682 |
| end |
| object Memo1: TMemo |
| Left = 16 |
| Top = 64 |
| Width = 722 |
| Height = 353 |
| Anchors = [akLeft, akTop, akRight, akBottom] |
| ReadOnly = True |
| ScrollBars = ssBoth |
| TabOrder = 2 |
| ExplicitWidth = 682 |
| ExplicitHeight = 352 |
| end |
| object ProgressBar1: TProgressBar |
| Left = 201 |
| Top = 423 |
| Width = 537 |
| Height = 17 |
| Anchors = [akLeft, akRight, akBottom] |
| TabOrder = 3 |
| ExplicitTop = 422 |
| ExplicitWidth = 497 |
| end |
| end |
| /trunk/FileReadChecker/FileReadCheckerMain.pas |
|---|
| 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. |