Monitoring System Shell Changes using Delphi

TSHChangeNotify

unit SHChangeNotify;

{$IFNDEF VER80} {$IFNDEF VER90} {$IFNDEF VER93}
  {$DEFINE Delphi3orHigher}
{$ENDIF} {$ENDIF} {$ENDIF}

//*************************************************************
//*************************************************************
// TSHChangeNotify component by Elliott Shevin  shevine@aol.com
// vers. 3.0, October 2000
//
//   See the README.TXT file for revision history.
//
//*
//*  I owe this component to James Holderness, who described the
//*  use of the undocumented Windows API calls it depends upon,
//*  and Brad Martinez, who coded a similar function in Visual
//*  Basic. I quote here from Brad's expression of gratitude to
//*  James:
//*     Interpretation of the shell's undocumented functions
//*     SHChangeNotifyRegister (ordinal 2) and SHChangeNotifyDeregister
//*     (ordinal 4) would not have been possible without the
//*     assistance of James Holderness. For a complete (and probably
//*     more accurate) overview of shell change notifcations,
//*     please refer to James'  "Shell Notifications" page at
//*     http://www.geocities.com/SiliconValley/4942/
//*
//*  This component will let you know when selected events
//*  occur in the Windows shell, such as files and folders
//*  being renamed, added, or deleted. (Moving an item yields
//*  the same results as renaming it.) For the complete list
//*  of events the component can trap, see Win32 Programmer's
//*  reference description of the SHChangeNotify API call.
//*
//*  Properties:
//*     MessageNo: the Windows message number which will be used to signal
//*                a trapped event. The default is WM_USER (1024); you may
//*                set it to some other value if you're using WM_USER for
//*                any other purpose.
//*     TextCase:  tcAsIs (default), tcLowercase, or tcUppercase, determines
//*                whether and how the Path parameters passed to your event
//*                handlers are case-converted.
//*     HardDriveOnly: when set to True, the component monitors only local
//*                hard drive partitions; when set to False, monitors the
//*                entire file system.
//*
//*  Methods:
//*     Execute:   Begin monitoring the selected shell events.
//*     Stop:      Stop monitoring.
//*
//*  Events:
//*     The component has an event corresponding to each event it can
//*     trap, e.g. OnCreate, OnMediaInsert, etc.
//*     Each event handler is passed either three or four parameters--
//*          Sender=this component.
//*          Flags=the value indentifying the event that triggered the handler,
//*             from the constants in the SHChangeNotify help. This parameter
//*             allows multiple events to share handlers and still distinguish
//*             the reason the handler was triggered.
//*          Path1, Path2: strings which are the paths affected by the shell
//*             event. Whether both are passed depends on whether the second
//*             is needed to describe the event. For example, OnDelete gives
//*             only the name of the file (including path) that was deleted;
//*             but OnRenameFolder gives the original folder name in Path1
//*             and the new name in Path2.
//*             In some cases, such as OnAssocChanged, neither Path parameter
//*             means anything, and in other cases, I guessed, but we always
//*             pass at least one.
//*     Each time an event property is changed, the component is reset to
//*     trap only those events for which handlers are assigned. So assigning
//*     an event handler suffices to indicate your intention to trap the
//*     corresponding shell event.
//*
//*     There is one more event: OnEndSessionQuery, which has the same
//*     parameters as the standard Delphi OnCloseQuery (and can in fact
//*     be your OnCloseQuery handler). This component must shut down its
//*     interception of shell events when system shutdown is begun, lest
//*     the system fail to shut down at the user's request.
//*
//*     Setting CanEndSession (same as CanClose) to FALSE in an
//*     OnEndSessionQuery will stop the process of shutting down
//*     Windows. You would only need this if you need to keep the user
//*     from ending his Windows session while your program is running.
//*
//*   I'd be honored to hear what you think of this component.
//*   You can write me at shevine@aol.com.
//*************************************************************
//*************************************************************

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  {$IFNDEF Delphi3orHigher}
     OLE2,
  {$ELSE}
     ActiveX, ComObj,
  {$ENDIF}

  ShlObj;

const
   SHCNF_ACCEPT_INTERRUPTS      = $0001;
   SHCNF_ACCEPT_NON_INTERRUPTS  = $0002;
   SHCNF_NO_PROXY               = $8000;

type NOTIFYREGISTER = record
    pidlPath      : PItemIDList;
    bWatchSubtree : boolean;
