How to get notified when disk free space changes? - delphi

Question

I used this code but it doesn't work for SHCNE_FREESPACE, I don't receive any notification if I delete or copy files in the specified folder. Only if I use other flags I receive notifications.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ShlObj, ActiveX;
const
SHCNRF_INTERRUPTLEVEL = $0001;
SHCNRF_SHELLLEVEL = $0002;
SHCNRF_RECURSIVEINTERRUPT = $1000;
SHCNRF_NEWDELIVERY = $8000;
type
TSHChangeNotifyEntry = record
pidl: PItemIdList;
fRecursive: BOOL;
end;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure OnNotifyEvent(var AMessage:TMessage); message WM_USER;
end;
var
Form1: TForm1;
Hand: THandle;
function SHChangeNotifyRegister(OwnerHwnd:HWND; fSources:Integer; fEvents:DWord; wMsg:UINT;
cEntries:Integer; var pshcne:TSHChangeNotifyEntry):ULONG; stdcall; external 'shell32.dll';
function SHChangeNotifyDeregister(ulID:ULONG):BOOL; stdcall; external 'shell32.dll';
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var Desktop:IShellFolder;
pidl:PItemIdList;
Path:String;
Eaten,attr,Events,Sources:DWord;
cnPIDL:TSHChangeNotifyEntry;
begin
if Succeeded(SHGetDesktopFolder(Desktop)) then begin
Path:='D:\Test';
if Succeeded(Desktop.ParseDisplayName(0, nil, PWideChar(Path), Eaten, pidl, attr)) then begin
Caption:=Path;
cnPIDL.pidl:=pidl;
cnPIDL.fRecursive:=true;
Sources:=SHCNRF_INTERRUPTLEVEL or SHCNRF_SHELLLEVEL or SHCNRF_NEWDELIVERY or SHCNRF_RECURSIVEINTERRUPT;
Events:=SHCNE_FREESPACE;
Hand:=SHChangeNotifyRegister(Handle, Sources, Events, WM_USER, 1, cnPIDL);;
CoTaskMemFree(pidl);
end;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
SHChangeNotifyDeregister(Hand);
end;
procedure TForm1.OnNotifyEvent(var AMessage: TMessage);
begin
if AMessage.Msg = WM_USER then Caption:=Caption+' x';
end;
end.

Answer 1

Here's my attempt (written in Delphi 2009):
unit DiskSpace;
interface
uses
Windows, Messages, Classes, ShlObj;
type
PLONG = ^LONG;
LONG = LongInt;
TSpaceChangeEvent = procedure(Sender: TObject; const DiskFree, DiskTotal: Int64) of object;
TDiskSpace = class
strict private
FDiskRoot: string;
FDiskFree: Int64;
FDiskTotal: Int64;
FWndHandle: HWND;
FNotifierID: ULONG;
FOnSpaceChange: TSpaceChangeEvent;
protected
procedure WndProc(var Msg: TMessage); virtual;
procedure DoSpaceChange(const DiskFree, DiskTotal: Int64); virtual;
public
constructor Create(Drive: Char); virtual;
destructor Destroy; override;
property DiskRoot: string read FDiskRoot;
property DiskFree: Int64 read FDiskFree;
property DiskTotal: Int64 read FDiskTotal;
property OnSpaceChange: TSpaceChangeEvent read FOnSpaceChange write FOnSpaceChange;
end;
implementation
const
shell32 = 'shell32.dll';
SHCNRF_InterruptLevel = $0001;
SHCNRF_ShellLevel = $0002;
SHCNRF_RecursiveInterrupt = $1000;
SHCNRF_NewDelivery = $8000;
WM_SHELL_ITEM_NOTIFY = WM_USER + 666;
type
PSHChangeNotifyEntry = ^TSHChangeNotifyEntry;
TSHChangeNotifyEntry = record
pidl: PItemIDList;
fRecursive: BOOL;
end;
procedure ILFree(pidl: PItemIDList); stdcall;
external shell32 name 'ILFree';
function ILCreateFromPath(pszPath: PWideChar): PItemIDList; stdcall;
external shell32 name 'ILCreateFromPathW';
function SHChangeNotifyRegister(hwnd: HWND; fSources: Integer; fEvents: LONG; wMsg: UINT;
cEntries: Integer; pshcne: PSHChangeNotifyEntry): ULONG; stdcall;
external shell32 name 'SHChangeNotifyRegister';
function SHChangeNotifyDeregister(ulID: ULONG): BOOL; stdcall;
external shell32 name 'SHChangeNotifyDeregister';
{ TDiskSpace }
constructor TDiskSpace.Create(Drive: Char);
var
NotifyEntry: TSHChangeNotifyEntry;
begin
FDiskRoot := Drive + ':\';
FWndHandle := AllocateHWnd(WndProc);
NotifyEntry.pidl := ILCreateFromPath(PWideChar(FDiskRoot));
try
NotifyEntry.fRecursive := True;
FNotifierID := SHChangeNotifyRegister(
FWndHandle,
SHCNRF_ShellLevel or SHCNRF_InterruptLevel or SHCNRF_RecursiveInterrupt,
SHCNE_CREATE or SHCNE_DELETE or SHCNE_UPDATEITEM,
WM_SHELL_ITEM_NOTIFY,
1,
#NotifyEntry);
finally
ILFree(NotifyEntry.pidl);
end;
end;
destructor TDiskSpace.Destroy;
begin
if FNotifierID <> 0 then
SHChangeNotifyDeregister(FNotifierID);
if FWndHandle <> 0 then
DeallocateHWnd(FWndHandle);
inherited;
end;
procedure TDiskSpace.WndProc(var Msg: TMessage);
var
NewFree: Int64;
NewTotal: Int64;
begin
if (Msg.Msg = WM_SHELL_ITEM_NOTIFY) then
begin
if GetDiskFreeSpaceEx(PChar(FDiskRoot), NewFree, NewTotal, nil) then
begin
if (FDiskFree <> NewFree) or (FDiskTotal <> NewTotal) then
begin
FDiskFree := NewFree;
FDiskTotal := NewTotal;
DoSpaceChange(FDiskFree, FDiskTotal);
end;
end
else
begin
FDiskFree := -1;
FDiskTotal := -1;
end;
end
else
Msg.Result := DefWindowProc(FWndHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;
procedure TDiskSpace.DoSpaceChange(const DiskFree, DiskTotal: Int64);
begin
if Assigned(FOnSpaceChange) then
FOnSpaceChange(Self, DiskFree, DiskTotal);
end;
end.
And a possible usage:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FDiskSpace: TDiskSpace;
procedure DiskSpaceChange(Sender: TObject; const DiskFree, DiskTotal: Int64);
end;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
FDiskSpace := TDiskSpace.Create('C');
FDiskSpace.OnSpaceChange := DiskSpaceChange;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FDiskSpace.Free;
end;
procedure TForm1.DiskSpaceChange(Sender: TObject; const DiskFree, DiskTotal: Int64);
begin
Caption := Format('%d/%d B', [DiskFree, DiskTotal]);
end;