本文整理自网络，侵删。
(******************************************
文件和目录监控
当磁盘上有文件或目录操作时，产生事件
使用方法：
开始监控: PathWatch(Self.Handle, 'C:\FtpFolder');
解除监控：PathWatch(-1);
在窗体中加消息监听
private
{ Private declarations }
procedure MsgListern(var Msg:TMessage);message WM_SHNOTIFY;
实现：
procedure TForm1.MsgListern(var Msg:TMessage);
begin
PathWatch(Msg,procedure(a,s1,s2:String) begin
Log('文件事件是：' +a);
Log('文件名称是：' +s1);
Log('另外的参数是：'+s2);
end);
end;
******************************************)
unit PathWatch;
interface
uses
Winapi.Messages, System.SysUtils, FMX.Types, FMX.Platform.Win, WinAPI.ShlObj,
Winapi.ActiveX, WinApi.Windows, VCL.Dialogs
;
const
WM_SHNOTIFY = $401;
type
PIDLSTRUCT = ^IDLSTRUCT;
_IDLSTRUCT = record
pidl : PItemIDList;
bWatchSubFolders : Integer;
end;
IDLSTRUCT =_IDLSTRUCT;
type
PSHNOTIFYSTRUCT=^SHNOTIFYSTRUCT;
SHNOTIFYSTRUCT = record
dwItem1 : PItemIDList;
dwItem2 : PItemIDList;
end;
Function SHChangeNotifyDeregister(hNotify:integer):integer;stdcall;
external 'Shell32.dll' index 4;
Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;lpps:PIDLSTRUCT):integer;stdcall;
external 'Shell32.dll' index 2;
function PathWatch(hWND: Integer ; Path:String=''):Boolean; overload;
function PathWatch(hWND: TWindowHandle; Path:String=''):Boolean; overload;
function PathWatch(var Msg: TMessage; callback: TProc<String,String,String>):Boolean; overload;
var
g_HSHNotify : Integer;
g_pidlDesktop : PItemIDList;
g_WatchPath : String;
implementation
function PathWatch(hWND: Integer; Path:String=''):Boolean;
var
ps:PIDLSTRUCT;
begin
result:=False;
Path:=Path.Replace('/','\');
if(hWnd>=0) then begin // 开始监控
g_WatchPath:=Path.ToUpper;
if g_HSHNotify = 0 then begin
SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, g_pidlDesktop);
if Boolean(g_pidlDesktop) then begin
getmem(ps,sizeof(IDLSTRUCT));
ps.bWatchSubFolders := 1;
ps.pidl := g_pidlDesktop;
g_HSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE Or SHCNF_IDLIST),(SHCNE_ALLEVENTS Or SHCNE_INTERRUPT),WM_SHNOTIFY, 1, ps);
Result := Boolean(g_HSHNotify);
end else CoTaskMemFree(g_pidlDesktop);
end;
end else begin // 解除监控
if boolean(g_HSHNotify) then if Boolean(SHChangeNotifyDeregister(g_HSHNotify)) then begin
g_HSHNotify := 1;
CoTaskMemFree(g_pidlDesktop);
result := True;
end;
end;
end;
function PathWatch(hWND: TWindowHandle; Path:String=''):Boolean;
begin
PathWatch(FmxHandleToHWND(hWND),Path); // FireMonkey的窗体不接受处理Windows消息
end;
function PathWatch(var Msg: TMessage; callback:TProc<String,String,String>):Boolean;
var
a, s1,s2 : String;
buf : array[0..MAX_PATH] of char;
pidlItem : PSHNOTIFYSTRUCT;
begin
pidlItem :=PSHNOTIFYSTRUCT(Msg.WParam);
SHGetPathFromIDList(pidlItem.dwItem1, buf); s1 := buf;
SHGetPathFromIDList(pidlItem.dwItem2, buf); s2 := buf;
a:='';
case Msg.LParam of
// SHCNE_RENAMEITEM : a := '重命名' ;
SHCNE_CREATE : a := '建立文件' ;
// SHCNE_DELETE : a := '删除文件' ;
// SHCNE_MKDIR : a := '新建目录' ;
// SHCNE_RMDIR : a := '删除目录' ;
// SHCNE_ATTRIBUTES : a := '改变属性' ;
// SHCNE_MEDIAINSERTED : a := '插入介质' ;
// SHCNE_MEDIAREMOVED : a := '移去介质' ;
// SHCNE_DRIVEREMOVED : a := '移去驱动器' ;
// SHCNE_DRIVEADD : a := '添加驱动器' ;
// SHCNE_NETSHARE : a := '改变共享' ;
// SHCNE_UPDATEDIR : a := '更新目录' ;
// SHCNE_UPDATEITEM : a := '更新文件' ;
// SHCNE_SERVERDISCONNECT: a := '断开连接' ;
// SHCNE_UPDATEIMAGE : a := '更新图标' ;
// SHCNE_DRIVEADDGUI : a := '添加驱动器' ;
// SHCNE_RENAMEFOLDER : a := '重命名文件夹' ;
// SHCNE_FREESPACE : a := '磁盘空间改变' ;
// SHCNE_ASSOCCHANGED : a := '改变文件关联' ;
// else a := '其他操作' ;
end;
result := True;
if( (a<>'') and (Assigned(callback)) and (s1.ToUpper.StartsWith(g_WatchPath))) and (not s1.Contains('_plate')) then
begin
callback(a,s1,g_WatchPath);
end;
end;
end.
调用：
PathWatch(self.Handle, DM.Config.O['Local'].S['PhotoPath']);
窗体中需要消息事件触发：
procedure MsgListern(var Msg: TMessage); message WM_SHNOTIFY; // 触发监听事件
procedure TFormMain.MsgListern(var Msg: TMessage);
begin
PathWatch(Msg, Procedure(act,fn,s2: string) begin
if(act='建立文件') then begin
if SecondsBetween(now(), PrePostTime) >= 5 then //两个时间之间相差的秒数
begin
// 这里处理监控到后 要响应的事情
end;
end;
end);
end;
相关阅读 >>
Delphi xe 跨平台（windows、android安卓、苹果macos、苹果ios）写法
Delphi 详解 enumwindows 与 enumwindowsproc
Delphi enumwindows回调函数获取qq2009窗体句柄
更多相关阅读请进入《Delphi》频道 >>
