Как можно из Delphi отслеживать все события Windows?

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

Источник: Delphi X-Files

{$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;//Case event of
end;//SNM_SHELLNOTIFICATION
end; //case
end;
 
end.

Статья добавлена: 2 марта 2005

Следующая статья: Работа с реестром и INI-файлами в Delphi »

Рейтинг статьи: 3.00 Голосов: 12

Зарегистрируйтесь/авторизируйтесь,
чтобы оценивать статьи.

Для вставки ссылки на данную статью на другом сайте используйте следующий HTML-код:
<a href="https://www.delphi-int.ru/articles/6/">Как можно из Delphi отслеживать все события Windows?</a>

Ссылка для форумов (BBCode):
[url=https://www.delphi-int.ru/articles/6/]Как можно из Delphi отслеживать все события Windows?[/url]

Быстрая вставка ссылки на статью в сообщениях на сайте:
{{a:6}} (буква a — латинская) — только адрес статьи (URL);
{{статья:6}} — полноценная HTML-ссылка на статью (текст ссылки — название статьи).

Поделитесь ссылкой в социальных сетях:

Комментарии читателей к данной статье

Пока нет комментариев к данной статье. Оставьте свой и он будет первым.

Оставлять комментарии к статьям могут только зарегистрированные пользователи.