TSearchRec.Findfirst, findnext Alternative

[Bjoerk]

Kennt jemand eine schnellere TSearchRec.Findfirst, findnext Alternative ?

[DeddyH]

Du kannst das auch per API machen (FindFirstFile, FindNextFile), aber ob das schneller ist, weiß ich nicht.

[Bjoerk]

Is the same.

Delphi-Quellcode:

function FindMatchingFile(var F: TSearchRec): Integer;
var
  LocalFileTime: TFileTime;
begin
  with F do
  begin
    while FindData.dwFileAttributes and ExcludeAttr <> 0 do
      if not FindNextFile(FindHandle, FindData) then
      begin
        Result := GetLastError;
        Exit;
      end;
    FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
    FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi,
      LongRec(Time).Lo);
    Size := FindData.nFileSizeLow or Int64(FindData.nFileSizeHigh) shl 32;
    Attr := FindData.dwFileAttributes;
    Name := FindData.cFileName;
  end;
  Result := 0;
end;

function FindFirst(const Path: string; Attr: Integer;
  var  F: TSearchRec): Integer;
const
  faSpecial = faHidden or faSysFile or faDirectory;
begin
  F.ExcludeAttr := not Attr and faSpecial;
  F.FindHandle := FindFirstFile(PChar(Path), F.FindData);
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Result := FindMatchingFile(F);
    if Result <> 0 then FindClose(F);
  end else
    Result := GetLastError;
end;

function FindNext(var F: TSearchRec): Integer;
begin
  if FindNextFile(F.FindHandle, F.FindData) then
    Result := FindMatchingFile(F) else
    Result := GetLastError;
end;

procedure FindClose(var F: TSearchRec);
begin
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(F.FindHandle);
    F.FindHandle := INVALID_HANDLE_VALUE;
  end;
end;

[himitsu]

Schneller geht nur

- die MFT auslesen (bei NTFS)