end;

type PNOTIFYREGISTER = ^NOTIFYREGISTER;

type TTextCase = (tcAsIs,tcUppercase,tcLowercase);

type
    TOneParmEvent = procedure(Sender : TObject; Flags : cardinal; Path1 : string) of object;
    TTwoParmEvent = procedure(Sender : TObject; Flags : cardinal; Path1, Path2 : string) of object;
    TEndSessionQueryEvent = procedure(Sender: TObject; var CanEndSession: Boolean) of object;

    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;


type
  TSHChangeNotify = class(TComponent)
  private
    fTextCase      : TTextCase;
    fHardDriveOnly : boolean;
    NotifyCount    : integer;
    NotifyHandle   : hwnd;
    NotifyArray    : array[1..26] of NOTIFYREGISTER;
    AllocInterface : IMalloc;
    PrevMsg        : integer;
    prevpath1      : string;
    prevpath2      : string;
    fMessageNo     : integer;
    fAssocChanged     : TTwoParmEvent;
    fAttributes       : TOneParmEvent;
    fCreate           : TOneParmEvent;
    fDelete           : TOneParmEvent;
    fDriveAdd         : TOneParmEvent;
    fDriveAddGUI      : TOneParmEvent;
    fDriveRemoved     : TOneParmEvent;
    fMediaInserted    : TOneParmEvent;
    fMediaRemoved     : TOneParmEvent;
    fMkDir            : TOneParmEvent;
    fNetShare         : TOneParmEvent;
    fNetUnshare       : TOneParmEvent;
    fRenameFolder     : TTwoParmEvent;
    fRenameItem       : TTwoParmEvent;
    fRmDir            : TOneParmEvent;
    fServerDisconnect : TOneParmEvent;
    fUpdateDir        : TOneParmEvent;
    fUpdateImage      : TOneParmEvent;
    fUpdateItem       : TOneParmEvent;
    fEndSessionQuery  : TEndSessionQueryEvent;

    OwnerWindowProc   : TWndMethod;

    procedure SetMessageNo(value : integer);
    procedure WndProc(var msg: TMessage);

  protected
    procedure QueryEndSession(var msg: TMessage);

  public
    constructor Create(AOwner : TComponent); override;
    destructor  Destroy; override;
    procedure   Execute;
    procedure   Stop;

  published
    property MessageNo : integer read fMessageNo write SetMessageNo default WM_USER;
    property TextCase : TTextCase read fTextCase write fTextCase  default tcAsIs;
    property HardDriveOnly : boolean  read fHardDriveOnly write fHardDriveOnly default True;

    property OnAssocChanged     : TTwoParmEvent read fAssocChanged write fAssocChanged;
    property OnAttributes : TOneParmEvent read fAttributes   write fAttributes;
    property OnCreate         : TOneParmEvent read fCreate       write fCreate;
    property OnDelete         : TOneParmEvent read fDelete       write fDelete;
    property OnDriveAdd         : TOneParmEvent read fDriveAdd     write fDriveAdd;
    property OnDriveAddGUI : TOneParmEvent read fDriveAddGUI  write fDriveAddGUI;
    property OnDriveRemoved : TOneParmEvent read fDriveRemoved write fDriveRemoved;
    property OnMediaInserted    : TOneParmEvent read fMediaInserted write fMediaInserted;
    property OnMediaRemoved : TOneParmEvent read fMediaRemoved write fMediaRemoved;
    property OnMkDir         : TOneParmEvent read fMkDir        write fMkDir;
    property OnNetShare         : TOneParmEvent read fNetShare     write fNetShare;
    property OnNetUnshare : TOneParmEvent read fNetUnshare   write fNetUnshare;
    property OnRenameFolder : TTwoParmEvent  read fRenameFolder write fRenameFolder;
    property OnRenameItem : TTwoParmEvent read fRenameItem   write fRenameItem;
    property OnRmDir         : TOneParmEvent read fRmDir        write fRmDir;
    property OnServerDisconnect : TOneParmEvent read fServerDisconnect write fServerDisconnect;
    property OnUpdateDir        : TOneParmEvent read fUpdateDir    write fUpdateDir;
    property OnUpdateImage : TOneParmEvent read fUpdateImage  write fUpdateImage;
    property OnUpdateItem       : TOneParmEvent read fUpdateItem   write fUpdateItem;
    property OnEndSessionQuery  : TEndSessionQueryEvent
                                         read fEndSessionQuery write fEndSessionQuery;
    { Published declarations }
  end;

