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

=== Получение уведомлений от оболочки (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