Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

File / Folder monitoring

What is the best way to monitor disks against file activities. I mean that getting the full file name (c:\temp\abc.txt), action(created/deleted/modified/renamed), and also the user (user1) and process name (notepad.exe) causing the file (multiple delete) activities.

I heard about Some APIs and ShellNotifications but could not use them for the whole needs above.

Best regards.

like image 848
user59003 Avatar asked Jan 26 '09 13:01

user59003


People also ask

How do I monitor files in a folder?

Details Tab You can use the ellipsis (...) button to browse for the folder. Select this option to monitor the files and folders in sub-folders in the Folder that you specified.

What is file activity monitoring?

File Activity Monitoring discovers the sensitive data on your servers; classifies content using pre-defined or user defined definitions; configures rules and policies about data access, and actions to be taken when rules are met.

How can I see folder activity?

Open “Windows Explorer”, and navigate to the folder that you want to track. Right-click the folder and select “Properties” from the context menu. The folder's properties window appears on the screen. Note: If you want to track multiple folders, you will have to configure audit for every folder individually.


2 Answers

One of my favorite blogs answered this question (with full source and a demo application) quite a while ago. Checkout the Delphi About.com article here which has a more in depth explanation. Code provided by Zarko Gajic at http://delphi.about.com

Wanna get notified when a file gets created, renamed or deleted on the system? Need to know the exact folder and file name? Let's start monitoring system shell changes!

//TSHChangeNotify

unit SHChangeNotify;

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

//*************************************************************
//*************************************************************
// TSHChangeNotify component by Elliott Shevin  [email protected]
// 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 [email protected].
//*************************************************************
//*************************************************************

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: [email protected]
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
********************************************
}
like image 174
Mick Avatar answered Oct 22 '22 10:10

Mick


Stack Overflow won't let me comment on Mick's answer. I would like everyone to know that it only compiles in target platform windows 32bit. If you try to compile it using target platform windows 64 bit, it will throw all kinds of errors.

You can find the original source code on Torry.net https://torry.net/pages.php?id=252 on the very bottom page.

The original version gave me some errors, for which was minor, but I fixed.

Here's my edited version that works for Delphi 10.4.1 (put this source code in a .pas file and include it into a new package file. You'll be able to compile and install it from there.):

//TSHChangeNotify

unit SHChangeNotify;

{$DEFINE Delphi3orHigher}

//*************************************************************
//*************************************************************
// TSHChangeNotify component by Elliott Shevin  [email protected]
// 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 [email protected].
//*************************************************************
//*************************************************************

interface

uses
  Windows, Messages, SysUtils, Classes, Vcl.Graphics, Vcl.Menus, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls,
  Vcl.ImgList, Vcl.StdActns, Vcl.Clipbrd, Vcl.ToolWin, Vcl.Printers, Vcl.ListActns, Vcl.GraphUtil, Vcl.Consts,
  ActiveX, ComObj, 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;

   NotifyHandle := 0;

   // 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.
like image 38
Greg T Avatar answered Oct 22 '22 10:10

Greg T