procedure Register;

implementation

const Shell32DLL = 'shell32.dll';

function SHChangeNotifyRegister;
              external Shell32DLL index 2;
function SHChangeNotifyDeregister;
              external Shell32DLL index 4;
function SHILCreateFromPath;
              external Shell32DLL index 28;

procedure Register;
begin
  RegisterComponents('Custom', [TSHChangeNotify]);
end;

// Set defaults, and ensure NotifyHandle is zero.
constructor TSHChangeNotify.Create (AOwner : TComponent);
begin
   inherited Create(AOwner);
   fTextCase      := tcAsIs;
   fHardDriveOnly := true;

   fAssocChanged     := nil;
   fAttributes       := nil;
   fCreate           := nil;
   fDelete           := nil;
   fDriveAdd         := nil;
   fDriveAddGUI      := nil;
   fDriveRemoved     := nil;
   fMediaInserted    := nil;
   fMediaRemoved     := nil;
   fMkDir            := nil;
   fNetShare         := nil;
   fNetUnshare       := nil;
   fRenameFolder     := nil;
   fRenameItem       := nil;
   fRmDir            := nil;
   fServerDisconnect := nil;
   fUpdateDir        := nil;
   fUpdateImage      := nil;
   fUpdateItem       := nil;
   fEndSessionQuery  := nil;

   MessageNo    := WM_USER;

   // If designing, dodge the code that implements messag interception.
   if csDesigning in ComponentState
      then exit;

   // Substitute our window proc for our owner's window proc.
   OwnerWindowProc := (Owner as TWinControl).WindowProc;
   (Owner as TWinControl).WindowProc := WndProc;

   // Get the IMAlloc interface so we can free PIDLs.
   SHGetMalloc(AllocInterface);
end;

procedure TSHChangeNotify.SetMessageNo(value : integer);
begin
   if (value >= WM_USER)
     then fMessageNo := value
     else raise Exception.Create
                    ('MessageNo must be greater than or equal to '
                    + inttostr(WM_USER));
end;

// Execute unregisters any current notification and registers a new one.
procedure TSHChangeNotify.Execute;
var
   EventMask      : integer;
   driveletter    : string;
   i              : integer;
   pidl           : PItemIDList;
   Attributes     : ULONG;
   NotifyPtr      : PNOTIFYREGISTER;
begin
   NotifyCount := 0;

   if csDesigning in ComponentState
      then exit;

   Stop;  // Unregister the current notification, if any.

   EventMask := 0;
   if assigned(fAssocChanged     ) then EventMask := (EventMask or SHCNE_ASSOCCHANGED);
   if assigned(fAttributes       ) then EventMask := (EventMask or SHCNE_ATTRIBUTES);
   if assigned(fCreate           ) then EventMask := (EventMask or SHCNE_CREATE);
   if assigned(fDelete           ) then EventMask := (EventMask or SHCNE_DELETE);
   if assigned(fDriveAdd         ) then EventMask := (EventMask or SHCNE_DRIVEADD);
   if assigned(fDriveAddGUI      ) then EventMask := (EventMask or SHCNE_DRIVEADDGUI);
   if assigned(fDriveRemoved     ) then EventMask := (EventMask or SHCNE_DRIVEREMOVED);
   if assigned(fMediaInserted    ) then EventMask := (EventMask or SHCNE_MEDIAINSERTED);
   if assigned(fMediaRemoved     ) then EventMask := (EventMask or SHCNE_MEDIAREMOVED);
   if assigned(fMkDir            ) then EventMask := (EventMask or SHCNE_MKDIR);
   if assigned(fNetShare         ) then EventMask := (EventMask or SHCNE_NETSHARE);
   if assigned(fNetUnshare       ) then EventMask := (EventMask or SHCNE_NETUNSHARE);
   if assigned(fRenameFolder     ) then EventMask := (EventMask or SHCNE_RENAMEFOLDER);
   if assigned(fRenameItem       ) then EventMask := (EventMask or SHCNE_RENAMEITEM);
   if assigned(fRmDir            ) then EventMask := (EventMask or SHCNE_RMDIR);
   if assigned(fServerDisconnect ) then EventMask := (EventMask or SHCNE_SERVERDISCONNECT);
   if assigned(fUpdateDir        ) then EventMask := (EventMask or SHCNE_UPDATEDIR);
   if assigned(fUpdateImage      ) then EventMask := (EventMask or SHCNE_UPDATEIMAGE);
   if assigned(fUpdateItem       ) then EventMask := (EventMask or SHCNE_UPDATEITEM);

   if EventMask = 0   // If there's no event mask
      then exit;      // then there's no need to set an event.

   // If the user requests watches on hard drives only, cycle through
   // the list of drive letters and add a NotifyList element for each.
   // Otherwise, just set the first element to watch the entire file
   // system.
   if fHardDriveOnly
     then for i := ord('A') to ord('Z') do begin
            DriveLetter := char(i) + ':\';
            if GetDriveType(pchar(DriveLetter)) = DRIVE_FIXED
               then begin
                      inc(NotifyCount);
                      with NotifyArray[NotifyCount] do begin
                          SHILCreateFromPath
                                     (pchar(DriveLetter),
                                      addr(pidl),
                                      Attributes);
                          pidlPath := pidl;
                          bWatchSubtree := true;
                      end;
            end;
     end

     // If the caller requests the entire file system be watched,
     // prepare the first NotifyElement accordingly.
     else begin
          NotifyCount := 1;
          with NotifyArray[1] do begin
              pidlPath      := nil;
              bWatchSubtree := true;
          end;
     end;

     NotifyPtr    :=  addr(NotifyArray);

     NotifyHandle :=  SHChangeNotifyRegister(
                               (Owner as TWinControl).Handle,
                                SHCNF_ACCEPT_INTERRUPTS       +
                                    SHCNF_ACCEPT_NON_INTERRUPTS,
                                EventMask,
                                fMessageNo,
                                NotifyCount,
                                NotifyPtr);

   if NotifyHandle = 0
      then begin
             Stop;
             raise Exception.Create('Could not register SHChangeNotify');
   end;
