针对文件活动监视磁盘的最佳方法是什么。我的意思是获取完整的文件名（c:\temp\abc.txt）、操作（创建/删除/修改/重命名），以及导致文件的用户（user1）和进程名（notepad.exe）（多个删除）活动。
我听说过一些 API 和 ShellNotifications，但无法将它们用于上述全部需求。
此致。
问问题
11562 次
4 回答
14
很久以前，我最喜欢的博客之一回答了这个问题（带有完整源代码和演示应用程序）。在此处查看Delphi About.com 文章，其中有更深入的解释。Zarko Gajic 在http://delphi.about.com提供的代码
想要在系统上创建、重命名或删除文件时收到通知？需要知道确切的文件夹和文件名吗？让我们开始监控系统外壳的变化吧！
//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.guide@about.com
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
********************************************
}
于 2009-01-26T16:13:26.817 回答
6
有一个 Windows API 可以接收有关目录和可选子目录更改的通知，请参阅这个 SO question以了解封装 API 的 Delphi 组件。
但是，（AFAIK）没有现成的界面来获取您需要的所有信息。您当然可以查看目录，使用每个文件的所有可用信息填充文件列表，并将当前列表与之前的列表进行比较，以确定发生了什么变化以及是谁做的。但是，这不会扩展，并且无法获取所有信息 - 例如，您会看到文件已被删除，但我认为您无法从哪个用户帐户获取文件被删除的信息.
编辑：像Process Explorer和朋友这样的工具提供了比 Windows API 提供的更多关于系统中正在发生的事情的信息，但它们通常需要驱动程序才能访问此类信息，并且需要以管理员权限运行。
于 2009-01-26T13:32:37.453 回答
1
Stack Overflow 不允许我评论 Mick 的回答。我想让大家知道它只能在目标平台 windows 32bit 中编译。如果你尝试使用目标平台 windows 64 位编译它，它会抛出各种错误。
您可以在 Torry.net https://torry.net/pages.php?id=252的最底部页面上找到原始源代码。
原始版本给了我一些错误，这是次要的，但我修复了。
这是我编辑的适用于 Delphi 10.4.1 的版本（将此源代码放在 .pas 文件中并将其包含到新的包文件中。您将能够从那里编译和安装它。）：
//TSHChangeNotify
unit SHChangeNotify;
{$DEFINE Delphi3orHigher}
//*************************************************************
//*************************************************************
// 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, 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.
于 2020-11-25T17:58:49.587 回答
-1
我有一些适用于 Windows 的 Python 内容，如果您愿意，您可能有兴趣从中移植：http: //github.com/gorakhargosh/watchdog
于 2010-12-14T07:42:56.917 回答