Menu
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.
848
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.
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.
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.
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/
********************************************
}
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.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With
