Delphi Monitoring Folder

(****************************************** file and directory monitoring when there is a file or directory operation on the disk, an event usage method is generated: Start monitoring: Pathwatch (Self.handle, ' \ C  Ftpfolder ');  Release monitoring: Pathwatch (-1);  Add messages to the form to listen for private {private declarations} procedure Msglistern (var msg:tmessage); message wm_shnotify;  Implementation: Procedure Tform1.msglistern (Var msg:tmessage);      Begin Pathwatch (Msg,procedure (a,s1,s2:string) Begin Log (' File event is: ' +a ');      Log (' File name is: ' +s1 ');    Log (' Additional parameters are: ' +s2 ');  End); end;******************************************) Unit pathwatch;interfaceuses 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;implementationfunction Pathwatch (Hwnd:integer;  Path:string= "): Boolean;var ps:pidlstruct;begin result:=false;  Path:=path.replace ('/', ' \ ');    if (hwnd>=0) THEN BEGIN//Start monitoring 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//de-Monitor 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 (HWND), Path); Firemonkey forms do not accept processing Windows messages 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: = ' rename '; SHCNE_CREATE:A: = ' Create file ';//shcne_delete:a: = ' delete file ';//shcne_mkdir:a: = ' new directory ';//SHCNE_RMD     IR:A: = ' delete directory ';//shcne_attributes:a: = ' change attribute ';//shcne_mediainserted:a: = ' Insert Media '        ;//SHCNE_MEDIAREMOVED:A: = ' Remove media ';//shcne_driveremoved:a: = ' Remove drive ';//Shcne_driveadd : A: = ' add drive ';//shcne_netshare:a: = ' change sharing ';//shcne_updatedir:a: = ' update directory ';//S HCNE_UPDATEITEM:A: = ' update file ';//shcne_serverdisconnect:a: = ' disconnected ';//SHCNE_UPDATEIMAGE:A: = ' Update icon ';//shcne_driveaddgui:a: = ' Add drive ';//shcne_renamefolder:a: = ' Rename folder ';//Shcne_freespa  CE:A: = ' disk space change ';//shcne_assocchanged:a: = ' Change file association ',//else A: = ' other operation ';  End  Result: = True; if ((A<> ') and (Assigned (callback)) and (S1. Toupper.startswith (G_watchpath)) and (not S1. Contains (' _plate ')) then beingGin callback (A,s1,g_watchpath); End;end;end.

Call:

Pathwatch (self. Handle, DM. config.o[' Local ']. s[' Photopath ');

A message Event trigger is required in the form:

Procedure Msglistern (var msg:tmessage);     Message wm_shnotify; Triggering listener Events

Procedure Tformmain.msglistern (var msg:tmessage); Begin  Pathwatch (MSG, procedure (act,fn,s2:string) BEGIN    If (act= ' Create file ') THEN begin      If Secondsbetween (now (), Preposttime) >= 5 then    //Two time difference between seconds      begin       // Here to deal with monitoring to   respond to things      end;    End;  end); end;

Delphi Monitoring Folder