delphi - 当磁盘可用空间发生变化时如何收到通知？

Question

我使用了此代码，但它不适用于 SHCNE_FREESPACE，如果我删除或复制指定文件夹中的文件，我不会收到任何通知。仅当我使用其他标志时，我才会收到通知。

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

这是我的尝试(用 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.

以及可能的用法:

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;