Получение уведомлений от оболочки (Shell)

Материал из DRKB

Получение уведомлений от оболочки (Shell)[править | править код]

Пример показывает - как можно отслеживать практически все события происходящий в Вашей оболочке. Код находится в процессе разработки, но уже содержит в себе большое количество возможностей.

{$IFNDEF VER80} {$IFNDEF VER90} {$IFNDEF VER93}
{$DEFINE Delphi3orHigher}
{$ENDIF} {$ENDIF} {$ENDIF}

unit ShellNotify;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
  {$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, ComObj, {$ENDIF}
  ShlObj;


type
  NOTIFYREGISTER = record
    pidlPath : PItemIDList;
    bWatchSubtree : boolean;
  end;

  PNOTIFYREGISTER = ^NOTIFYREGISTER;

const
  SNM_SHELLNOTIFICATION = WM_USER +1;
  SHCNF_ACCEPT_INTERRUPTS = $0001;
  SHCNF_ACCEPT_NON_INTERRUPTS = $0002;
  SHCNF_NO_PROXY = $8000;

type
  TNotificationEvent = (neAssociationChange, neAttributesChange,
    neFileChange, neFileCreate, neFileDelete, neFileRename,
    neDriveAdd, neDriveRemove, neShellDriveAdd, neDriveSpaceChange,
    neMediaInsert, neMediaRemove, neFolderCreate, neFolderDelete,
    neFolderRename, neFolderUpdate, neNetShare, neNetUnShare,
    neServerDisconnect, neImageListChange);
  TNotificationEvents = set of TNotificationEvent;

  TShellNotificationEvent1 = procedure(Sender: TObject; Path: string)of object;
  TShellNotificationEvent2 = procedure(Sender: TObject; path1, path2: string) of object;
  // TShellNotificationAttributesEvent = procedure(Sender: TObject; OldAttribs, NewAttribs: Integer) of Object;

  TShellNotification = class(TComponent)
  private
    FWatchEvents: TNotificationEvents;
    FPath: string;
    FActive, FWatch: Boolean;

    prevPath1, prevPath2: string;
    PrevEvent: Integer;

    Handle, NotifyHandle: HWND;

    FOnAssociationChange: TNotifyEvent;
    FOnAttribChange: TShellNotificationEvent2;
    FOnCreate: TShellNotificationEvent1;
    FOnDelete: TShellNotificationEvent1;
    FOnDriveAdd: TShellNotificationEvent1;
    FOnDriveAddGui: TShellNotificationEvent1;
    FOnDriveRemove: TShellNotificationEvent1;
    FOnMediaInsert: TShellNotificationEvent1;
    FOnMediaRemove: TShellNotificationEvent1;
    FOnDirCreate: TShellNotificationEvent1;
    FOnNetShare: TShellNotificationEvent1;
    FOnNetUnShare: TShellNotificationEvent1;
    FOnRenameFolder: TShellNotificationEvent2;
    FOnItemRename: TShellNotificationEvent2;
    FOnFolderRemove: TShellNotificationEvent1;
    FOnServerDisconnect: TShellNotificationEvent1;
    FOnFolderUpdate: TShellNotificationEvent1;

    function PathFromPidl(Pidl: PItemIDList): string;
    procedure SetWatchEvents(const Value: TNotificationEvents);
    function GetActive: Boolean;
    procedure SetActive(const Value: Boolean);
    procedure SetPath(const Value: string);
    procedure SetWatch(const Value: Boolean);
  protected
    procedure ShellNotifyRegister;
    procedure ShellNotifyUnregister;
    procedure WndProc(var message: TMessage);

    procedure DoAssociationChange; dynamic;
    procedure DoAttributesChange(Path1, Path2: string); dynamic;
    procedure DoCreateFile(Path: string); dynamic;
    procedure DoDeleteFile(Path: string); dynamic;
    procedure DoDriveAdd(Path:string); dynamic;
    procedure DoDriveAddGui(Path: string); dynamic;
    procedure DoDriveRemove(Path: string); dynamic;
    procedure DoMediaInsert(Path: string); dynamic;
    procedure DoMediaRemove(Path: string); dynamic;
    procedure DoDirCreate(Path: string); dynamic;
    procedure DoNetShare(Path: string); dynamic;
    procedure DoNetUnShare(Path: string); dynamic;
    procedure DoRenameFolder(Path1, Path2: string); dynamic;
    procedure DoRenameItem(Path1, Path2: string); dynamic;
    procedure DoFolderRemove(Path: string); dynamic;
    procedure DoServerDisconnect(Path: string); dynamic;
    procedure DoDirUpdate(Path: string); dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Path: string read FPath write SetPath;
    property Active: Boolean read GetActive write SetActive;
    property WatchSubTree: Boolean read FWatch write SetWatch;

    property WatchEvents: TNotificationEvents read FWatchEvents write SetWatchEvents;

    property OnAssociationChange: TNotifyEvent read FOnAssociationChange write FOnAssociationChange;
    property OnAttributesChange: TShellNotificationEvent2 read FOnAttribChange write FOnAttribChange;
    property OnFileCreate: TShellNotificationEvent1 read FOnCreate write FOnCreate;
    property OnFolderRename: TShellNotificationEvent2 read FOnRenameFolder write FOnRenameFolder;
    property OnFolderUpdate: TShellNotificationEvent1 read FOnFolderUpdate write FOnFolderUpdate;
    property OnFileDelete: TShellNotificationEvent1 read FOnDelete write FOnDelete;
    property OnDriveAdd: TShellNotificationEvent1 read FOnDriveAdd write FOnDriveAdd;
    property OnFolderRemove: TShellNotificationEvent1 read FOnFolderRemove write FOnFolderRemove;
    property OnItemRename: TShellNotificationEvent2 read FOnItemRename write FOnItemRename;
    property OnDriveAddGui: TShellNotificationEvent1 read FOnDriveAddGui write FOnDriveAddGui;
    property OnDriveRemove: TShellNotificationEvent1 read FOnDriveRemove write FOnDriveRemove;
    property OnMediaInserted: TShellNotificationEvent1 read FOnMediaInsert write FOnMediaInsert;
    property OnMediaRemove: TShellNotificationEvent1 read FOnMediaRemove write FOnMediaRemove;
    property OnDirCreate: TShellNotificationEvent1 read FOnDirCreate write FOnDirCreate;
    property OnNetShare: TShellNotificationEvent1 read FOnNetShare write FOnNetShare;
    property OnNetUnShare: TShellNotificationEvent1 read FOnNetUnShare write FOnNetUnShare;
    property OnServerDisconnect: TShellNotificationEvent1 read FOnServerDisconnect write FOnServerDisconnect;
  end;

implementation

const Shell32DLL = 'shell32.dll';

function SHChangeNotifyRegister(hWnd: HWND; dwFlags: Integer;
  wEventMask: Cardinal; uMsg: UINT; cItems: Integer;
  lpItems: PNOTIFYREGISTER): HWND;
  stdcall; external Shell32DLL index 2;

function SHChangeNotifyDeregister(hWnd: HWND): Boolean;
  stdcall; external Shell32DLL index 4;

function SHILCreateFromPath(Path: Pointer; PIDL: PItemIDList; var Attributes: ULONG): HResult;
  stdcall; external Shell32DLL index 28;

{ TShellNotification }

constructor TShellNotification.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if not (csDesigning in ComponentState) then
    Handle := AllocateHWnd(WndProc);
end;

destructor TShellNotification.Destroy;
begin
  if not (csDesigning in ComponentState) then
    Active := False;
  if Handle <> 0 then
    DeallocateHWnd(Handle);
  inherited Destroy;
end;

procedure TShellNotification.DoAssociationChange;
begin
  if Assigned(FOnAssociationChange) and (neAssociationChange in FWatchEvents) then
    FOnAssociationChange(Self);
end;

procedure TShellNotification.DoAttributesChange;
begin
  if Assigned(FOnAttribChange) then
    FOnAttribChange(Self, Path1, Path2);
end;

procedure TShellNotification.DoCreateFile(Path: string);
begin
  if Assigned(FOnCreate) then
    FOnCreate(Self, Path);
end;

procedure TShellNotification.DoDeleteFile(Path: string);
begin
  if Assigned(FOnDelete) then
    FOnDelete(Self, Path);
end;

procedure TShellNotification.DoDirCreate(Path: string);
begin
  if Assigned(FOnDirCreate) then
    FOnDirCreate(Self, Path);
end;

procedure TShellNotification.DoDirUpdate(Path: string);
begin
  if Assigned(FOnFolderUpdate) then
    FOnFolderUpdate(Self, Path);
end;

procedure TShellNotification.DoDriveAdd(Path: string);
begin
  if Assigned(FOnDriveAdd) then
    FOnDriveAdd(Self, Path);
end;

procedure TShellNotification.DoDriveAddGui(Path: string);
begin
  if Assigned(FOnDriveAddGui) then
    FOnDriveAdd(Self, Path);
end;

procedure TShellNotification.DoDriveRemove(Path: string);
begin
  if Assigned(FOnDriveRemove) then
    FOnDriveRemove(Self, Path);
end;

procedure TShellNotification.DoFolderRemove(Path: string);
begin
  if Assigned(FOnFolderRemove) then
    FOnFolderRemove(Self, Path);
end;

procedure TShellNotification.DoMediaInsert(Path: string);
begin
  if Assigned(FOnMediaInsert) then
    FOnMediaInsert(Self, Path);
end;

procedure TShellNotification.DoMediaRemove(Path: string);
begin
  if Assigned(FOnMediaRemove) then
    FOnMediaRemove(Self, Path);
end;

procedure TShellNotification.DoNetShare(Path: string);
begin
  if Assigned(FOnNetShare) then
    FOnNetShare(Self, Path);
end;

procedure TShellNotification.DoNetUnShare(Path: string);
begin
  if Assigned(FOnNetUnShare) then
    FOnNetUnShare(Self, Path);
end;

procedure TShellNotification.DoRenameFolder(Path1, Path2: string);
begin
  if Assigned(FOnRenameFolder) then
    FOnRenameFolder(Self, Path1, Path2);
end;

procedure TShellNotification.DoRenameItem(Path1, Path2: string);
begin
  if Assigned(FOnItemRename) then
    FonItemRename(Self, Path1, Path2);
end;

procedure TShellNotification.DoServerDisconnect(Path: string);
begin
  if Assigned(FOnServerDisconnect) then
    FOnServerDisconnect(Self, Path);
end;

function TShellNotification.GetActive: Boolean;
begin
  Result := (NotifyHandle <> 0) and (FActive);
end;

function TShellNotification.PathFromPidl(Pidl: PItemIDList): string;
begin
  SetLength(Result, Max_Path);
  if not SHGetPathFromIDList(Pidl, PChar(Result)) then
    Result := '';
  if Pos(#0, Result) > 0 then
    SetLength(Result, Pos(#0, Result));
end;

procedure TShellNotification.SetActive(const Value: Boolean);
begin
  if (Value <> FActive) then
  begin
    FActive := Value;
    if FActive then
      ShellNotifyRegister
    else
      ShellNotifyUnregister;
  end;
end;

procedure TShellNotification.SetPath(const Value: string);
begin
  if FPath <> Value then
  begin
    FPath := Value;
    ShellNotifyRegister();
  end;
end;

procedure TShellNotification.SetWatch(const Value: Boolean);
begin
  if FWatch <> Value then
  begin
    FWatch := Value;
    ShellNotifyRegister();
  end;
end;

procedure TShellNotification.SetWatchEvents(
const Value: TNotificationEvents);
begin
  if FWatchEvents <> Value then
  begin
    FWatchEvents := Value;
    ShellNotifyRegister();
  end;
end;

procedure TShellNotification.ShellNotifyRegister;
var
  NotifyRecord: PNOTIFYREGISTER;
  Flags: DWORD;
  Pidl: PItemIDList;
  Attributes: ULONG;
begin
  if (not (csDesigning in ComponentState))
  and (not (csLoading in ComponentState)) then
  begin
    SHILCreatefromPath(PChar(FPath), Addr(Pidl), Attributes);
    NotifyRecord^.pidlPath := Pidl;
    NotifyRecord^.bWatchSubtree := FWatch;

    if NotifyHandle <> 0 then
      ShellNotifyUnregister;
    Flags := 0;
    if neAssociationChange in FWatchEvents then
      Flags := Flags or SHCNE_ASSOCCHANGED;
    if neAttributesChange in FWatchEvents then
      Flags := Flags or SHCNE_ATTRIBUTES;
    if neFileChange in FWatchEvents then
      Flags := Flags or SHCNE_UPDATEITEM;
    if neFileCreate in FWatchEvents then
      Flags := Flags or SHCNE_CREATE;
    if neFileDelete in FWatchEvents then
      Flags := Flags or SHCNE_DELETE;
    if neFileRename in FWatchEvents then
      Flags := Flags or SHCNE_RENAMEITEM;
    if neDriveAdd in FWatchEvents then
      Flags := Flags or SHCNE_DRIVEADD;
    if neDriveRemove in FWatchEvents then
      Flags := Flags or SHCNE_DRIVEREMOVED;
    if neShellDriveAdd in FWatchEvents then
      Flags := Flags or SHCNE_DRIVEADDGUI;
    if neDriveSpaceChange in FWatchEvents then
      Flags := Flags or SHCNE_FREESPACE;
    if neMediaInsert in FWatchEvents then
      Flags := Flags or SHCNE_MEDIAINSERTED;
    if neMediaRemove in FWatchEvents then
      Flags := Flags or SHCNE_MEDIAREMOVED;
    if neFolderCreate in FWatchEvents then
      Flags := Flags or SHCNE_MKDIR;
    if neFolderDelete in FWatchEvents then
      Flags := Flags or SHCNE_RMDIR;
    if neFolderRename in FWatchEvents then
      Flags := Flags or SHCNE_RENAMEFOLDER;
    if neFolderUpdate in FWatchEvents then
      Flags := Flags or SHCNE_UPDATEDIR;
    if neNetShare in FWatchEvents then
      Flags := Flags or SHCNE_NETSHARE;
    if neNetUnShare in FWatchEvents then
      Flags := Flags or SHCNE_NETUNSHARE;
    if neServerDisconnect in FWatchEvents then
      Flags := Flags or SHCNE_SERVERDISCONNECT;
    if neImageListChange in FWatchEvents then
      Flags := Flags or SHCNE_UPDATEIMAGE;
    NotifyHandle := SHChangeNotifyRegister(Handle,
      SHCNF_ACCEPT_INTERRUPTS or SHCNF_ACCEPT_NON_INTERRUPTS,
      Flags, SNM_SHELLNOTIFICATION, 1, NotifyRecord);
  end;
end;

procedure TShellNotification.ShellNotifyUnregister;
begin
  if NotifyHandle <> 0 then
    SHChangeNotifyDeregister(NotifyHandle);
end;

procedure TShellNotification.WndProc(var message: TMessage);
type
  TPIDLLIST = record
    pidlist: array[1..2] of PITEMIDLIST;
  end;
  PIDARRAY = ^TPIDLLIST;
var
  Path1: string;
  Path2: string;
  ptr: PIDARRAY;
  repeated: Boolean;
  event: LongInt;
begin
  case message.Msg of
    SNM_SHELLNOTIFICATION:
    begin
      event := message.LParam and ($7FFFFFFF);
      Ptr := PIDARRAY(message.WParam);

      Path1 := PathFromPidl(Ptr^.pidlist[1]);
      Path2 := PathFromPidl(Ptr^.pidList[2]);

      repeated := (PrevEvent = event)
              and (uppercase(prevpath1) = uppercase(Path1))
              and (uppercase(prevpath2) = uppercase(Path2));

      if Repeated then
        exit;

      PrevEvent := message.Msg;
      prevPath1 := Path1;
      prevPath2 := Path2;

      case event of
        SHCNE_ASSOCCHANGED: DoAssociationChange;
        SHCNE_ATTRIBUTES: DoAttributesChange(Path1, Path2);
        SHCNE_CREATE: DoCreateFile(Path1);
        SHCNE_DELETE: DoDeleteFile(Path1);
        SHCNE_DRIVEADD: DoDriveAdd(Path1);
        SHCNE_DRIVEADDGUI: DoDriveAddGui(path1);
        SHCNE_DRIVEREMOVED: DoDriveRemove(Path1);
        SHCNE_MEDIAINSERTED: DoMediaInsert(Path1);
        SHCNE_MEDIAREMOVED: DoMediaRemove(Path1);
        SHCNE_MKDIR: DoDirCreate(Path1);
        SHCNE_NETSHARE: DoNetShare(Path1);
        SHCNE_NETUNSHARE: DoNetUnShare(Path1);
        SHCNE_RENAMEFOLDER: DoRenameFolder(Path1, Path2);
        SHCNE_RENAMEITEM: DoRenameItem(Path1, Path2);
        SHCNE_RMDIR: DoFolderRemove(Path1);
        SHCNE_SERVERDISCONNECT: DoServerDisconnect(Path);
        SHCNE_UPDATEDIR: DoDirUpdate(Path);
        SHCNE_UPDATEIMAGE: ;
        SHCNE_UPDATEITEM: ;
      end;
    end;
  end;
end;

end.


Author: maniac_n@hotmail.com
Source: Взято с http://delphiworld.narod.ru
ID: 02399