Come ricevere una notifica quando lo spazio libero su disco cambia?

Question

Ho usato questo codice ma non funziona per SHCNE_FREESPACE, non ricevo alcuna notifica se elimini o copi i file nella cartella specificata. Solo se uso altre bandiere ricevo notifiche.

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

Ecco il mio tentativo (scritto 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. 

E un possibile uso:

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;