- mit Backuprechten das Verzeichnis direkt auslesen und den Inhalt selber parsen
(hier brauchst'e dann Wissen über die Interna von ausreichend verschiedenen Dateisystemen)


schneller, aber einfacher = Austausch der HDD (SDD)

[Bjoerk]

Wie machen es denn die ShellCtrls ?

[himitsu]

Zitat:

Zitat von Bjoerk (Beitrag 1123838)

Wie machen es denn die ShellCtrls ?

Schau doch nach?

Die gehn über SHGetDesktopFolder und Co.

[Bjoerk]

Ich hab' mir die ShellCtrls jetzt auch mal näher angesehen. Die laden immer nur den nächsten Level in das TreeView rein (keine Rekursion). Deshalb sind diese (scheinbar) schneller, liegt weniger an findfirst und Co.. ShellTreeView1.Items[0].Expand(true) dauert deshalb auch sehr lange (lädt dann die fehlenden Items nach).

[DeddyH]

Das macht übrigens der Windows Explorer auch nicht anders.

[Bjoerk]

So geht's eigentlich ganz gut, nur bisschen doof, daß dann erst mal nicht angezeigt wird, ob der Ordner Unterordner hat.

Delphi-Quellcode:

procedure GetNextLevelNodeDirs(const ADirectory: String; var ATree: TTreeView; const Start: TTreeNode);
var
  S: TSearchRec;
  R: integer;
  N: TTreeNode;
begin
  R:= FindFirst(IncludeTrailingPathDelimiter(ADirectory)+'*.*', faDirectory, S);
  while R = 0 do
  begin
    if ((S.Attr and faDirectory) <> 0) then
      if ((S.Name <> '.') and (S.Name <> '..')) then
        if not N.HasChildren then
          N:= ATree.Items.AddChild(Start, S.Name);
    R:= FindNext(S);
  end;
  Findclose(S);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Path: string;
begin
  Path:= 'C:\';
  TreeView1.Items.BeginUpDate;
  GetNextLevelNodeDirs(Path, TreeView1, TreeView1.Items.AddChild(Nil, Path));
  TreeView1.Items.EndUpDate;
  TreeView1.Items[0].Expand(false);
end;

function GetTreeNodePath(const ANode: TTreeNode): string;
var
  I: integer;
begin
  if Assigned(ANode) then
    if Assigned(ANode.Parent) then
      GetTreeNodePath:= GetTreeNodePath(ANode.Parent)+'\'+ANode.Text
    else
      Result:= ANode.Text
  else
    Result:= '';
  if Result <> '' then Result:= Result+'\';
  I:= 1;
  while I < Length(Result) do
  begin
    if (Result[I] = '\') and (Result[I+1] = '\') then Delete (Result, I, 1);
    Inc(I);
  end;
end;

procedure TForm1.TreeView1Click(Sender: TObject);
var
  ANode: TTreeNode;
begin
  ANode:= TreeView1.Selected;
  TreeView1.Items.BeginUpDate;
  GetNextLevelNodeDirs(GetTreeNodePath(ANode), TreeView1, ANode);
  TreeView1.Items.EndUpDate;
end;

procedure TForm1.TreeView1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  TreeView1Click(Sender);
end;

[DeddyH]

Ich kenne da den Trick, zunächst einmal "Dummy"-Knoten anzulegen, damit auf jeden Fall das "+" angezeigt wird. Wird nun versucht, den Knoten aufzuklappen und der Ordner enthält keine Unterordner, dann wird das Aufklappen abgebrochen und das "+" entfernt. Aber mal etwas anderes zu GetNextLevelNodeDirs: wieso übergibst Du die Treeview als Var-Parameter? Und N ist zumindest beim ersten Scheifendurchlauf nicht initialisiert, es wundert mich ein wenig, dass das nicht knallt.

[BUG]

Zitat:

Zitat von Bjoerk (Beitrag 1123948)

So geht's eigentlich ganz gut, nur bisschen doof, daß dann erst mal nicht angezeigt wird, ob der Ordner Unterordner hat.

Man könnte auch eine Rekursionstiefe weiter runter gehen als angezeigt. Dabei würde es vielleicht sogar reichen, nur das erste Unteritem zu finden, um zu wissen ob ein Plus angezeigt werden soll.

[Bjoerk]

Ja, das wundert mich auch, hab' die Compilermelung auch erhalten. Könnte man Nil setzen und das abfragen oder GetTreeNodePath verwenden. Das var soll natürlich ein const sein. Ich wollte verhindern, daß Delphi eine Kopie anlegt. Mit const, var, out und ohne habe ich bei Pointern immer noch Schwierigkeiten, (bei dynamischen Arrays ist es nochmal ein wenig anders, hab ich festgestellt) ob wohl du, Handbagger und Sirius das mir schon mehrfach erklärt haben.

[DeddyH]

Ungetesteter Vorschlag:

Delphi-Quellcode:

procedure IndicateSubDirs(const ADirectory: String; ATree: TTreeView; Node: TTreeNode);
var
  S: TSearchRec;
  N: TTreeNode;
begin
  N := nil;
  if FindFirst(IncludeTrailingPathDelimiter(ADirectory)+'*.*', faDirectory, S) = 0 then
    try
      repeat
        if (S.Attr and faDirectory) = faDirectory then
          if (Rec.Name <> '.') and (Rec.Name <> '..') then
            N := ATree.Items.AddChild(Node, S.Name);          
      until Assigned(N) or (FindNext(S) <> 0);
    finally
      SysUtils.FindClose(S);
    end;
end;

[Bjoerk]

Das hat nicht funktioniert, zeigt die Dirs doppelt an.

Am Anfang meiner procedure kann man N:= Start setzen, dann ist N nicht mehr undefiniert.

Edit, nein umgekehrt, zeigt nur ein Dir an.

[DeddyH]

Ja, soll ja auch nur ein Dir anzeigen. Es ging nur darum, zu ermitteln, ob zum Verzeichnis des übergebenen Knotens noch Unterordner existieren. Wenn ja, dann Childknoten anlegen.

[Bjoerk]

Mann, war das jetzt ein Akt. Knoten, welche man anklickt und dann das Plus verschwindet, mag ich ja gar nicht. So finde ich’s schöner und läuft auch ziemlich flott soweit:

Delphi-Quellcode:

function GetTreeNodePath(const ANode: TTreeNode): string;
var
  I: integer;
begin
  if Assigned(ANode) then
    if Assigned(ANode.Parent) then
      GetTreeNodePath:= GetTreeNodePath(ANode.Parent)+'\'+ANode.Text
    else
      Result:= ANode.Text
  else
    Result:= '';
  if Result <> '' then Result:= Result+'\';
  I:= 1;
  while I < Length(Result) do
  begin
    if (Result[I] = '\') and (Result[I+1] = '\') then
    begin
      Delete (Result, I, 1);
      Dec(I);
    end;
    Inc(I);
  end;
end;

function FindSubDir(const ADir: String; var ASubDir: string): boolean;
var
  S: TSearchRec;
  R: integer;
begin
  Result:= false;
  ASubDir:= '';
  R:= FindFirst(IncludeTrailingPathDelimiter(ADir)+'*.*', faDirectory, S);
  while ((R = 0) and (not Result)) do
  begin
    if ((S.Attr and faDirectory) = faDirectory) then
      if ((S.Name <> '.') and (S.Name <> '..')) then
      begin
        Result:= true;
        ASubDir:= S.Name;
      end;
      R:= FindNext(S);
  end;
  FindClose(S);
end;

procedure GetFirstAndSecondLevel(const APath: String; const ATree: TTreeView; const AStartNode: TTreeNode);
var
  S: TSearchRec;
  R: integer;
  N: TTreeNode;
  ASubPath: string;
begin
  R:= FindFirst(APath+'*.*', faDirectory, S);
  while R = 0 do
  begin
    if ((S.Attr and faDirectory) = faDirectory) then
      if ((S.Name <> '.') and (S.Name <> '..')) then
      begin
        N:= ATree.Items.AddChild(AStartNode, S.Name);
        if FindSubDir(APath+S.Name, ASubPath) then ATree.Items.AddChild(N, ASubPath);
      end;
    R:= FindNext(S);
  end;
  FindClose(S);
end;

procedure IndicatePathTreeView(const ATree: TTreeView; APath: String);
begin
  APath:= IncludeTrailingPathDelimiter(APath);
  ATree.Items.Clear;
  ATree.Items.BeginUpDate;
  GetFirstAndSecondLevel(APath, ATree, ATree.Items.AddChild(Nil, APath));
  ATree.Items.EndUpDate;
  ATree.Items.GetFirstNode.Expand(false);
end;

procedure IndicateSelectedNode(const ATree: TTreeView);
var
  ANode: TTreeNode;
begin
  if ATree.Selected <> ATree.Items.GetFirstNode then
  begin
    ATree.Items.BeginUpDate;
    while ATree.Selected.getFirstChild <> Nil do
      ATree.Items.Delete(ATree.Selected.getFirstChild);
    ANode:= ATree.Selected;
    GetFirstAndSecondLevel(GetTreeNodePath(ANode), ATree, ANode);
    ATree.Items.EndUpDate;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IndicatePathTreeView(TreeView1, 'C:');
end;

procedure TForm1.TreeView1Click(Sender: TObject);
begin
  IndicateSelectedNode(TreeView1);
end;

procedure TForm1.TreeView1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  TreeView1Click(Sender);
end;