Entwickler-Ecke

Dateizugriff - Findfirst.....zum 2ten


Scrat - Mo 25.11.02 13:08
Titel: Findfirst.....zum 2ten
Ich habe jetzt mal einen Quellcode zustande gebracht,der auch dateien findet....nur nicht in Unterverzeichnissen. Ich habe auch schon für
aPath := 'C:\*.*' eingegeben...aber nix tat sich.



Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
    
Procedure FindFiles(aPath, aFindMask: String; aWithSub: Boolean; aResult:tStrings);
var
FindRec: tSearchRec;
Begin
  aPath:= 'C:\';                     
  aFindMask:= '*.html';              
  aWithSub:= true;                   
  If FindFirst(aPath + aFindMask, faAnyFile  , FindRec) = 0 Then
  Repeat
  If (FindRec.Name <> '.') and (FindRec.Name <> '..') Then 
  aResult.add (aPath + FindRec.Name);
  Until FindNext (FindRec) <> 0;
  FindClose (FindRec);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
FindFiles('APatch', 'aFindMask',true,Listbox1.Items);
ShowMessage(IntToStr(ListBox1.Items.Count) + ' Daten gefunden');
end;


Wer kann mir helfen...


foxy - Mo 25.11.02 13:11

sers ich hatte gerade ne unit zur hand ... schau dir die mal an und dann kannste dein prog angleichen


Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
unit Dsuche;

interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
     StdCtrls;
  
     


procedure GetFiles(const Directory: string; var Files:TStrings;
const FileMask: string = '*.*';  const SubFolders: Boolean = False);

implementation
uses Unit1,Tabelle,Unit6;



procedure GetFiles(const Directory: string; var Files: TStrings;
  const FileMask: string = '*.*';  const SubFolders: Boolean = False);

  //Hilfsfunktion, um Schrägstriche hinzuzfügen, wenn nötig
  function SlashSep(const Path, S: string): string;
  begin
    if AnsiLastChar(Path)^ <> '\' then  Result := Path + '\' + S
    else Result := Path + S;
  end;

var SearchRec: TSearchRec;
    
begin
  //Zuerst alle Dateien im aktuelle Verzeichnis finden

  if FindFirst(SlashSep(Directory, FileMask), faAnyFile-faDirectory-faVolumeID,
  SearchRec) = 0 then begin
    try
      repeat
        Files.Add(SlashSep(Directory, SearchRec.Name));
      until FindNext(SearchRec) <> 0;
    finally
      SysUtils.FindClose(SearchRec);
    end;
  end;

  //Als nächstes nach Unterverzeichnissen suchen und, wenn benötigt, durchsuchen
  if SubFolders then begin
    if FindFirst(SlashSep(Directory,'*.*'), faAnyFile,  SearchRec) = 0 then begin
      try
        repeat
          //Wenn es ein Verzeichnis ist, Rekursion verwenden
          if (SearchRec.Attr and faDirectory) <> 0 then begin
            if ((SearchRec.Name <> '.') and (SearchRec.Name <> '..')) then
              GetFiles(SlashSep(Directory, SearchRec.Name), Files, FileMask, SubFolders);
          end;
        until FindNext(SearchRec) <> 0;
      finally
        SysUtils.FindClose(SearchRec);
      end;
    end;
  end;

end;
end.


Delete - Mo 25.11.02 13:47
Titel: Re: Findfirst.....zum 2ten
Scrat hat folgendes geschrieben:
Ich habe jetzt mal einen Quellcode zustande gebracht,der auch dateien findet....nur nicht in Unterverzeichnissen.

Ich will dich nicht kränken, aber dein "zustande gebrachter" Quellcode sieht ein bisschen wie eine Funktion aus dem EDH aus.

Das Unvermögen der Funktion, in Unterverzeichnissen zu suchen, wundert mich nicht weiter, denn du prüfst ja überhaupt nicht danach! Wie foxy dir gezeigt hast, musst du das Verzeichnisattribut prüfen und die Funktion ggf. erneut aufrufen.
Scheint als hättest du das beim Kopieren vergessen. :twisted:


Quelltext
1:
2:
3:
aPath:= 'C:\';
aFindMask:= '*.html';
aWithSub:= true;

Das ist schon mal Quatsch, weil das ja bereits durch die Parameterliste im Funktionskopf eingestellt werden kann und sollte!


Anonymous - Mo 25.11.02 16:46

Du kannst dir mal hier Tip 8 angucken:

http://mitglied.lycos.de/popov3/pub/topten/faq.txt