end;

// This procedure unregisters the Change Notification
procedure TSHChangeNotify.Stop;
var
   NotifyHandle   : hwnd;
   i              : integer;
   pidl           : PITEMIDLIST;
begin
   if csDesigning in ComponentState
      then exit;

   // Deregister the shell notification.
   if NotifyCount > 0
      then SHChangeNotifyDeregister(NotifyHandle);

   // Free the PIDLs in NotifyArray.
   for i := 1 to NotifyCount do begin
      pidl := NotifyArray[i].PidlPath;
      if AllocInterface.DidAlloc(pidl) = 1
                         then AllocInterface.Free(pidl);
   end;

   NotifyCount := 0;
end;

// This is the procedure that is called when a change notification occurs.
// It interprets the two PIDLs passed to it, and calls the appropriate
// event handler, according to what kind of event occurred.
procedure TSHChangeNotify.WndProc(var msg: TMessage);
type
   TPIDLLIST = record
      pidlist : array[1..2] of PITEMIDLIST;
   end;
   PIDARRAY = ^TPIDLLIST;
var
   Path1    : string;
   Path2    : string;
   ptr      : PIDARRAY;
   p1,p2    : PITEMIDLIST;
   repeated : boolean;
   p        : integer;
   event    : longint;
   parmcount      : byte;
   OneParmEvent   : TOneParmEvent;
   TwoParmEvent   : TTwoParmEvent;

   // The internal function ParsePidl returns the string corresponding
   // to a PIDL.
   function ParsePidl (Pidl : PITEMIDLIST) : string;
   begin
      SetLength(result,MAX_PATH);
      if not SHGetPathFromIDList(Pidl,pchar(result))
          then result := '';
   end;

