Получение уведомлений от оболочки (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;
 
function SHChangeNotifyRegister( hWnd: HWND; dwFlags: integer;
wEventMask : cardinal; uMsg: UINT; cItems : integer;
lpItems : PNOTIFYREGISTER) : HWND; stdcall;
 
function SHChangeNotifyDeregister(hWnd: HWND) : boolean; stdcall;
 
function SHILCreateFromPath(Path: Pointer; PIDL: PItemIDList;
var Attributes: ULONG):HResult; stdcall;
 
implementation
 
const Shell32DLL = 'shell32.dll';
 
function SHChangeNotifyRegister; external Shell32DLL index 2;
function SHChangeNotifyDeregister; external Shell32DLL index 4;
function SHILCreateFromPath; 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.

Автор: maniac_n@hotmail.com

Взято с https://delphiworld.narod.ru