Belegter Speicherplatz von Verzeichnissen ermitteln?

[dstein]

Die einzelnen Dateien mit FileSize auslesen und zusammenzählen ist recht langsam und mit Subdirs wird es noch langsamer.
Mit JAM ShellBrowser Delphi Components bekomme ich nur Laufwerke hin.
Gibt es eine andere Möglichkeit?

[Der schöne Günther]

Scheint unter NTFS halt so zu sein. Rechtsklick im Windows-Explorer auf einen Ordner und die Kiste rödelt gerne minutenlang wenn sie hunderttausende Dateien erst aufsummieren muss. Wenn das besser ginge würde das Microsoft in seinem Explorer sicher machen.

[KodeZwerg]

Ich mache bei sowas einen Thread auf der dann fröhlich vor sich hin zählt. So wird die Hauptanwendung nicht blockiert, da ich nicht weiß für was für einen Zweck du das brauchst kann es auch der falsche weg sein.

[KodeZwerg]

https://stackoverflow.com/questions/...ctory-size-api <- gute variante finde ich.

Delphi-Quellcode:

function ListFilesOf(CONST aFolder, FileType: string; CONST ReturnFullPath, DigSubdirectories: Boolean): TTSL;
{ If DigSubdirectories is false, it will return only the top level files,
  else it will return also the files in subdirectories of subdirectories.
  If FullPath is true the returned files will have full path.
  FileType can be something like '*.*' or '*.exe;*.bin'
  Will show also the Hidden/System files.
  Source Marco Cantu Delphi 2010 HandBook

   // Works with UNC paths}
VAR
  i: Integer;
  s: string;
  SubFolders, filesList: TStringDynArray;
  MaskArray: TStringDynArray;
  Predicate: TDirectory.TFilterPredicate;

 procedure ListFiles(CONST aFolder: string);
 VAR strFile: string;
 begin
  Predicate:=
        function(const Path: string; const SearchRec: TSearchRec): Boolean
        VAR Mask: string;
        begin
          for Mask in MaskArray DO
            if System.Masks.MatchesMask(SearchRec.Name, Mask)
            then EXIT(TRUE);
          EXIT(FALSE);
        end;

  filesList:= TDirectory.GetFiles (aFolder, Predicate);
  for strFile in filesList DO
   if strFile<> ''                                                                                 { Bug undeva: imi intoarce doua intrari empty ('') }
   then Result.Add(strFile);
 end;

begin
 { I need this in order to prevent the EPathTooLongException (reported by some users) }
 if aFolder.Length >= MAXPATH then
  begin
   MesajError('Path is longer than '+ IntToStr(MAXPATH)+ ' characters!');
   EXIT(NIL);
  end;

 if NOT System.IOUtils.TDirectory.Exists (aFolder)
 then RAISE Exception.Create('Folder does not exist! '+ CRLF+ aFolder);

 Result:= TTSL.Create;

 { Split FileType in subcomponents }
 MaskArray:= System.StrUtils.SplitString(FileType, ';');

 { Search the parent folder }
 ListFiles(aFolder);

 { Search in all subfolders }
 if DigSubdirectories then
  begin
   SubFolders:= TDirectory.GetDirectories(aFolder, TSearchOption.soAllDirectories, NIL);
   for s in SubFolders DO
     if cIO.DirectoryExists(s)                                                                     { This solves the problem caused by broken 'Symbolic Link' folders }
     then ListFiles(s);
  end;

 { Remove full path }
 if NOT ReturnFullPath then
  for i:= 0 to Result.Count-1 DO
   Result[i]:= TPath.GetFileName(Result[i]);
end;

{ Works with >4GB files
  Source: http://stackoverflow.com/questions/1642220/getting-size-of-a-file-in-delphi-2010-or-later }
function GetFileSize(const aFilename: String): Int64;
VAR
   info: TWin32FileAttributeData;
begin
 if GetFileAttributesEx(PWideChar(aFileName), GetFileExInfoStandard, @info)
 then Result:= Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32)
 else Result:= -1;
end;

function GetFolderSize(aFolder: string; FileType: string= '*.*'; DigSubdirectories: Boolean= TRUE): Int64;
VAR
   i: Integer;
   TSL: TTSL;
begin
 Result:= 0;
 TSL:= ListFilesOf(aFolder, FileType, TRUE, DigSubdirectories);
 TRY
  for i:= 0 to TSL.Count-1 DO
   Result:= Result+ GetFileSize(TSL[i]);
 FINALLY
  FreeAndNil(TSL);
 END;
end;

Zitat:

Note that:
1. You can only count the size of some file types in a folder. For example in a folder containing BMP and JPEG files, if you want/need, you can only obtain the folder size only for BMP files.
2. Multiple filetypes are supported, like this: '.bmp;.png'.
3. You can choose if you want to read or not rea the size of the sub-folders.

Further improvements: You can massively reduce the size of the code by eliminating the GetFolderSize and moving the GetFileSize directly into ListFilesOf.

[jziersch]

Zitat von dstein:

Die einzelnen Dateien mit FileSize auslesen und zusammenzählen ist recht langsam und mit Subdirs wird es noch langsamer.

So kann man es machen:

Code:

function DirSize( path : String ) : Int64;
var sr: TSearchRec;  
begin
      path := IncludeTrailingPathDelimiter(path);
      Result := 0;
      if FindFirst( path   + '*.*', faAnyFile, sr) = 0 then
      try
          repeat
              if (sr.Attr and faDirectory)=faDirectory then
              begin
                 if  (sr.Name<>'') and  (sr.Name<>'.') and  (sr.Name<>'..') then
                    Result := Result  + DirSize(path + sr.Name );
              end
              else Result := Result  + sr.Size;
          until FindNext(sr) <> 0;
      finally
          FindCLose(sr);
      end;
end;

[dstein]

Danke, probiere es mal aus. Mein Recherchefehler hatte gewohnheitsmässig in deutsch gesucht.

[Benmik]

Zitat von dstein:

Gibt es eine andere Möglichkeit?

Klar, die MFT direkt auslesen. Geht in Sekundenbruchteilen. Einziger Nachteil: Benötigt Administratorenrechte.

[Andreas13]

Zitat von jziersch:

So kann man es machen:

Code:

function DirSize( path : String ) : Int64;
var sr: TSearchRec;  
begin
      path := IncludeTrailingPathDelimiter(path);
      Result := 0;
      if FindFirst( path   + '*.*', faAnyFile, sr) = 0 then
      try
          repeat
              if (sr.Attr and faDirectory)=faDirectory then
              begin
                 if  (sr.Name<>'') and  (sr.Name<>'.') and  (sr.Name<>'..') then
                    Result := Result  + DirSize(path + sr.Name );
              end
              else Result := Result  + sr.Size;
          until FindNext(sr) <> 0;
      finally
          FindCLose(sr);
      end;
end;

Nur eine kleine Korrektur: Anstelle von

Delphi-Quellcode:

  Finally
    FindClose(sr);
  End;

solltest Du einen qualifizierten Bezeichner verwenden, weil es FindClose auch in Winapi.Windows gibt und der Compiler u. U. ins Stocken gerät...

Delphi-Quellcode:

  Finally
    System.SysUtils.FindClose(sr);
  End;

Viele Grüße, Andreas

[KodeZwerg]

Delphi-Quellcode:

Unit22;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm22 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    CheckBox1: TCheckBox;
    FileOpenDialog1: TFileOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form22: TForm22;

implementation

{$R *.dfm}

uses
  System.IOUtils;

type
  TMyFile = packed record
    Folder: string;
    Filename: string;
    Filesize: Int64;
    Archive: Boolean;
    ReadOnly: Boolean;
    Hidden: Boolean;
    System: Boolean;
  end;

  TMyFiles = array of TMyFile;
  TMyFolders = array of string;

  TMyFileSystem = class (TPersistent)
    strict private
      FContent: TMyFiles;
      FFolderNames: TMyFolders;
      FFolderCount: Int64;
      FFileCount: Int64;
      FSize: Int64;
      FBaseFolder: string;
      FIncludeSub: Boolean;
    protected
      procedure AddFile(const APath: string);
      procedure AddFolder(const APath: string);
    private
      procedure Reset;
      procedure Init(const APath: string; const AIncludeSub: Boolean = False);
      procedure SetBaseFolder(const APath: string);
    public
      constructor Create(const APath: string; const AIncludeSub: Boolean = False); overload;
      constructor Create(); overload;
      destructor Destroy; override;
    public
      property BaseFolder: string read FBaseFolder write SetBaseFolder;
      property IncludeSub: Boolean read FIncludeSub write FIncludeSub;
      property Files: Int64 read FFileCount;
      property Folders: Int64 read FFolderCount;
      property Size: Int64 read FSize;
      property FileItems: TMyFiles read FContent;
      property FolderItems: TMyFolders read FFolderNames;
  end;

constructor TMyFileSystem.Create(const APath: string; const AIncludeSub: Boolean = False);
begin
  inherited Create;
  Self.Reset;
  Self.Init(APath, AIncludeSub);
end;

constructor TMyFileSystem.Create();
begin
  inherited Create;
  Self.Reset;
end;

destructor TMyFileSystem.Destroy;
begin
  Self.Reset;
  inherited Destroy;
end;

procedure TMyFileSystem.Reset;
begin
  SetLength(FContent, 0);
  SetLength(FFolderNames, 0);
  FFolderCount := 0;
  FFileCount := 0;
  FSize := 0;
  FBaseFolder := '';
  FIncludeSub := False;
end;

procedure TMyFileSystem.SetBaseFolder(const APath: string);
begin
  Self.Reset;
  Self.Init(APath, FIncludeSub);
end;

procedure TMyFileSystem.Init(const APath: string; const AIncludeSub: Boolean = False);
var
  LString: string;
begin
  FIncludeSub := AIncludeSub;
  if TDirectory.Exists(APath) then
    begin
      FBaseFolder := APath;
      case AIncludeSub of
        True:  begin
                 for LString in TDirectory.GetFiles(FBaseFolder, '*', TSearchOption.soAllDirectories) do
                   Self.AddFile(LString);
                 for LString in TDirectory.GetDirectories(FBaseFolder, '*', TSearchOption.soAllDirectories) do
                   Self.AddFolder(LString);
               end;
        False: begin
                 for LString in TDirectory.GetFiles(FBaseFolder, '*', TSearchOption.soTopDirectoryOnly) do
                   Self.AddFile(LString);
                 for LString in TDirectory.GetDirectories(FBaseFolder, '*', TSearchOption.soTopDirectoryOnly) do
                   Self.AddFolder(LString);
               end;
      end;
    end;
end;

procedure TMyFileSystem.AddFile(const APath: string);
  function MyGetFileSize(const APath: String): Int64;
    var
      Win32FileAttributeData: TWin32FileAttributeData;
    begin
      Result := -1;
      if (not GetFileAttributesEx(PChar(APath), GetFileExInfoStandard, @Win32FileAttributeData)) then
        Exit;
      Result := Int64(Win32FileAttributeData.nFileSizeLow) or Int64(Win32FileAttributeData.nFileSizeHigh shl 32);
    end;
var
  i: Integer;
  FileAttributes: TFileAttributes;
begin
  i := Length(FContent);
  SetLength(FContent, i + 1);
  FContent[i].Folder := ExtractFilePath(APath);
  FContent[i].Filename := ExtractFileName(APath);
  FileAttributes := TFile.GetAttributes(APath, False);
  FContent[i].ReadOnly := (TFileAttribute.faReadOnly in FileAttributes);
  FContent[i].Hidden := (TFileAttribute.faHidden in FileAttributes);
  FContent[i].System := (TFileAttribute.faSystem in FileAttributes);
  FContent[i].Archive := (TFileAttribute.faArchive in FileAttributes);
  FContent[i].Filesize := MyGetFileSize(APath);
  Inc(FFileCount, 1);
  FSize := FSize + FContent[i].Filesize;
end;

procedure TMyFileSystem.AddFolder(const APath: string);
var
  i: Integer;
begin
  i := Length(FFolderNames);
  SetLength(FContent, i + 1);
  FFolderNames[i] := ExtractFileName(APath);
  Inc(FFolderCount);
end;

procedure TForm22.Button1Click(Sender: TObject);
var
  FileSystem: TMyFileSystem;
begin
  if FileOpenDialog1.Execute then
    begin
      FileSystem := TMyFileSystem.Create(FileOpenDialog1.FileName, CheckBox1.Checked);
      try
        for i := 0 to FileSystem.Files - 1 do
          Memo1.Lines.Add({FileSystem.FileItems[i].Folder +} FileSystem.FileItems[i].Filename);
        Label1.Caption := FileSystem.BaseFolder;
        Label2.Caption := UIntToStr(FileSystem.Size);
      finally
        FileSystem.Free;
      end;
    end;
end;


end.

hatte ich mal auf die schnelle für einen discord user getippst, sind bestimmt noch optimierungen vorhanden aber grundsätzlich macht es was es soll.
vielleicht hilft es?