ファイルアクティビティに対してディスクを監視するための最良の方法は何ですか。つまり、完全なファイル名（c：\ temp \ abc.txt）、アクション（作成/削除/変更/名前変更）、およびファイルの原因となっているユーザー（user1）とプロセス名（notepad.exe）を取得します（複数削除）アクティビティ。
一部のAPIとShellNotificationsについて聞いたが、上記のニーズ全体にそれらを使用することはできなかった。
よろしくお願いします。
質問する
11562 次
4 に答える
14
私のお気に入りのブログの 1 つが、かなり前にこの質問に (完全なソースとデモ アプリケーションと共に) 回答しました。詳細な説明がある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
ディレクトリおよびオプションでそのサブディレクトリの変更に関する通知を受信するWindowsAPIがあります。APIをカプセル化するDelphiコンポーネントについては、このSOの質問を参照してください。
ただし、（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
Python for Windows には、必要に応じて移植することに興味があるかもしれないものがあります: http://github.com/gorakhargosh/watchdog
于 2010-12-14T07:42:56.917 に答える