Delphi-PRAXiS
Seite 2 von 6     12 34     Letzte »    

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Neuen Beitrag zur Code-Library hinzufügen (https://www.delphipraxis.net/33-neuen-beitrag-zur-code-library-hinzufuegen/)
-   -   Klasse für FindFirstFile/FindNextFile (https://www.delphipraxis.net/150887-klasse-fuer-findfirstfile-findnextfile.html)

DeddyH 29. Apr 2010 16:26

Re: Klasse für FindFirstFile/FindNextFile
 
Pöhser Frank, pöhser :lol:

negaH 29. Apr 2010 16:32

Re: Klasse für FindFirstFile/FindNextFile
 
@Luckie,

mal so nebenbei und aus aktuellem Anlass ein Kompliment für deinen sauberen Programmierstil, da kann man sagen: das lässt sich sehr flüssig lesen und man sieht sofort die Fehler die hätten drinnen sein können wenn es anders formatiert wäre ;) Zum Glück keine Fehler, weil sauber geschrieben.

Gruß Hagen

Luckie 29. Apr 2010 16:45

Re: Klasse für FindFirstFile/FindNextFile
 
Zitat:

Zitat von negaH
@Luckie,

mal so nebenbei und aus aktuellem Anlass ein Kompliment für deinen sauberen Programmierstil, da kann man sagen: das lässt sich sehr flüssig lesen und man sieht sofort die Fehler die hätten drinnen sein können wenn es anders formatiert wäre ;) Zum Glück keine Fehler, weil sauber geschrieben.

Danke. Das geht runter wie Öl. :P Aber ich habe auch lange gebraucht, bis ich soweit war. Habe mich allerdings in letzter Zeit etwas damit auseinander gesetzt. Nicht zu Letzt, weil ich beruflich jetzt überwiegend mit PHP arbeite und da muss man sauberen Code schreiben. ;)

Luckie 29. Apr 2010 23:17

Re: Klasse für FindFirstFile/FindNextFile
 
Kann man da irgendwie noch ein Ereignis einbauen, wenn wieder in das übergeordnete Verzeichnis gewechselt wird? Als Parameter wären beide Verzeichnisse, also aus dem zurückgesprungen wird und in welches zurückgesprungen wird, wünschenswert.

omata 29. Apr 2010 23:57

Re: Klasse für FindFirstFile/FindNextFile
 
Was soll die Frage? Wie wäre es mit realisieren...

Delphi-Quellcode:
unit FindFilesCls;

interface

uses
  Windows;

type
  TOnFindFile = procedure(Filename: string;
                          const Info: TWin32FindData;
                          var Cancel: Boolean) of object;
  TOnDirectoryFind = procedure(Directory: string;
                               const Info: TWin32FindData;
                               var Cancel: Boolean) of object;
  TOnDirectoryUp = procedure(FromDirectory, ToDirectory: string;
                             var Cancel: Boolean) of object;
  TFindFiles = class
  private
    FSubfolders: Boolean;
    FMask: string;
    FOnFindFile: TOnFindFile;
    FOnFindDirectory: TOnDirectoryFind;
    FOnDirectoryUp: TOnDirectoryUp;
    FCancel: Boolean;
    procedure Search(RootFolder: string);
  public
    constructor Create;
    property SubFolders: Boolean
      read FSubFolders write FSubFolders;
    property Mask: string
      read FMask write FMask;
    property OnFileFind: TOnFindFile
      read FOnFindFile write FOnFindFile;
    property OnDirectoryFind: TOnDirectoryFind
      read FOnFindDirectory write FOnFindDirectory;
    property OnDirectoryUp: TOnDirectoryUp
      read FOnDirectoryUp write FOnDirectoryUp;
    procedure Find(RootFolder: string);
  end;

implementation

{ TFindFiles }

constructor TFindFiles.Create;
begin
  inherited;
  FSubfolders := False;
  FMask := '*.*';
  FOnFindFile:=nil;
  FOnFindDirectory:=nil;
  FOnDirectoryUp:=nil;
end;

procedure TFindFiles.Search(RootFolder: string);
var
  wfd: TWin32FindData;
  hFile: THandle;
