资料地址:
1.https://www.cnblogs.com/studypanp/p/4890970.html
单元代码:
![](https://i-blog.csdnimg.cn/blog_migrate/8f900a89c6347c561fdf2122f13be562.gif)
![](https://i-blog.csdnimg.cn/blog_migrate/961ddebeb323a10fe0623af514929fc1.gif)
1 (****************************************** 2 文件和目录监控 3 当磁盘上有文件或目录操作时,产生事件 4 使用方法: 5 6 开始监控: PathWatch(Self.Handle, 'C:\FtpFolder'); 7 解除监控:PathWatch(-1); 8 9 在窗体中加消息监听 10 private 11 { Private declarations } 12 procedure MsgListern(var Msg:TMessage);message WM_SHNOTIFY; 13 14 实现: 15 procedure TForm1.MsgListern(var Msg:TMessage); 16 begin 17 PathWatch(Msg,procedure(a,s1,s2:String) begin 18 Log('文件事件是:' +a); 19 Log('文件名称是:' +s1); 20 Log('另外的参数是:'+s2); 21 end); 22 end; 23 原始资料:https://www.cnblogs.com/studypanp/p/4890970.html 24 环境情况:win7 64 + DelphiXE10.2 25 更新情况:修改20190315 增加多目录处理 26 ******************************************) 27 unit ZJQPathWatch; 28 29 interface 30 31 uses 32 Winapi.Messages, System.SysUtils, FMX.Types, FMX.Platform.Win, WinAPI.ShlObj, 33 Winapi.ActiveX, WinApi.Windows, VCL.Dialogs, 34 System.Classes;//TStringList 35 36 const 37 WM_SHNOTIFY = $401; 38 39 type 40 PIDLSTRUCT = ^IDLSTRUCT; 41 _IDLSTRUCT = record 42 pidl : PItemIDList; 43 bWatchSubFolders : Integer; 44 end; 45 IDLSTRUCT =_IDLSTRUCT; 46 47 type 48 PSHNOTIFYSTRUCT=^SHNOTIFYSTRUCT; 49 SHNOTIFYSTRUCT = record 50 dwItem1 : PItemIDList; 51 dwItem2 : PItemIDList; 52 end; 53 54 Function SHChangeNotifyDeregister(hNotify:integer):integer;stdcall; external 'Shell32.dll' index 4; 55 Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;lpps:PIDLSTRUCT):integer;stdcall; external 'Shell32.dll' index 2; 56 57 function PathWatch(hWND: Integer; Path:String = ''):Boolean; overload; 58 function PathWatch(hWND: TWindowHandle; Path:String = ''):Boolean; overload; 59 function PathWatch(var Msg: TMessage; callback: TProc<String, String, String>): Boolean; overload; 60 61 var 62 g_HSHNotify: Integer; 63 g_pidlDesktop: PItemIDList; 64 g_WatchPath: String; 65 g_WatchPathList: TStringList; 66 67 implementation 68 69 function GetPathIsExist(AWatchPathList: TStringList; APath: string): Boolean; 70 var 71 I: Integer; 72 begin 73 Result := False; 74 for I := 0 to AWatchPathList.Count -1 do 75 begin 76 if APath.ToUpper.StartsWith(AWatchPathList[I]) then 77 begin 78 Result := True; 79 Break; 80 end; 81 end; 82 end; 83 84 function PathWatch(hWND: Integer; Path: String = ''): Boolean; 85 var 86 ps:PIDLSTRUCT; 87 begin 88 result := False; 89 Path := Path.Replace('/','\'); 90 if(hWnd >= 0) then begin // 开始监控 91 // g_WatchPath := Path.ToUpper; 92 g_WatchPathList.Add(Path.ToUpper); 93 94 if g_HSHNotify = 0 then begin 95 SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, g_pidlDesktop); 96 if Boolean(g_pidlDesktop) then 97 begin 98 getmem(ps, sizeof(IDLSTRUCT)); 99 ps.bWatchSubFolders := 1; 100 ps.pidl := g_pidlDesktop; 101 g_HSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE Or SHCNF_IDLIST),(SHCNE_ALLEVENTS Or SHCNE_INTERRUPT),WM_SHNOTIFY, 1, ps); 102 Result := Boolean(g_HSHNotify); 103 end 104 else 105 CoTaskMemFree(g_pidlDesktop); 106 end; 107 end 108 else 109 begin // 解除监控 110 if boolean(g_HSHNotify) then if Boolean(SHChangeNotifyDeregister(g_HSHNotify)) then begin 111 g_HSHNotify := 1; 112 CoTaskMemFree(g_pidlDesktop); 113 result := True; 114 end; 115 end; 116 end; 117 118 function PathWatch(hWND: TWindowHandle; Path:String=''):Boolean; 119 begin 120 PathWatch(FmxHandleToHWND(hWND),Path); // FireMonkey的窗体不接受处理Windows消息 121 end; 122 123 function PathWatch(var Msg: TMessage; callback:TProc<String, String, String>): Boolean; 124 var 125 a, s1, s2: String; 126 buf: array[0..MAX_PATH] of char; 127 pidlItem: PSHNOTIFYSTRUCT; 128 begin 129 pidlItem := PSHNOTIFYSTRUCT(Msg.WParam); 130 SHGetPathFromIDList(pidlItem.dwItem1, buf); s1 := buf; 131 SHGetPathFromIDList(pidlItem.dwItem2, buf); s2 := buf; 132 a:=''; 133 case Msg.LParam of 134 // SHCNE_RENAMEITEM : a := '重命名' ; 135 SHCNE_CREATE : a := '建立文件' ; 136 // SHCNE_DELETE : a := '删除文件' ; 137 SHCNE_MKDIR : a := '新建目录' ; 138 // SHCNE_RMDIR : a := '删除目录' ; 139 // SHCNE_ATTRIBUTES : a := '改变属性' ; 140 // SHCNE_MEDIAINSERTED : a := '插入介质' ; 141 // SHCNE_MEDIAREMOVED : a := '移去介质' ; 142 // SHCNE_DRIVEREMOVED : a := '移去驱动器' ; 143 // SHCNE_DRIVEADD : a := '添加驱动器' ; 144 // SHCNE_NETSHARE : a := '改变共享' ; 145 // SHCNE_UPDATEDIR : a := '更新目录' ; 146 // SHCNE_UPDATEITEM : a := '更新文件' ; 147 // SHCNE_SERVERDISCONNECT: a := '断开连接' ; 148 // SHCNE_UPDATEIMAGE : a := '更新图标' ; 149 // SHCNE_DRIVEADDGUI : a := '添加驱动器' ; 150 // SHCNE_RENAMEFOLDER : a := '重命名文件夹' ; 151 // SHCNE_FREESPACE : a := '磁盘空间改变' ; 152 // SHCNE_ASSOCCHANGED : a := '改变文件关联' ; 153 // else a := '其他操作' ; 154 155 end; 156 result := True; 157 158 if( (a<>'') and (Assigned(callback)) and (GetPathIsExist(g_WatchPathList, s1))) and (not s1.Contains('_plate')) then 159 begin 160 callback(a,s1,g_WatchPath); 161 end; 162 end; 163 164 initialization 165 g_WatchPathList := TStringList.Create; 166 finalization 167 FreeAndNil(g_WatchPathList); 168 169 end.
调用代码:
![](https://i-blog.csdnimg.cn/blog_migrate/8f900a89c6347c561fdf2122f13be562.gif)
![](https://i-blog.csdnimg.cn/blog_migrate/961ddebeb323a10fe0623af514929fc1.gif)
1 unit Unit1; 2 3 interface 4 5 uses 6 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, 8 ZJQPathWatch,//引入 9 System.DateUtils;//引入 10 11 type 12 TForm1 = class(TForm) 13 Button1: TButton; 14 Button2: TButton; 15 Edit1: TEdit; 16 procedure Button1Click(Sender: TObject); 17 procedure FormCreate(Sender: TObject); 18 procedure Button2Click(Sender: TObject); 19 private 20 procedure MsgListern(var Msg: TMessage); message WM_SHNOTIFY;// 触发监听事件 21 { Private declarations } 22 public 23 { Public declarations } 24 end; 25 26 var 27 Form1: TForm1; 28 PrePostTime: TDateTime; //定义原始时间 29 implementation 30 31 {$R *.dfm} 32 33 { TForm1 } 34 35 procedure TForm1.Button1Click(Sender: TObject); 36 begin 37 PathWatch(self.Handle, 'e:\ABC'); 38 PathWatch(self.Handle, 'E:\abd'); 39 40 // PathWatch(self.Handle, '\\gccp-builder8\builder_release'); 41 end; 42 43 procedure TForm1.Button2Click(Sender: TObject); 44 begin 45 PathWatch(-1); 46 end; 47 48 procedure TForm1.FormCreate(Sender: TObject); 49 begin 50 PrePostTime := Now; 51 end; 52 53 procedure TForm1.MsgListern(var Msg: TMessage); 54 var 55 I: Integer; 56 begin 57 PathWatch(Msg, Procedure(act, fn, s2: string) begin 58 if(act='建立文件') then 59 begin 60 if SecondsBetween(Now, PrePostTime) >= 5 then //两个时间之间相差的秒数 61 begin 62 // 这里处理监控到后 要响应的事情 63 I := I + 1; 64 end; 65 end; 66 if(act='新建目录') then 67 begin 68 if SecondsBetween(Now, PrePostTime) >= 5 then //两个时间之间相差的秒数 69 begin 70 // 这里处理监控到后 要响应的事情 71 I := I + 1; 72 end; 73 end; 74 end); 75 end; 76 77 end.