delphi – 如何在磁盘可用空间更改时收到通知？

unit DiskSpace;

interface

uses
  Windows,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,@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.

可能的用法：

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;