begin
  if (RootFolder <> '') and (RootFolder[Length(RootFolder)] <> '\') then
    RootFolder := RootFolder + '\';
  if not FCancel and FSubFolders then
  begin
    hFile := FindFirstFile(PChar(RootFolder + '*.*'), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
          if    (string(wfd.cFileName) <> '.')
             and (string(wfd.cFileName) <> '..') then
          begin
            if Assigned(OnDirectoryFind) then
              OnDirectoryFind(RootFolder + wfd.cFileName, wfd, FCancel);
            Find(RootFolder + wfd.cFileName + '\');
            if Assigned(OnDirectoryUp) then
              OnDirectoryUp(RootFolder + wfd.cFileName, RootFolder, FCancel);
          end;
      until FCancel or not FindNextFile(hFile, wfd);
    finally
      windows.FindClose(hFile);
    end;
  end;
  if not FCancel and Assigned(OnFileFind) then
  begin
    hFile := FindFirstFile(PChar(RootFolder + FMask), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
          OnFileFind(RootFolder + wfd.cFileName, wfd, FCancel);
      until FCancel or not FindNextFile(hFile, wfd);
    finally
      Windows.FindClose(hFile);
    end;
  end;
end;

procedure TFindFiles.Find(RootFolder: string);
begin
  FCancel := False;
  Search(RootFolder);
end;

end.

himitsu 30. Apr 2010 06:56

Re: Klasse für FindFirstFile/FindNextFile
 
Nur noch eine kleine Änderung,
Code:
if [b]not FCancel and[/b] Assigned(FOnDirectoryUp) then
damit OnDirectoryUp nicht aufgerufen wird, wenn in damit OnDirectoryFind abgerochen wurde.


[edit]
Code hier entfernt und dafür in Beitrag #5 geändert

NormanNG 30. Apr 2010 07:19

Re: Klasse für FindFirstFile/FindNextFile
 
Hi,

wäre es nicht auch nützlich, in das FOnDirectoryFind noch einen Parameter IgnoreDirectory einzuführen?

Delphi-Quellcode:
  TOnDirectoryFind = procedure(Directory: string;
                               const Info: TWin32FindData;
                               var Cancel: Boolean;
                               var IgnoreDirectory: Boolean) of object;

himitsu 30. Apr 2010 07:42

Re: Klasse für FindFirstFile/FindNextFile
 
Zitat:

Zitat von NormanNG
wäre es nicht auch nützlich

In Beitrag #5 mit drinnen.

Hatte zwar überlegt, ob man die beiden sich beeinflussenden Cancel und IgnoreDirectory kombinieren könnte und es dann nur einen Parameter gäbe,
aber nur für diese eine Prozedur einen neuen Enum einzuführen spart nicht wirklich was ein.

Daniel 30. Apr 2010 08:17

Re: Klasse für FindFirstFile/FindNextFile
 
Dann sollte in die Doku mit rein, ob der neue Parameter nur dazu führt, das aktuelle Verzeichnis zu überspringen oder auch ggf. alle Unterverzeichnisse gleich mit.

Luckie 30. Apr 2010 12:10

Re: Klasse für FindFirstFile/FindNextFile
 
@omata: Ja, hätte ich auch machen können, nur ich hatte gestern Abend etwas Matsch in der Birne und habe die Stelle einfach nicht mehr gesehen. ;)

Hier jetzt der aktuelle Code:
Delphi-Quellcode:
// FindFiles - Klasse zum Durchsuchen von Ordnern
// Michael Puff [[url]http://www.michael-puff.de][/url], himitsu, omata

unit MpuFindFilesCls;

interface

uses
  Windows;

type
  TOnFindFile = procedure(Filename: string; const Info: TWin32FindData; var Cancel: Boolean) of object;
  TOnFindDirectory = procedure(Directory: string; const Info: TWin32FindData; var Cancel: Boolean; var IgnoreDirectory: Boolean) of object;
  TOnDirectoryUp = procedure(FromDirectory, ToDirectory: string; var Cancel: Boolean) of object;
  TFindFiles = class(TObject)
  private
    FSubfolders: Boolean;
    FMask: string;
    FCancel: Boolean;
    FOnFindFile: TOnFindFile;
    FOnFindDirectory: TOnFindDirectory;
    FOnDirectoryUp: TOnDirectoryUp;
    procedure Search(RootFolder: string);
  public
    constructor Create;
    procedure Find(RootFolder: string);
    property SubFolders: Boolean read FSubFolders write FSubFolders;
    property Mask: string read FMask write FMask;
    property OnFindFile: TOnFindFile read FOnFindFile write FOnFindFile;
    property OnFindDirectory: TOnFindDirectory read FOnFindDirectory write FOnFindDirectory;
    property OnDirectoryUp: TOnDirectoryUp read FOnDirectoryUp write FOnDirectoryUp;
  end;

implementation

{ TFindFiles }

constructor TFindFiles.Create;
begin
  inherited;
  FSubfolders := False;
  FMask := '*.*';
end;

procedure TFindFiles.Search(RootFolder: string);
var
  wfd: TWin32FindData;
  hFile: THandle;
  Ignore: Boolean;
begin
  if (RootFolder <> '') and (RootFolder[Length(RootFolder)] <> '\') then
    RootFolder := RootFolder + '\';
  if not FCancel and FSubFolders then
  begin
    hFile := FindFirstFile(PChar(RootFolder + '*.*'), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
          if    (string(wfd.cFileName) <> '.')
             and (string(wfd.cFileName) <> '..') then
          begin
            Ignore := False;
            if Assigned(FOnFindDirectory) then
              FOnFindDirectory(RootFolder + wfd.cFileName, wfd, FCancel, Ignore);
            if not FCancel and not Ignore then
              Find(RootFolder + wfd.cFileName + '\');
            if not FCancel and Assigned(FOnDirectoryUp) then
              FOnDirectoryUp(RootFolder + wfd.cFileName, RootFolder, FCancel);
          end;
      until FCancel or not FindNextFile(hFile, wfd);
    finally
      windows.FindClose(hFile);
    end;
  end;
  if not FCancel and Assigned(OnFindFile) then
  begin
    hFile := FindFirstFile(PChar(RootFolder + FMask), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
          OnFindFile(RootFolder + wfd.cFileName, wfd, FCancel);
      until FCancel or not FindNextFile(hFile, wfd);
    finally
      Windows.FindClose(hFile);
    end;
  end;
end;

procedure TFindFiles.Find(RootFolder: string);
begin
  FCancel := False;
  Search(RootFolder);
end;

end.
Ich habe mal himitsu und omata* als Co-Autoren eingetragen. Falls ich jemanden vergessen habe, bitte melden.

@himitsu: Du hattest zwei kleine Fehler drin. Und ich habe die Ereignisse umbenannte, so klingt es besser, finde ich.

@Daniel: Ja der Parameter IgnoreDirectory müsste Dokumentiert werden, es sei denn uns fällt noch ein besserer Name ein, was mir eigentlich lieber wäre.

*) Falls ihr mit richtigen Namen genannt werden wollt, sagt Bescheid.


Alle Zeitangaben in WEZ +1. Es ist jetzt 06:02 Uhr.
Seite 2 von 6     12 34     Letzte »    

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz