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);
