dishchangenotify.pas

来自「DELPHI 访问SQLITE3 数据库的VCL控件」· PAS 代码 · 共 309 行

{-------------------------------------------------------------------------------
 
 Copyright (c) 1999-2007 Ralf Junker, The Delphi Inspiration
 Internet: http://www.yunqa.de/delphi/
 E-Mail:   [e-mail]

-------------------------------------------------------------------------------}

unit DISHChangeNotify;

{$I DI.inc}

interface

uses
  Windows, Messages, Classes, ShlObj;

const

  SHCNRF_InterruptLevel = $0001;

  SHCNRF_ShellLevel = $0002;

  SHCNRF_RecursiveInterrupt = $1000;

type
  TDICustomSHChangeNotify = class;

  TDIShChangeNotifyEvent = procedure(
    const ASender: TDICustomSHChangeNotify;
    const AEvent: Cardinal;
    const APidl1, APidl2: PItemIDList) of object;

  TDICustomSHChangeNotify = class(TComponent)
  private
    FActive: boolean;
    fEvents: Cardinal;
    FHWnd: hWnd;
    FHNotify: THandle;
    FNotification: PItemIDList;
    FNotificationRecursive: boolean;
    fSources: Cardinal;
    FOnNotify: TDIShChangeNotifyEvent;
    procedure SetActive(const AValue: boolean);
    procedure SetEvents(const AValue: Cardinal);
    procedure SetNotifyPidl(const AValue: PItemIDList);
    procedure SetSources(const AValue: Cardinal);
    procedure ShellNotifyDeregister;
    procedure ShellNotifyRegister;
    procedure WndProc(var AMsg: TMessage);
    procedure SetNotifyRecursive(const AValue: boolean);
  protected
    procedure DoNotify(const AEvent: Integer; const APidl1, APidl2: PItemIDList); dynamic;
    procedure Loaded; override;
    property Events: Cardinal read fEvents write SetEvents default SHCNE_ALLEVENTS;
    property NotifyPidl: PItemIDList read FNotification write SetNotifyPidl;
    property NotifyRecursive: boolean read FNotificationRecursive write SetNotifyRecursive;
    property Sources: Cardinal read fSources write SetSources default SHCNRF_InterruptLevel or SHCNRF_ShellLevel;
    property OnNotify: TDIShChangeNotifyEvent read FOnNotify write FOnNotify;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Registered: boolean;
  published
    property Active: boolean read FActive write SetActive;
  end;

  TDISHChangeNotify = class(TDICustomSHChangeNotify)
  public
    property Events;
    property NotifyPidl;
    property NotifyRecursive;
    property Sources;
    property OnNotify;
  end;

procedure FreePidl(const APidl: PItemIDList);

function PathToPIDL(const APath: WideString): PItemIDList;
function PidlToPath(const APidl: PItemIDList): WideString;
procedure StrRetFree(var AStrRet: TStrRet);
function StrRetToStr(const AStrRet: TStrRet; const APidl: PItemIDList): WideString;

implementation

uses
  ActiveX, ShellApi;

var
  ShellMalloc: IMalloc;

const

  SHCNRF_NewDelivery = $8000;

  WM_SHELLNOTIFY = WM_USER + 1;

type

  TSHChangeNotifyEntry = packed record
    pidl: PItemIDList;
    frecursive: bool;
  end;
  PSHChangeNotifyEntry = ^TSHChangeNotifyEntry;

function SHChangeNotifyRegister(hWnd: hWnd; fSources: dword; fEvents: ulong; wMsg: UINT; cEntries: dword; pfsne: PSHChangeNotifyEntry): THandle; stdcall; external shell32 Index 2;
function SHChangeNotifyDeregister(hWnd: hWnd): boolean; stdcall; external shell32 Index 4;

procedure FreePidl(const APidl: PItemIDList);
begin
  ShellMalloc.Free(APidl);
end;

function PathToPIDL(const APath: WideString): PItemIDList;
var
  Desktop: IShellFolder;
  pchEaten, dwAttributes: Cardinal;
begin
  SHGetDesktopFolder(Desktop);
  dwAttributes := 0;
  if Assigned(Desktop) then
    Desktop.ParseDisplayName(0, nil, PWideChar(APath), pchEaten, Result, dwAttributes)
  else
    Result := nil;
end;

function PidlToPath(const APidl: PItemIDList): WideString;
var
  Desktop: IShellFolder;
  StrRet: TStrRet;
begin
  SHGetDesktopFolder(Desktop);
  FillChar(StrRet, SizeOf(StrRet), 0);
  Desktop.GetDisplayNameOf(APidl, SHGDN_FORPARSING, StrRet);
  Result := StrRetToStr(StrRet, APidl);
  StrRetFree(StrRet);
