SS}}

Delphi.int.ru — Портал программистов

Вход Регистрация | Забыли пароль?

События

Сегодня:
Вопросы0    Ответы0    Мини-форумы0


Последние:
Вопрос02.04, 13:45 / #6688
Ответ29.03, 23:32 / #6682
Новости30 апреля 2012


Сейчас онлайн:
На сайте — 14
На IRC-канале — 1

Ссылки

Как можно из 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-код:

Ссылка для форумов (BBCode):

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

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


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

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

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