Получение уведомлений от оболочки (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.
Взято с https://delphiworld.narod.ru