Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

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

01.01.2007

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

{$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