// The actual message handler starts here.
begin
  if Msg.Msg = WM_QUERYENDSESSION
     then QueryEndSession(Msg);

  if Msg.Msg = fMessageNo
     then begin
        OneParmEvent := nil;
        TwoParmEvent := nil;

        event := msg.LParam and ($7FFFFFFF);

        case event of
           SHCNE_ASSOCCHANGED     : TwoParmEvent := fAssocChanged;
           SHCNE_ATTRIBUTES       : OneParmEvent := fAttributes;
           SHCNE_CREATE           : OneParmEvent := fCreate;
           SHCNE_DELETE           : OneParmEvent := fDelete;
           SHCNE_DRIVEADD         : OneParmEvent := fDriveAdd;
           SHCNE_DRIVEADDGUI      : OneParmEvent := fDriveAddGUI;
           SHCNE_DRIVEREMOVED     : OneParmEvent := fDriveRemoved;
           SHCNE_MEDIAINSERTED    : OneParmEvent := fMediaInserted;
           SHCNE_MEDIAREMOVED     : OneParmEvent := fMediaRemoved;
           SHCNE_MKDIR            : OneParmEvent := fMkDir;
           SHCNE_NETSHARE         : OneParmEvent := fNetShare;
           SHCNE_NETUNSHARE       : OneParmEvent := fNetUnshare;
           SHCNE_RENAMEFOLDER     : TwoParmEvent := fRenameFolder;
           SHCNE_RENAMEITEM       : TwoParmEvent := fRenameItem;
           SHCNE_RMDIR            : OneParmEvent := fRmDir;
           SHCNE_SERVERDISCONNECT : OneParmEvent := fServerDisconnect;
           SHCNE_UPDATEDIR        : OneParmEvent := fUpdateDir;
           SHCNE_UPDATEIMAGE      : OneParmEvent := fUpdateImage;
           SHCNE_UPDATEITEM       : OneParmEvent := fUpdateItem;
           else begin
                   OneParmEvent := nil; // Unknown event;
                   TwoParmEvent := nil;
                end;
        end;
        if (assigned(OneParmEvent)) or (assigned(TwoParmEvent))
          then begin

                // Assign a pointer to the array of PIDLs sent
                // with the message.
                ptr := PIDARRAY(msg.wParam);

                // Parse the two PIDLs.
                p1 := ptr^.pidlist[1];
                try
                   SetLength(Path1,MAX_PATH);
                   Path1 := ParsePidl(p1);
                   p := pos(#00,Path1);
                   if p > 0
                      then SetLength(Path1,p - 1);
                except
                   Path1 := '';
                end;

                p2 := ptr^.pidlist[2];
                try
                   SetLength(Path2,MAX_PATH);
                   Path2 := ParsePidl(p2);
                   p := pos(#00,Path2);
                   if p > 0
                      then SetLength(Path2,p - 1);
                except
                   Path2 := '';
                end;

                // If this message is the same as the last one (which happens
                // a lot), bail out.
                try
                   repeated := (PrevMsg = event)
                                and (uppercase(prevpath1) = uppercase(Path1))
                                and (uppercase(prevpath2) = uppercase(Path2))
                except
                   repeated := false;
                end;

                // Save the elements of this message for comparison next time.
                PrevMsg    := event;
                PrevPath1  := Path1;
                PrevPath2  := Path2;

                // Convert the case of Path1 and Path2 if desired.
                case fTextCase of
                        tcUppercase : begin
                           Path1 := uppercase(Path1);
                           Path2 := uppercase(Path2);
                        end;
                        tcLowercase : begin
                           Path1 := lowercase(Path1);
                           Path2 := lowercase(Path2);
                        end;
                end;

                // Call the event handler according to the number
                // of paths we will pass to it.
                if not repeated then begin
                   case event of
                        SHCNE_ASSOCCHANGED,
                        SHCNE_RENAMEFOLDER,
                        SHCNE_RENAMEITEM   : parmcount := 2;
                   else parmcount := 1;
                   end;

                   if parmcount = 1
                      then OneParmEvent(self, event, Path1)
                      else TwoParmEvent(self, event, Path1, Path2);
                end;

        end;  // if assigned(OneParmEvent)...

  end;        // if Msg.Msg = fMessageNo...

  // Call the original message handler.
  OwnerWindowProc(Msg);
end;

procedure TSHChangeNotify.QueryEndSession(var msg: TMessage);
var
   CanEndSession : boolean;
begin
   CanEndSession := true;
   if Assigned(fEndSessionQuery)
      then fEndSessionQuery(Self, CanEndSession);
   if CanEndSession
      then begin
             Stop;
             Msg.Result := 1;
      end
      else Msg.Result := 0;
end;

destructor TSHChangeNotify.Destroy;
begin
   if not (csDesigning in ComponentState)
      then begin
             if Assigned(Owner)
               then (Owner as TWinControl).WindowProc := OwnerWindowProc;
             Stop;
   end;

   inherited;
end;

end.


{
********************************************
Zarko Gajic
About.com Guide to Delphi Programming
http://delphi.about.com
email: delphi@aboutguide.com
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
********************************************
}