FilesAndFolders/SizeThread.PAS at main · Hellogramming/FilesAndFolders · GitHub

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
unit SizeThread;

interface

uses
  Windows, Messages;

const
  WM_UPDATEDIRSIZE = WM_USER + 1;

var
  FolderSize, ActualFolderSize, FileNo, FolderNo : Int64;
  CurClusterSize   : Integer;
  fDirThreadActive : Boolean;
  fKillDirThread   : Boolean;
  hDirThread       : THandle;
  IDDirThread      : LongWord;
  hDirTreeOwner    : HWND;
  curDir           : string;
  Tick             : Cardinal;

function DirThreadMain(Ignored : Pointer) : Integer;

function GetActualSize(LogicalSize : Int64; ClusterSize : Integer) : Int64;

implementation

uses SysUtils;

function GetActualSize(LogicalSize : Int64; ClusterSize : Integer) : Int64;
const
  Vals : array[False..True] of Integer = (0, 1);
begin
  Result := (LogicalSize div ClusterSize)*ClusterSize;
  Inc(Result, Vals[LogicalSize mod ClusterSize <> 0]*ClusterSize);
end;

procedure DirThreadProcess(const Path : string);
var
  SearchRec : TSearchRec;
  Status : Integer;
  NewTick : Cardinal;
begin
  NewTick := GetTickCount;
  if NewTick - Tick > 250 then
  begin
    Tick := NewTick;
    PostMessage(hDirTreeOwner, WM_UPDATEDIRSIZE, 0, 0);
  end;
  Status := FindFirst(Path + '\*.*', faAnyFile, SearchRec);
  try
    while Status = 0 do
    begin
      if fKillDirThread then Exit;
      if (SearchRec.Attr and faDirectory = faDirectory) then
      begin
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          Inc(FolderNo);
          DirThreadProcess(Path + '\' + SearchRec.Name);
        end;
      end
      else
      begin
        Inc(FolderSize, SearchRec.Size);
        Inc(ActualFolderSize, GetActualSize(SearchRec.Size, CurClusterSize));
        Inc(FileNo);
      end;
      Status := FindNext(SearchRec);
    end;
  finally
    FindClose(SearchRec);
  end;
end;

function DirThreadMain(Ignored : Pointer) : Integer;
begin
  FolderSize := 0;
  ActualFolderSize := 0;
  FileNo     := 0;
  FolderNo   := 0;
  Tick       := GetTickCount;
  DirThreadProcess(curDir);
  Result := 0;
  if fKillDirThread = False then PostMessage(hDirTreeOwner, WM_UPDATEDIRSIZE, 0, 0);
  fDirThreadActive := False;
  EndThread(Result);
end;

end.