end;

procedure StrRetFree(var AStrRet: TStrRet);
begin
  with AStrRet do
    if (uType = STRRET_WSTR) and Assigned(pOleStr) then
      begin
        ShellMalloc.Free(pOleStr);
        pOleStr := nil;
      end;
end;

function StrRetToStr(const AStrRet: TStrRet; const APidl: PItemIDList): WideString;
var
  P: PAnsiChar;
begin
  with AStrRet do
    case uType of

      STRRET_CSTR:
        SetString(Result, cStr, lStrLen(cStr));

      STRRET_OFFSET:
        if Assigned(APidl) then
          begin
            P := PAnsiChar(@APidl.mkid.abID[uOffset - SizeOf(APidl.mkid.cb)]);
            SetString(Result, P, APidl.mkid.cb - uOffset);
          end
        else
          Result := '';

      STRRET_WSTR:
        Result := pOleStr;
    end;
end;

constructor TDICustomSHChangeNotify.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fSources := SHCNRF_InterruptLevel or SHCNRF_ShellLevel;
  fEvents := SHCNE_ALLEVENTS;
  if not (csDesigning in ComponentState) then
    FHWnd := AllocateHWnd(WndProc);
end;

destructor TDICustomSHChangeNotify.Destroy;
begin
  ShellNotifyDeregister;
  FreePidl(FNotification);
  inherited;
end;

procedure TDICustomSHChangeNotify.DoNotify(const AEvent: Integer; const APidl1, APidl2: PItemIDList);
begin
  if Assigned(FOnNotify) then
    FOnNotify(Self, AEvent, APidl1, APidl2);
end;

procedure TDICustomSHChangeNotify.Loaded;
begin
  inherited;
  if FActive and not Registered then
    ShellNotifyRegister;
end;

procedure TDICustomSHChangeNotify.ShellNotifyDeregister;
begin
  if Registered then
    begin
      SHChangeNotifyDeregister(FHNotify);
      FHNotify := 0;
    end;
end;

procedure TDICustomSHChangeNotify.ShellNotifyRegister;
var
  NR: TSHChangeNotifyEntry;
  s: Cardinal;
begin
  ShellNotifyDeregister;
  s := fSources and not SHCNRF_NewDelivery;
  NR.pidl := FNotification;
  NR.frecursive := FNotificationRecursive;
  FHNotify := SHChangeNotifyRegister(FHWnd, s, fEvents, WM_SHELLNOTIFY, 1, @NR);
end;

function TDICustomSHChangeNotify.Registered: boolean;
begin
  Result := FHNotify <> 0;
end;

procedure TDICustomSHChangeNotify.SetActive(const AValue: boolean);
begin
  if FActive <> AValue then
    begin
      FActive := AValue;
      if not (csDesigning in ComponentState) then
        if FActive then
          begin
            if not Registered then
              ShellNotifyRegister;
          end
        else
          ShellNotifyDeregister;
    end;
end;

procedure TDICustomSHChangeNotify.SetEvents(const AValue: Cardinal);
begin
  if fEvents <> AValue then
    begin
      fEvents := AValue;
      if FActive then
        ShellNotifyRegister;
    end;
end;

procedure TDICustomSHChangeNotify.SetNotifyPidl(const AValue: PItemIDList);
begin
  FNotification := AValue;
  if FActive then
    ShellNotifyRegister;
end;

procedure TDICustomSHChangeNotify.SetNotifyRecursive(const AValue: boolean);
begin
  if FNotificationRecursive <> AValue then
    begin
      FNotificationRecursive := AValue;
      if FActive then
        ShellNotifyRegister;
    end;
end;

procedure TDICustomSHChangeNotify.SetSources(const AValue: Cardinal);
begin
  if fSources <> AValue then
    begin
      fSources := AValue;
      if FActive then
        ShellNotifyRegister;
    end;
end;

procedure TDICustomSHChangeNotify.WndProc(var AMsg: TMessage);
type

  TShellNotifyRec = packed record
    Pidl1: PItemIDList;
    Pidl2: PItemIDList;
  end;
  PShellNotifyRec = ^TShellNotifyRec;
begin
  case AMsg.msg of
    WM_SHELLNOTIFY:
      DoNotify(
        AMsg.LParam,
        PShellNotifyRec(AMsg.wParam).Pidl1,
        PShellNotifyRec(AMsg.wParam).Pidl2);
  else
    AMsg.Result := DefWindowProc(FHWnd, AMsg.msg, AMsg.wParam, AMsg.LParam);
  end;
end;

initialization
  SHGetMalloc(ShellMalloc);

finalization
  ShellMalloc := nil;

end.