delphi监控文件夹

(******************************************

  文件和目录监控

  当磁盘上有文件或目录操作时，产生事件

  使用方法：

  开始监控: 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;