AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Klasse für FindFirstFile/FindNextFile

Ein Thema von Luckie · begonnen am 29. Apr 2010 · letzter Beitrag vom 2. Mai 2010
Antwort Antwort
Seite 2 von 6     12 34     Letzte »    
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.622 Beiträge
 
Delphi 12 Athens
 
#11

Re: Klasse für FindFirstFile/FindNextFile

  Alt 29. Apr 2010, 17:26
Pöhser Frank, pöhser
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat
Benutzerbild von negaH
negaH

Registriert seit: 25. Jun 2003
Ort: Thüringen
2.950 Beiträge
 
#12

Re: Klasse für FindFirstFile/FindNextFile

  Alt 29. Apr 2010, 17:32
@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
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#13

Re: Klasse für FindFirstFile/FindNextFile

  Alt 29. Apr 2010, 17:45
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. 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.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#14

Re: Klasse für FindFirstFile/FindNextFile

  Alt 30. Apr 2010, 00:17
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.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
omata

Registriert seit: 26. Aug 2004
Ort: Nebel auf Amrum
3.154 Beiträge
 
Delphi 7 Enterprise
 
#15

Re: Klasse für FindFirstFile/FindNextFile

  Alt 30. Apr 2010, 00:57
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.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.056 Beiträge
 
Delphi 12 Athens
 
#16

Re: Klasse für FindFirstFile/FindNextFile

  Alt 30. Apr 2010, 07:56
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
Neuste Erkenntnis:
Seit Pos einen dritten Parameter hat,
wird PoSex im Delphi viel seltener praktiziert.
  Mit Zitat antworten Zitat
NormanNG

Registriert seit: 1. Feb 2006
294 Beiträge
 
Delphi 2007 Professional
 
#17

Re: Klasse für FindFirstFile/FindNextFile

  Alt 30. Apr 2010, 08:19
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;
Gruß
Norman
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.056 Beiträge
 
Delphi 12 Athens
 
#18

Re: Klasse für FindFirstFile/FindNextFile

  Alt 30. Apr 2010, 08:42
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.
Neuste Erkenntnis:
Seit Pos einen dritten Parameter hat,
wird PoSex im Delphi viel seltener praktiziert.
  Mit Zitat antworten Zitat
Daniel
(Co-Admin)

Registriert seit: 30. Mai 2002
Ort: Hamburg
13.920 Beiträge
 
Delphi 10.4 Sydney
 
#19

Re: Klasse für FindFirstFile/FindNextFile

  Alt 30. Apr 2010, 09:17
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.
Daniel R. Wolf
mit Grüßen aus Hamburg
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#20

Re: Klasse für FindFirstFile/FindNextFile

  Alt 30. Apr 2010, 13:10
@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.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 2 von 6     12 34     Letzte »    


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:23 Uhr.
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