Permalink
Browse files

added FileScanner

  • Loading branch information...
1 parent 2e9d991 commit 2a9469798e8e9b24788e6606ccb24d2addb9e00c @sx2008 committed Apr 23, 2012
Showing with 616 additions and 0 deletions.
  1. +169 −0 FileScanner/FileScanner.pas
  2. +105 −0 FileScanner/FileScannerDemo.dof
  3. +15 −0 FileScanner/FileScannerDemo.dpr
  4. +140 −0 FileScanner/MainForm.dfm
  5. +187 −0 FileScanner/MainForm.pas
@@ -0,0 +1,169 @@
+unit FileScanner;
+
+{
+für Delphi-Praxis by shmia
+
+
+}
+
+
+interface
+
+
+
+type
+
+// Info über einzelne Datei oder Verzeichnis
+TFileInformation = record
+ Name : string;
+ Path : string;
+ IsDir : boolean;
+ ArchiveFlag, ReadOnlyFlag, HiddenFlag, SystemFlag : boolean;
+// Owner : TOwner; // TODO
+ Size : Int64;
+ Depth : Integer; // Tiefe: 0=Startverz, 1= erstes Unterverz.
+ Created,LastWrite, LastAccess : TDateTime;
+end;
+
+TFileFindEvent = procedure(Sender:TObject; const FileInformation:TFileInformation) of object;
+
+
+// Klasse um Verzeichnisse aufzulisten
+//
+TFileScanner = class(Tobject)
+private
+ FOnFound: TFileFindEvent;
+ FRecursive: Boolean;
+ FStopped : Boolean;
+ FStopDir : Boolean;
+ FStartDepth : Integer;
+ procedure DoFound(const FileInformation:TFileInformation);virtual;
+
+ procedure ScanDirInternal(const Directory:string; depth:Integer);
+
+public
+ procedure ScanDir(const Directory:string); // Verzeichnis scannen
+
+ procedure Stop; // Scanvorgang anhalten
+ procedure StopDirectory; // nur Scanvorgang im aktuellen Verzeichnis unterbrechen
+
+ property Recursive:Boolean read FRecursive write FRecursive;
+ property OnFound:TFileFindEvent read FOnFound write FOnFound;
+ property Stopped:Boolean read FStopped;
+end;
+
+
+
+implementation
+
+uses Windows, SysUtils;
+
+
+const
+ FileTimeBase = -109205.0;
+ FileTimeStep: Extended = 24.0 * 60.0 * 60.0 * 1000.0 * 1000.0 * 10.0; // 100 nSek per Day
+
+
+function FileTimeToDateTime(const FileTime: TFileTime): TDateTime;
+begin
+ Result := Int64(FileTime) / FileTimeStep;
+ Result := Result + FileTimeBase;
+end;
+
+
+function FileTimeToLocalDateTime(const FileTime: TFileTime): TDateTime;
+var
+ LocalFileTime: TFileTime;
+begin
+ if FileTimeToLocalFileTime(FileTime, LocalFileTime) then
+ Result := FileTimeToDateTime(LocalFileTime)
+ { TODO : daylight saving time }
+ else
+ Result := 0.0;
+end;
+
+
+
+{ TFileScanner }
+
+procedure TFileScanner.DoFound(const FileInformation: TFileInformation);
+begin
+ if Assigned(onFound) then
+ OnFound(Self, FileInformation)
+ else
+ Stop; // ohne Eventhandler macht es keinen Sinn
+end;
+
+procedure TFileScanner.ScanDir(const Directory: string);
+begin
+ if Recursive then
+ FStartDepth := 255
+ else
+ FStartDepth := 0;
+ FStopped := False;
+ ScanDirInternal(IncludeTrailingBackslash(Directory), FStartDepth)
+end;
+
+procedure TFileScanner.ScanDirInternal(const Directory: string; depth:Integer);
+var
+ SR : TSearchRec;
+ FI : TFileInformation;
+begin
+ FStopDir := False;
+ FI.Path := Directory;
+ FI.Depth := FStartDepth-depth;
+ FI.IsDir := True;
+
+ if FindFirst(Directory+'*.*',faAnyFile,SR) = 0 then
+ begin
+ try
+ DoFound(FI);
+ if FStopDir then
+ Exit;
+ repeat
+ if (SR.Attr and faDirectory) = faDirectory then
+ begin
+ if (depth > 0) and (SR.Name <> '.') and (SR.Name <> '..') then
+ ScanDirInternal(IncludeTrailingBackSlash(Directory+SR.Name), depth-1);
+ end
+ else
+ begin
+ FI.Name := SR.Name;
+ FI.Size := SR.Size;
+ FI.IsDir := False;
+ FI.Created := FileTimeToLocalDateTime(SR.FindData.ftCreationTime);
+ FI.LastWrite := FileTimeToLocalDateTime(SR.FindData.ftLastWriteTime);
+ FI.LastAccess := FileTimeToLocalDateTime(SR.FindData.ftLastAccessTime);
+
+ FI.ReadOnlyFlag := (SR.FindData.dwFileAttributes and faReadOnly) <> 0;
+ FI.HiddenFlag := (SR.FindData.dwFileAttributes and faHidden) <> 0;
+ FI.SystemFlag := (SR.FindData.dwFileAttributes and faSysFile) <> 0;
+ FI.ArchiveFlag := (SR.FindData.dwFileAttributes and faArchive) <> 0;
+
+ (*
+ TODO:
+ Size mit 64-Bit Dateigrösse füllen
+ *)
+
+ DoFound(FI);
+ end;
+ until FStopped or (FindNext(SR) <> 0);
+ finally
+ FindClose(SR);
+ end;
+ end;
+end;
+
+procedure TFileScanner.Stop;
+begin
+ FStopped := True;
+end;
+
+
+
+procedure TFileScanner.StopDirectory;
+begin
+ FStopDir := True;
+end;
+
+end.
@@ -0,0 +1,105 @@
+[Compiler]
+A=1
+B=0
+C=1
+D=1
+E=0
+F=0
+G=1
+H=1
+I=0
+J=1
+K=0
+L=1
+M=0
+N=1
+O=1
+P=1
+Q=0
+R=0
+S=0
+T=0
+U=0
+V=1
+W=0
+X=1
+Y=1
+Z=1
+ShowHints=1
+ShowWarnings=1
+UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+[Linker]
+MapFile=0
+OutputObjs=0
+ConsoleApp=1
+DebugInfo=0
+RemoteSymbols=0
+MinStackSize=16384
+MaxStackSize=1048576
+ImageBase=4194304
+ExeDescription=
+[Directories]
+OutputDir=
+UnitOutputDir=
+PackageDLLOutputDir=
+PackageDCPOutputDir=
+SearchPath=
+Packages=Vcl50;Vclx50;VclSmp50;Qrpt50;Vcldb50;Vclbde50;vcldbx50;TeeUI50;TeeDB50;Tee50;TeeQR50;VCLIB50;vclie50;Inetdb50;Inet50;NMFast50;dclocx50;dclaxserver50;vclado50;dxEdtrD5;dxcomnD5;EQTLD5;ECQDBCD5;EQDBTLD5;EQGridD5;dxGrEdD5;dxExELD5;dxELibD5;rbTDBC75;rbRCL75;rbCIDE75;rbIDE75;rbBDE75;rbDBDE75;rbDAD75;rbDIDE75;rbUSER75;rbDB75;rbADO75;rbIBE75;BuilderControlsPackage;DJcl50;BIZPACK;uSec2050
+Conditionals=
+DebugSourceDirs=
+UsePackages=0
+[Parameters]
+RunParams=
+HostApplication=
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1031
+CodePage=1252
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+[Excluded Packages]
+$(DELPHI)\Projects\Bpl\B304_d50.bpl=TurboPower Abbrevia 3.04 Design-time package - VCL50
+$(DELPHI)\Bin\dclocx50.bpl=Borland Importierte ActiveX-Beispielkomponenten
+$(DELPHI)\Bin\dclite50.bpl=Borland Integrierte �bersetzungsumgebung (ITE)
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=..\Lib\;$(DELPHI)\RBuilder\Source
+[HistoryLists\hlConditionals]
+Count=1
+Item0=DEBUG
+[HistoryLists\hlUnitAliases]
+Count=2
+Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+Item1=WinTypes=Windows;WinProcs=Windows;Variants=System
+[HistoryLists\hlSearchPath]
+Count=3
+Item0=..\lib;$(DELPHI)\ocx\chartfx
+Item1=C:\Delphi\Componen\DfueVers;C:\Delphi\Bizerba\Lib
+Item2=C:\Delphi\Componen\DfueVers
+[HistoryLists\hlUnitOutputDirectory]
+Count=2
+Item0=.\Obj
+Item1=C:\DELPHI\BIZERBA\CVS\OBJ
+[HistoryLists\hlOutputDirectorry]
+Count=2
+Item0=C:\DCVS
+Item1=C:\PSS
@@ -0,0 +1,15 @@
+program FileScannerDemo;
+
+uses
+ Forms,
+ MainForm in 'MainForm.pas' {Form1},
+ FileScanner in 'FileScanner.pas';
+
+{$R *.RES}
+
+begin
+ Application.Initialize;
+ Application.Title := 'File Scanner Demo';
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
Oops, something went wrong.

0 comments on commit 2a94697

Please sign in to comment.