delphi 文件夹操作（监控）

delphi 监控文件系统

delphi 监控文件系统你是否想为你的Windows加上一双眼睛，察看使用者在机器上所做的各种操作（例如建立、删除文件；改变文件或目录名字）呢？

这里介绍一种利用Windows未公开函数实现这个功能的方法。

在Windows下有一个未公开函数SHChangeNotifyRegister可以把你的窗口添加到系统的系统消息监视链中，该函数在Delphi中的定义如下：

Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;
lpps:PIDLSTRUCT):integer;stdcall;external 'Shell32.dll' index 2;

其中参数hWnd定义了监视系统操作的窗口得句柄，参数uFlags dwEventID定义监视操作参数，参数uMsg定义操作消息，参数cItems定义附加参数，参数lpps指定一个PIDLSTRUCT结构，该结构指定监视的目录。

当函数调用成功之后，函数会返回一个监视操作句柄，同时系统就会将hWnd指定的窗口加入到操作监视链中，当有文件操作发生时，系统会向hWnd发送uMsg指定的消息，我们只要在程序中加入该消息的处理函数就可以实现对系统操作的监视了。

如果要退出程序监视，就要调用另外一个未公开得函数SHChangeNotifyDeregister来取消程序监视。

下面是使用Delphi编写的具体程序实现范例，首先建立一个新的工程文件，然后在Form1中加入一个Button控件和一个Memo控件，

程序的代码如下：

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs ,shlobj,Activex, StdCtrls;

const

SHCNE_RENAMEITEM = $;

SHCNE_CREATE = $;

SHCNE_DELETE = $;

SHCNE_MKDIR = $;

SHCNE_RMDIR = $;

SHCNE_MEDIAINSERTED = $;

SHCNE_MEDIAREMOVED = $;

SHCNE_DRIVEREMOVED = $;

SHCNE_DRIVEADD = $;

SHCNE_NETSHARE = $;

SHCNE_NETUNSHARE = $;

SHCNE_ATTRIBUTES = $;

SHCNE_UPDATEDIR = $;

SHCNE_UPDATEITEM = $;

SHCNE_SERVERDISCONNECT = $;

SHCNE_UPDATEIMAGE = $;

SHCNE_DRIVEADDGUI = $;

SHCNE_RENAMEFOLDER = $;

SHCNE_FREESPACE = $;

SHCNE_ASSOCCHANGED = $;

SHCNE_DISKEVENTS = $2381F;

SHCNE_GLOBALEVENTS = $C0581E0;

SHCNE_ALLEVENTS = $7FFFFFFF;

SHCNE_INTERRUPT = $;

SHCNF_IDLIST = ;

// LPITEMIDLIST

SHCNF_PATHA = $;

// path name

SHCNF_PRINTERA = $;

// printer friendly name

SHCNF_DWORD = $;

// DWORD

SHCNF_PATHW = $;

// path name

SHCNF_PRINTERW = $;

// printer friendly name

SHCNF_TYPE = $FF;

SHCNF_FLUSH = $;

SHCNF_FLUSHNOWAIT = $;

SHCNF_PATH = SHCNF_PATHW;

SHCNF_PRINTER = SHCNF_PRINTERW;

WM_SHNOTIFY = $;

NOERROR = ;

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

procedure WMShellReg(var Message:TMessage);message WM_SHNOTIFY; { Public declarations }

end;

type PSHNOTIFYSTRUCT=^SHNOTIFYSTRUCT;

SHNOTIFYSTRUCT = record

dwItem1 : PItemIDList;

dwItem2 : PItemIDList;

end;

Type PSHFileInfoByte=^SHFileInfoByte;

_SHFileInfoByte = record

hIcon :Integer;

iIcon :Integer;

dwAttributes : Integer;

szDisplayName : array [..] of char;

szTypeName : array [..] of char;

end;

SHFileInfoByte=_SHFileInfoByte;

Type PIDLSTRUCT = ^IDLSTRUCT;

_IDLSTRUCT = record

pidl : PItemIDList;

bWatchSubFolders : Integer;

end;

IDLSTRUCT =_IDLSTRUCT;

function SHNotify_Register(hWnd : Integer) : Bool;

function SHNotify_UnRegister:Bool;

function SHEventName(strPath1,strPath2:string;lParam:Integer):string;

Function SHChangeNotifyDeregister(hNotify:integer):integer;stdcall;external 'Shell32.dll' index ;

Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;lpps:PIDLSTRUCT):integer;stdcall;external 'Shell32.dll' index ;

Function SHGetFileInfoPidl(pidl : PItemIDList;dwFileAttributes : Integer;psfib : PSHFILEINFOBYTE;cbFileInfo : Integer;uFlags : Integer):Integer;stdcall;external 'Shell32.dll' name 'SHGetFileInfoA';

var

Form1: TForm1;

m_hSHNotify:Integer;

m_pidlDesktop : PItemIDList;

implementation

{$R *.dfm}

{ TForm1 }

function SHEventName(strPath1,strPath2:string;lParam:Integer):string;

var

sEvent:String;

begin

case lParam of //根据参数设置提示消息

SHCNE_RENAMEITEM: sEvent := '重命名文件'+strPath1+'为'+strpath2;

SHCNE_CREATE: sEvent := '建立文件 文件名：'+strPath1;

SHCNE_DELETE: sEvent := '删除文件 文件名：'+strPath1;

SHCNE_MKDIR: sEvent := '新建目录 目录名：'+strPath1;

SHCNE_RMDIR: sEvent := '删除目录 目录名：'+strPath1;

SHCNE_MEDIAINSERTED: sEvent := strPath1+'中插入可移动存储介质';

SHCNE_MEDIAREMOVED: sEvent := strPath1+'中移去可移动存储介质'+strPath1+' '+strpath2;

SHCNE_DRIVEREMOVED: sEvent := '移去驱动器'+strPath1;

SHCNE_DRIVEADD: sEvent := '添加驱动器'+strPath1;

SHCNE_NETSHARE: sEvent := '改变目录'+strPath1+'的共享属性';

SHCNE_ATTRIBUTES: sEvent := '改变文件目录属性 文件名'+strPath1;

SHCNE_UPDATEDIR: sEvent := '更新目录'+strPath1;

SHCNE_UPDATEITEM: sEvent := '更新文件 文件名：'+strPath1;

SHCNE_SERVERDISCONNECT: sEvent := '断开与服务器的连接'+strPath1+' '+strpath2;

SHCNE_UPDATEIMAGE: sEvent := 'SHCNE_UPDATEIMAGE';

SHCNE_DRIVEADDGUI: sEvent := 'SHCNE_DRIVEADDGUI';

SHCNE_RENAMEFOLDER: sEvent := '重命名文件夹'+strPath1+'为'+strpath2;

SHCNE_FREESPACE: sEvent := '磁盘空间大小改变';

SHCNE_ASSOCCHANGED: sEvent := '改变文件关联';

else

sEvent:='未知操作'+IntToStr(lParam);

end;

Result:=sEvent;

end;

function SHNotify_Register(hWnd : Integer) : Bool;

var

ps: pidlstruct;

begin

{$R-}

result := false;

if m_hshnotify =  then begin

//获取桌面文件夹的pidl

if shgetspecialfolderlocation(, CSIDL_DESKTOP, m_pidldesktop) <> noerror then

form1.close;

if boolean(m_pidldesktop) then begin

new(ps);

try

ps.bwatchsubfolders := ;

ps.pidl := m_pidldesktop;

// 利用shchangenotifyregister函数注册系统消息处理

m_hshnotify := shchangenotifyregister(hwnd, (shcnf_type or shcnf_idlist),

(shcne_allevents or shcne_interrupt),

wm_shnotify, , ps);

result := boolean(m_hshnotify);

finally

FreeMem(ps);

end;

end

else

// 如果出现错误就使用 cotaskmemfree函数来释放句柄

cotaskmemfree(m_pidldesktop);

end;

{$R+}

end;

function SHNotify_UnRegister:Bool;

begin

Result:=False;

If Boolean(m_hSHNotify) Then

//取消系统消息监视，同时释放桌面的Pidl

If Boolean(SHChangeNotifyDeregister(m_hSHNotify)) Then begin

{$R-}

m_hSHNotify := ;

CoTaskMemFree(m_pidlDesktop);

Result := True;

{$R-}

End;

end;

procedure TForm1.WMShellReg(var Message: TMessage);

//file://系统消息处理函数

var

strPath1,strPath2:String;

charPath:array[..]of char;

pidlItem:PSHNOTIFYSTRUCT;

begin

pidlItem:=PSHNOTIFYSTRUCT(Message.wParam);

//file://获得系统消息相关得路径

SHGetPathFromIDList(pidlItem.dwItem1,charPath);

strPath1:=charPath;

SHGetPathFromIDList(pidlItem.dwItem2,charPath);

strPath2:=charPath;

Memo1.Lines.Add(SHEvEntName(strPath1,strPath2,Message.lParam)+chr()+chr());

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

//在程序退出的同时删除监视

if Boolean(m_pidlDesktop) then

SHNotify_Unregister;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

m_hSHNotify:=;

if SHNotify_Register(Form1.Handle) then begin //file://注册Shell监视

ShowMessage('Shell监视程序成功注册');

Button1.Enabled := False;

end

else

ShowMessage('Shell监视程序注册失败');

end;

end.

运行程序，点击“打开监视”按钮，如果出现一个显示“Shell监视程序成功注册”的对话框，说明Form1已经加入到系统操作监视链中了，你可以试着在资源管理器中建立、删除文件夹，移动文件等操作，你可以发现这些操作都被记录下来并显示在文本框中。

在上面的程序中多次使用到了一个PItemIDList的结构，这个数据结构指定Windows下得一个“项目”，在Windows下资源实现统一管理一个“项目”可以是一个文件或者一个文件夹，也可以是一个打印机等资源。另外一些API函数也涉及到了Shell(Windows外壳)操作，各位读者可以参考相应的参考资料。

由于使用到了Windows的未公开函数，没有相关得参考资料，所以有一些未知得操作（在Memo1中会显示“未知操作”）。如果哪位读者有兴趣， http://member.netease.com/～blackcat 有实现该功能的VB程序下载。

以上程序在Windows98、Windows2000、Delphi5下运行通过。

如果需要检测某个文件夹，可使用以下方法：

function TDyjPlatDirMonitor.RegisterDirMonitor(hWnd: Integer;

aPath: string): Boolean;

var

_vP : PWideChar;

_vPs : IDLSTRUCT;

begin

{$R-}

Result := False;

if FSHNotify =  then

begin

_vP := PWideChar(WideString(aPath));

FPathPidl := SHSimpleIDListFromPath(_vP);

if Boolean(FPathPidl) then

begin

_vPs.bWatchSubFolders := ;

_vPs.pidl := FPathPidl;

FSHNotify := SHChangeNotifyRegister(hWnd,

(SHCNF_TYPE or SHCNF_IDLIST),

(SHCNE_ALLEVENTS or SHCNE_INTERRUPT),

WM_SHNOTIFY, , @_vPs);

Result := Boolean(FSHNotify);

end

else

CoTaskMemFree(FPathPidl);

end;

{$R+ }

end;

监控系统文件操作

这里介绍一种利用Windows未公开函数实现这个功能的方法。

在Windows下有一个未公开函数SHChangeNotifyRegister可以把你的窗口添加到系统的系统消息监视链中，该函数在Delphi中的定义如下：

Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;
lpps:PIDLSTRUCT):integer;stdcall;external 'Shell32.dll' index 2;

如果要退出程序监视，就要调用另外一个未公开得函数SHChangeNotifyDeregister来取消程序监视。

下面是使用Delphi编写的具体程序实现范例，首先建立一个新的工程文件，然后在Form1中加入一个Button控件和一个Memo控件，

程序的代码如下：

unit ufrmMain; 

interface 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs ,shlobj, Activex, StdCtrls,

Menus,

uTbLogFile; 

const

SHCNE_RENAMEITEM = $;

SHCNE_CREATE = $;

SHCNE_DELETE = $;

SHCNE_MKDIR = $;

SHCNE_RMDIR = $;

SHCNE_MEDIAINSERTED = $;

SHCNE_MEDIAREMOVED = $;

SHCNE_DRIVEREMOVED = $;

SHCNE_DRIVEADD = $;

SHCNE_NETSHARE = $;

SHCNE_NETUNSHARE = $;

SHCNE_ATTRIBUTES = $;

SHCNE_UPDATEDIR = $;

SHCNE_UPDATEITEM = $;

SHCNE_SERVERDISCONNECT = $;

SHCNE_UPDATEIMAGE = $;

SHCNE_DRIVEADDGUI = $;

SHCNE_RENAMEFOLDER = $;

SHCNE_FREESPACE = $;

SHCNE_ASSOCCHANGED = $;

SHCNE_DISKEVENTS = $2381F;

SHCNE_GLOBALEVENTS = $C0581E0;

SHCNE_ALLEVENTS = $7FFFFFFF;

SHCNE_INTERRUPT = $;

SHCNF_IDLIST = ;

// LPITEMIDLIST

SHCNF_PATHA = $;

// path name

SHCNF_PRINTERA = $;

// printer friendly name

SHCNF_DWORD = $;

// DWORD

SHCNF_PATHW = $;

// path name

SHCNF_PRINTERW = $;

// printer friendly name

SHCNF_TYPE = $FF;

SHCNF_FLUSH = $;

SHCNF_FLUSHNOWAIT = $;

SHCNF_PATH = SHCNF_PATHW;

SHCNF_PRINTER = SHCNF_PRINTERW;

WM_SHNOTIFY = $;

NOERROR = ; 

type

TForm1 = class(TForm)

mmo1: TMemo;

Button1: TButton;

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure btn1Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

WRITE_LOG : TRTLCriticalSection;

FLogWriterSetupForm: TTbLogFile;

public

procedure WMShellReg(var Message:TMessage);message WM_SHNOTIFY;

end; 

type

PSHNOTIFYSTRUCT=^SHNOTIFYSTRUCT;

SHNOTIFYSTRUCT = record

dwItem1 : PItemIDList;

dwItem2 : PItemIDList;

end; 

Type

PSHFileInfoByte=^SHFileInfoByte;

_SHFileInfoByte = record

hIcon :Integer;

iIcon :Integer;

dwAttributes : Integer;

szDisplayName : array [..] of char;

szTypeName : array [..] of char;

end; 

SHFileInfoByte=_SHFileInfoByte; 

Type PIDLSTRUCT = ^IDLSTRUCT;

_IDLSTRUCT = record

pidl : PItemIDList;

bWatchSubFolders : Integer;

end; 

IDLSTRUCT = _IDLSTRUCT; 

function SHNotify_Register(hWnd : Integer) : Bool;

function SHNotify_UnRegister:Bool;

function SHEventName(strPath1,strPath2:string;lParam:Integer):string;

Function SHChangeNotifyDeregister(hNotify:integer):integer;stdcall;external 'Shell32.dll' index ;

Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;lpps:PIDLSTRUCT):integer;stdcall;external 'Shell32.dll' index ;

Function SHGetFileInfoPidl(pidl : PItemIDList;dwFileAttributes : Integer;psfib : PSHFILEINFOBYTE;cbFileInfo : Integer;uFlags : Integer):Integer;stdcall;external 'Shell32.dll' name 'SHGetFileInfoA'; 

var

Form1: TForm1;

m_hSHNotify:Integer;

m_pidlDesktop : PItemIDList; 

implementation 

{$R *.dfm} 

function SHEventName(strPath1, strPath2: string; lParam: Integer): string;

var

sEvent:String;

begin

case lParam of //根据参数设置提示消息

SHCNE_RENAMEITEM: sEvent := '重命名文件' + strPath1 + '为' + strpath2;

SHCNE_CREATE: sEvent := '建立文件 文件名：' + strPath1;

SHCNE_DELETE: sEvent := '删除文件 文件名：' + strPath1;

SHCNE_MKDIR: sEvent := '新建目录 目录名：' + strPath1;

SHCNE_RMDIR: sEvent := '删除目录 目录名：' + strPath1;

SHCNE_MEDIAINSERTED: sEvent := strPath1 + '中插入可移动存储介质';

SHCNE_MEDIAREMOVED: sEvent := strPath1 + '中移去可移动存储介质' + strPath1 + ' '+strpath2;

SHCNE_DRIVEREMOVED: sEvent := '移去驱动器' + strPath1;

SHCNE_DRIVEADD: sEvent := '添加驱动器' + strPath1;

SHCNE_NETSHARE: sEvent := '改变目录' + strPath1 + '的共享属性'; 

SHCNE_ATTRIBUTES: sEvent := '改变文件目录属性 文件名' + strPath1;

SHCNE_UPDATEDIR: sEvent := '更新目录' + strPath1;

SHCNE_UPDATEITEM: sEvent := '更新文件 文件名：' + strPath1;

SHCNE_SERVERDISCONNECT: sEvent := '断开与服务器的连接' + strPath1 + ' ' + strpath2;

SHCNE_UPDATEIMAGE: sEvent := 'SHCNE_UPDATEIMAGE';

SHCNE_DRIVEADDGUI: sEvent := 'SHCNE_DRIVEADDGUI';

SHCNE_RENAMEFOLDER: sEvent := '重命名文件夹' + strPath1 + '为' + strpath2;

SHCNE_FREESPACE: sEvent := '磁盘空间大小改变';

SHCNE_ASSOCCHANGED: sEvent := '改变文件关联';

else

sEvent := '未知操作' + IntToStr(lParam);

end;

Result := sEvent;

end; 

function SHNotify_Register(hWnd: Integer): Bool;

var

ps: pidlstruct;

begin

{$R-}

result := false;

if m_hshnotify =  then

begin

//获取桌面文件夹的pidl

if shgetspecialfolderlocation(, CSIDL_DESKTOP, m_pidldesktop) <> noerror then

form1.close;

if boolean(m_pidldesktop) then begin

new(ps);

try

ps.bwatchsubfolders := ;

ps.pidl := m_pidldesktop; 

// 利用shchangenotifyregister函数注册系统消息处理

m_hshnotify := shchangenotifyregister(hwnd, (shcnf_type or shcnf_idlist),

(shcne_allevents or shcne_interrupt),

wm_shnotify, , ps);

result := boolean(m_hshnotify);

finally

FreeMem(ps);

end;

end

else

begin

// 如果出现错误就使用 cotaskmemfree函数来释放句柄

cotaskmemfree(m_pidldesktop);

end;

end;

{$R+}

end; 

function SHNotify_UnRegister: Bool;

begin

Result := False;

If Boolean(m_hSHNotify) Then

begin

//取消系统消息监视，同时释放桌面的Pidl

If Boolean(SHChangeNotifyDeregister(m_hSHNotify)) Then begin

{$R-}

m_hSHNotify := ;

CoTaskMemFree(m_pidlDesktop);

Result := True;

{$R-}

End;

end;

end; 

procedure TForm1.WMShellReg(var Message: TMessage);

//file://系统消息处理函数

var

strPath1,strPath2:String;

charPath:array[..]of char;

pidlItem:PSHNOTIFYSTRUCT;

begin

pidlItem := PSHNOTIFYSTRUCT(Message.wParam);

//file://获得系统消息相关得路径

SHGetPathFromIDList(pidlItem.dwItem1, charPath);

strPath1 := charPath;

SHGetPathFromIDList(pidlItem.dwItem2, charPath);

strPath2 := charPath; 

try

EnterCriticalSection(WRITE_LOG);

FLogWriterSetupForm.WriteLnLog(SHEvEntName(strPath1, strPath2, Message.lParam) + chr() + chr());

finally

LeaveCriticalSection(WRITE_LOG);

end;

// mmo1.Lines.Add(SHEvEntName(strPath1,strPath2,Message.lParam)+chr(13)+chr(10));

end; 

{获得计算机名}

function GetComputerName: string;

var

buffer: array[..MAX_COMPUTERNAME_LENGTH + ] of Char;

Size: Cardinal;

begin

Size := MAX_COMPUTERNAME_LENGTH + ;

Windows.GetComputerName(@buffer, Size);

Result := strpas(buffer);

end; 

procedure TForm1.FormCreate(Sender: TObject);

begin

Caption := GetComputerName; 

InitializeCriticalSection(WRITE_LOG);

FLogWriterSetupForm := TTbLogFile.Create(nil);

FLogWriterSetupForm.AutoRenameByDay := True;

FLogWriterSetupForm.Open(ExtractFilePath(ParamStr()) + ' 操作.log', otAppend);

end; 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

//在程序退出的同时删除监视

if Boolean(m_pidlDesktop) then

SHNotify_Unregister;

end; 

procedure TForm1.btn1Click(Sender: TObject);

begin

m_hSHNotify:=;

if SHNotify_Register(Form1.Handle) then begin //file://注册Shell监视

ShowMessage('Shell监视程序成功注册');

Button1.Enabled := False;

end

else

ShowMessage('Shell监视程序注册失败');

end; 

procedure TForm1.FormDestroy(Sender: TObject);

begin

DeleteCriticalSection(WRITE_LOG);

FreeAndNil(FLogWriterSetupForm);

end; 

end.

以上程序在Windows98、Windows2000、Delphi5下运行通过。

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 = $;

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 ;

Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;lpps:PIDLSTRUCT):integer;stdcall;

external 'Shell32.dll' index ;

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>=) then begin  //  开始监控

    g_WatchPath:=Path.ToUpper;

    if g_HSHNotify =  then begin

      SHGetSpecialFolderLocation(, CSIDL_DESKTOP, g_pidlDesktop);

      if Boolean(g_pidlDesktop) then begin

        getmem(ps,sizeof(IDLSTRUCT));

        ps.bWatchSubFolders := ;

        ps.pidl := g_pidlDesktop;

        g_HSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE Or SHCNF_IDLIST),(SHCNE_ALLEVENTS Or SHCNE_INTERRUPT),WM_SHNOTIFY, , 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 := ;

      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[..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) >=  then    //两个时间之间相差的秒数

      begin

       // 这里处理监控到后   要响应的事情

      end;

    end;

  end);

end;

监控指定文件夹

delphi XE + XP 下测试通过

O2DirSpy.pas    (该单元获取自网络)

[delphi]

{====================================================================}

{   TOxygenDirectorySpy Component, v1.6 c 2000-2001 Oxygen Software  }

{--------------------------------------------------------------------}

{          Written by Oleg Fyodorov, delphi@oxygensoftware.com       }

{                  http://www.oxygensoftware.com                     }

{====================================================================}  

unit O2DirSpy;  

interface  

  uses Classes, Controls, Windows, SysUtils, ShellApi, Dialogs, Messages, FileCtrl;  

  type

    TDirectoryChangeType = (ctNone, ctAttributes, ctSize, ctCreationTime, ctLastModificationTime, ctLastAccessTime, ctLastTime, ctCreate, ctRemove);  

    TOxygenDirectorySpy = class;  

    TDirectoryChangeRecord = record

      Directory : String;

      FileFlag : Boolean; // When True, ChangeType applies to a file; False - ChangeType applies to Directory

      Name : String; // Name of changed file/directory

      OldTime, NewTime : TDateTime;  // Significant only when ChangeType is one of ctCreationTime, ctLastModificationTime, ctLastAccessTime, ctLastTime

      OldAttributes, NewAttributes : DWord; // Significant only when ChangeType is ctAttributes

      OldSize, NewSize : DWord; // Significant only when ChangeType is ctSize

      ChangeType : TDirectoryChangeType; // Describes a change type (creation, removing etc.)

    end;  

    TSpySearchRec = record

      Time: Integer;

      Size: Integer;

      Attr: Integer;

      dwFileAttributes: DWORD;

      ftCreationTime: TFileTime;

      ftLastAccessTime: TFileTime;

      ftLastWriteTime: TFileTime;

      nFileSizeHigh: DWORD;

      nFileSizeLow: DWORD;

    end;  

    TFileData = class

      private

        FSearchRec : TSpySearchRec;

        Name: TFileName;

        FFound : Boolean;

      public

        constructor Create;

        procedure Free;

    end;  

    TFileDataList = class(TStringList)

      private

        function NewFileData(const FileName : String; sr : TSearchRec) : TFileData;

        function GetFoundCount : Integer;

      public

        property FoundCount : Integer read GetFoundCount;  

        destructor Destroy; override;

        function AddFileData(FileData : TFileData) : Integer;

        function AddSearchRec(const Directory : String; sr : TSearchRec) : Integer;

        procedure Delete(Index : Integer); override;

        procedure Clear; override;

        procedure SetFound(Value : Boolean);

    end;  

    TReadDirChangesThread = class(TThread)

    private

      FOwner           : TOxygenDirectorySpy;

      FDirectories     : TStringList;

      FHandles         : TList;

      FChangeRecord    : TDirectoryChangeRecord;

      FFilesData,

      FTempFilesData   : TFileDataList;

      pHandles         : PWOHandleArray;

      procedure ReleaseHandle;

      procedure AllocateHandle;

      procedure ReadDirectories(DestData : TFileDataList);

      procedure CompareSearchRec(var srOld, srNew : TSpySearchRec);

    protected

      procedure Execute; override;

      procedure Notify;

    public

      constructor Create(Owner : TOxygenDirectorySpy);

      destructor Destroy; override;

      procedure Reset;

    end;  

    TChangeDirectoryEvent = procedure (Sender : TObject; ChangeRecord : TDirectoryChangeRecord) of object;  

    TOxygenDirectorySpy = class(TComponent)

      private

        FThread : TReadDirChangesThread;

        FEnabled,

        FWatchSubTree : Boolean;

        FDirectories : TStrings;

        FOnChangeDirectory : TChangeDirectoryEvent;  

        procedure SetEnabled(const Value : Boolean);

        procedure CheckDirectories;

        procedure SetDirectories(const Value : TStrings);

        procedure SetWatchSubTree(const Value : Boolean);

      protected

        procedure DoChangeDirectory(ChangeRecord : TDirectoryChangeRecord);

      published

        property Enabled : Boolean read FEnabled write SetEnabled;

        property Directories : TStrings read FDirectories write SetDirectories;

        property WatchSubTree : Boolean read FWatchSubTree write SetWatchSubTree;

        property OnChangeDirectory : TChangeDirectoryEvent read FOnChangeDirectory write FOnChangeDirectory;

      public

        constructor Create(AOwner : TComponent); override;

        destructor Destroy; override;

    end;  

    function ChangeRecord2String(ChangeRecord : TDirectoryChangeRecord) : String;  

    procedure Register;  

implementation  

function ChangeRecord2String(ChangeRecord : TDirectoryChangeRecord) : String;

  var s : String;

begin

  Result := 'No changes';

  if ChangeRecord.FileFlag then s := 'File ' else s := 'Directory ';

  s := s + '"' + ChangeRecord.Name + '"';

  case ChangeRecord.ChangeType of

    ctAttributes           : Result := s + ' attributes are changed. Old: ' + IntToHex(ChangeRecord.OldAttributes,) + ', New: ' + IntToHex(ChangeRecord.NewAttributes,);

    ctSize                 : Result := s + ' size is changed. Old: ' + IntToStr(ChangeRecord.OldSize) + ', New: ' + IntToStr(ChangeRecord.NewSize);

    ctCreationTime         : Result := s + ' creation time is changed. Old: ' + DateTimeToStr(ChangeRecord.OldTime) + ', New: ' + DateTimeToStr(ChangeRecord.NewTime);

    ctLastModificationTime : Result := s + ' last modification time is changed. Old: ' + DateTimeToStr(ChangeRecord.OldTime) + ', New: ' + DateTimeToStr(ChangeRecord.NewTime);

    ctLastAccessTime       : Result := s + ' last access time is changed. Old: ' + DateTimeToStr(ChangeRecord.OldTime) + ', New: ' + DateTimeToStr(ChangeRecord.NewTime);

    ctLastTime             : Result := s + ' time is changed. Old: ' + DateTimeToStr(ChangeRecord.OldTime) + ', New: ' + DateTimeToStr(ChangeRecord.NewTime);

    ctCreate               : Result := s + ' is created';

    ctRemove               : Result := s + ' is deleted';

  end;

end;  

function  SameSystemTime(Time1, Time2 : TSystemTime) : Boolean;

begin

  Result := ((Time1.wYear = Time2.wYear) and (Time1.wMonth = Time2.wMonth) and (Time1.wDay = Time2.wDay) and (Time1.wHour = Time2.wHour) and (Time1.wMinute = Time2.wMinute) and (Time1.wSecond = Time2.wSecond) and (Time1.wMilliseconds = Time2.wMilliseconds));

end;  

function ReplaceText(s, SourceText, DestText: String):String;

  var st,res:string;

      i:Integer;

begin

  ReplaceText:='';

  if ((s='') or (SourceText='')) then Exit;

  st:=s;

  res:='';

  i:=Pos(SourceText,s);

  while (i>) do

  begin

    res:=res+Copy(st,,i-)+DestText;

    Delete(st,,(i+Length(SourceText)-));

    i:=Pos(SourceText,st);

  end;

  res:=res+st;

  ReplaceText:=res;

end;  

///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// TFileData

///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

constructor TFileData.Create;

begin

  inherited Create;

  Name := '';

  FillChar(FSearchRec,SizeOf(FSearchRec),);

  FFound := False;

end;  

procedure TFileData.Free;

begin

  Name := '';

  //Finalize(FSearchRec);

  inherited Free;

end;  

///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

//  TFileDataList

///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

destructor TFileDataList.Destroy;

begin

  Clear;

  inherited Destroy;;

end;  

function TFileDataList.NewFileData(const FileName : String; sr : TSearchRec) : TFileData;

begin

  Result := TFileData.Create;

  Result.Name := FileName;

  with Result.FSearchRec do begin

    Time := sr.Time;

    Size := sr.Size;

    Attr := sr.Attr;

    dwFileAttributes := sr.FindData.dwFileAttributes;

    ftCreationTime := sr.FindData.ftCreationTime;

    ftLastAccessTime := sr.FindData.ftLastAccessTime;

    ftLastWriteTime := sr.FindData.ftLastWriteTime;

    nFileSizeHigh := sr.FindData.nFileSizeHigh;

    nFileSizeLow := sr.FindData.nFileSizeLow;

  end;

end;  

function TFileDataList.GetFoundCount : Integer;

  var i : Integer;

begin

  Result := ;

  for i :=  to Count do if TFileData(Objects[i-]).FFound then Inc(Result);

end;  

function TFileDataList.AddFileData(FileData : TFileData) : Integer;

  var fd : TFileData;

begin

  fd := TFileData.Create;

  fd.Name := FileData.Name;

  fd.FSearchRec := FileData.FSearchRec;

  Result := AddObject(fd.Name, fd);

end;  

function TFileDataList.AddSearchRec(const Directory : String; sr : TSearchRec) : Integer;

  var FileName : String;

begin

  if (Directory <> '') then FileName := ReplaceText(Directory + '\' + sr.Name,'\\','\') else FileName := sr.Name;

  Result := AddObject(FileName, NewFileData(FileName, sr));

end;  

procedure TFileDataList.Delete(Index : Integer);

begin

  TFileData(Objects[Index]).Free;

  inherited Delete(Index);

end;  

procedure TFileDataList.Clear;

begin

  while (Count > ) do Delete();

  inherited Clear;

end;  

procedure TFileDataList.SetFound(Value : Boolean);

  var i : Integer;

begin

  for i :=  to Count do TFileData(Objects[i-]).FFound := Value;

end;  

function CompareMem(fpBlock1, fpBlock2: Pointer; Size: Cardinal): Boolean; assembler;

asm

        PUSH    ESI

        PUSH    EDI

        MOV     ESI,fpBlock1

        MOV     EDI,fpBlock2

        MOV     ECX,Size

        MOV     EDX,ECX

        XOR     EAX,EAX

        AND     EDX,

        SHR     ECX,

        REPE    CMPSD

        JNE     @@

        MOV     ECX,EDX

        REPE    CMPSB

        JNE     @@

@@:    INC     EAX

@@:    POP     EDI

        POP     ESI

end;  

///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

//       TReadDirChangesThread

///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

procedure TReadDirChangesThread.CompareSearchRec(var srOld, srNew : TSpySearchRec);

  var tt,nt,ot : TSystemTime;

      //sro,srn : TSpySearchRec;

begin

  FChangeRecord.ChangeType := ctNone;

  if CompareMem(@srOld,@srNew, SizeOf(TSpySearchRec)) then Exit;

  if (srOld.Time <> srNew.Time) then begin

    FChangeRecord.ChangeType := ctLastTime;

    FChangeRecord.OldTime := FileDateToDateTime(srOld.Time);

    FChangeRecord.NewTime := FileDateToDateTime(srNew.Time);

    srOld.Time := srNew.Time;

    Exit;

  end

  else if (srOld.Size <> srNew.Size) then begin

    FChangeRecord.ChangeType := ctSize;

    FChangeRecord.OldSize := srOld.Size;

    FChangeRecord.NewSize := srNew.Size;

    srOld.Size := srNew.Size;

    Exit;

  end

  else if (srOld.Attr <> srNew.Attr) or (srOld.dwFileAttributes <> srNew.dwFileAttributes) then begin

    FChangeRecord.ChangeType := ctAttributes;

    FChangeRecord.OldAttributes := srOld.dwFileAttributes;

    FChangeRecord.NewAttributes := srNew.dwFileAttributes;

    srOld.dwFileAttributes := srNew.dwFileAttributes;

    srOld.Attr := srNew.Attr;

    Exit;

  end

  else begin

    FileTimeToSystemTime(srNew.ftCreationTime,nt);

    SystemTimeToTzSpecificLocalTime(nil,nt,tt);

    nt := tt;

    FileTimeToSystemTime(srOld.ftCreationTime,ot);

    SystemTimeToTzSpecificLocalTime(nil,ot,tt);

    ot := tt;

    if not SameSystemTime(nt,ot) then begin

      FChangeRecord.ChangeType := ctCreationTime;

      FChangeRecord.OldTime := SystemTimeToDateTime(ot);

      FChangeRecord.NewTime := SystemTimeToDateTime(nt);

      srOld.ftCreationTime := srNew.ftCreationTime;

      Exit;

    end

    else begin

      FileTimeToSystemTime(srNew.ftLastAccessTime,nt);

      SystemTimeToTzSpecificLocalTime(nil,nt,tt);

      nt := tt;

      FileTimeToSystemTime(srOld.ftLastAccessTime,ot);

      SystemTimeToTzSpecificLocalTime(nil,ot,tt);

      ot := tt;

      if not SameSystemTime(nt,ot) then begin

        FChangeRecord.ChangeType := ctLastAccessTime;

        FChangeRecord.OldTime := SystemTimeToDateTime(ot);

        FChangeRecord.NewTime := SystemTimeToDateTime(nt);

        srOld.ftLastAccessTime := srNew.ftLastAccessTime;

        Exit;

      end

      else begin

        FileTimeToSystemTime(srNew.ftLastWriteTime,nt);

        SystemTimeToTzSpecificLocalTime(nil,nt,tt);

        nt := tt;

        FileTimeToSystemTime(srOld.ftLastWriteTime,ot);

        SystemTimeToTzSpecificLocalTime(nil,ot,tt);

        ot := tt;

        if not SameSystemTime(nt,ot) then begin

          FChangeRecord.ChangeType := ctLastModificationTime;

          FChangeRecord.OldTime := SystemTimeToDateTime(ot);

          FChangeRecord.NewTime := SystemTimeToDateTime(nt);

          srOld.ftLastWriteTime := srNew.ftLastWriteTime;

          Exit;

        end;

      end;

    end;

  end;

end;  

procedure TReadDirChangesThread.Execute;

  var i, Index : Integer;

      R : DWord;

      fd : TFileData;

begin

  while not Terminated do try

    if (FDirectories.Count = ) or (not FOwner.Enabled) then Sleep()

    else begin

      R := WaitForMultipleObjects(FHandles.Count,pHandles,False,);

      if (R < (WAIT_OBJECT_ + DWord(FHandles.Count))) then begin

        FillChar(FChangeRecord,SizeOf(FChangeRecord),);

        FFilesData.SetFound(False);

        FTempFilesData.Clear;

        ReadDirectories(FTempFilesData);

        while (FTempFilesData.Count > ) do begin

          fd := TFileData(FTempFilesData.Objects[]);

          // New file/directory is created

          if not FFilesData.Find(fd.Name,Index) then begin

            Index := FFilesData.AddFileData(fd);

            TFileData(FFilesData.Objects[Index]).FFound := True;

            FChangeRecord.ChangeType := ctCreate;

            FChangeRecord.Name := fd.Name;

            FChangeRecord.FileFlag := ((fd.FSearchRec.Attr and faDirectory) = );

            FChangeRecord.Directory := FDirectories[R - WAIT_OBJECT_];

            Synchronize(Notify);

          end

          else begin

            // file/directory is modified

            TFileData(FFilesData.Objects[Index]).FFound := True;

            CompareSearchRec(TFileData(FFilesData.Objects[Index]).FSearchRec, fd.FSearchRec);

            while (FChangeRecord.ChangeType <> ctNone) do begin

              FChangeRecord.Name := fd.Name;

              FChangeRecord.FileFlag := ((fd.FSearchRec.Attr and faDirectory) = );

              FChangeRecord.Directory := FDirectories[R - WAIT_OBJECT_];

              Synchronize(Notify);

              CompareSearchRec(TFileData(FFilesData.Objects[Index]).FSearchRec, fd.FSearchRec);

            end;

          end;

          FTempFilesData.Delete();

        end;

        for i := FFilesData.Count downto  do if not TFileData(FFilesData.Objects[i-]).FFound then begin

          // file/directory is deleted

          fd := TFileData(FFilesData.Objects[i-]);

          FChangeRecord.ChangeType := ctRemove;

          FChangeRecord.Name := fd.Name;

          FChangeRecord.FileFlag := ((fd.FSearchRec.Attr and faDirectory) = );

          FChangeRecord.Directory := FDirectories[R - WAIT_OBJECT_];

          FFilesData.Delete(i-);

          Synchronize(Notify);

        end;

        FindNextChangeNotification(THandle(FHandles[R - WAIT_OBJECT_]));

      end;

    end;

  except end;

end;  

procedure TReadDirChangesThread.Notify;

  var cr : TDirectoryChangeRecord;

begin

  cr := FChangeRecord;

  if (cr.ChangeType <> ctNone) then FOwner.DoChangeDirectory(cr);

end;  

constructor TReadDirChangesThread.Create(Owner : TOxygenDirectorySpy);

begin

  inherited Create(True);

  FOwner := Owner;

  FHandles := TList.Create;

  pHandles := nil;

  FDirectories := TStringList.Create;

  FDirectories.Sorted := True;

  FDirectories.Duplicates := dupIgnore;

  FreeOnTerminate := True;

  FFilesData := TFileDataList.Create;

  FFilesData.Sorted := True;

  FFilesData.Duplicates := dupIgnore;

  FTempFilesData := TFileDataList.Create;

  FTempFilesData.Sorted := True;

  FTempFilesData.Duplicates := dupIgnore;

  //Reset;

end;  

procedure TReadDirChangesThread.ReleaseHandle;

  var i : Integer;

begin

  if (pHandles <> nil) then FreeMem(pHandles,FHandles.Count * SizeOf(THandle));

  pHandles := nil;

  for i :=  to FHandles.Count do if (THandle(FHandles[i-]) <> INVALID_HANDLE_VALUE) then FindCloseChangeNotification(THandle(FHandles[i-]));//CloseHandle(FHandle);

  FHandles.Clear;

end;  

destructor TReadDirChangesThread.Destroy;

begin

  ReleaseHandle;

  FHandles.Free;

  FDirectories.Free;

  FFilesData.Clear;

  FFilesData.Free;

  FTempFilesData.Clear;

  FTempFilesData.Free;

  inherited Destroy;

end;  

procedure TReadDirChangesThread.AllocateHandle;

  var i : Integer;

      h : THandle;

begin

  if (FOwner <> nil) then for i :=  to FDirectories.Count do begin

    h := FindFirstChangeNotification(PChar(FDirectories[i-]), FOwner.WatchSubTree, FILE_NOTIFY_CHANGE_FILE_NAME +

                                           FILE_NOTIFY_CHANGE_DIR_NAME + FILE_NOTIFY_CHANGE_ATTRIBUTES +

                                           FILE_NOTIFY_CHANGE_SIZE + FILE_NOTIFY_CHANGE_LAST_WRITE);

    {h := FindFirstChangeNotification(PChar(FDirectories[i-1]), FALSE, FILE_NOTIFY_CHANGE_FILE_NAME +

                                           FILE_NOTIFY_CHANGE_DIR_NAME + FILE_NOTIFY_CHANGE_ATTRIBUTES +

                                           FILE_NOTIFY_CHANGE_SIZE + FILE_NOTIFY_CHANGE_LAST_WRITE);}

    if (h <> INVALID_HANDLE_VALUE) then FHandles.Add(Pointer(h)) else raise Exception.Create('Error allocating handle: #'+IntToStr(GetLastError));

  end;

  GetMem(pHandles,FHandles.Count * SizeOf(THandle));

  for i :=  to FHandles.Count do pHandles^[i-] := THandle(FHandles[i-]);

  ReadDirectories(FFilesData);

end;  

procedure TReadDirChangesThread.ReadDirectories(DestData : TFileDataList);

  var i : Integer;  

  procedure AppendDirContents(const Directory : String);

    var sr : TSearchRec;

        s : String;

  begin

    if (Directory[Length(Directory)] <> '\') then s := Directory + '\*.*' else s := Directory + '*.*';

    if (FindFirst(s,faAnyFile,sr) = ) then begin

      if (sr.Name <> '.') and (sr.Name <> '..') then begin

        DestData.AddSearchRec(Directory,sr);

        if ((sr.Attr and faDirectory) <> ) and FOwner.WatchSubTree then AppendDirContents(Directory + '\' + sr.Name);

      end;

      while (FindNext(sr) = ) do if (sr.Name <> '.') and (sr.Name <> '..') then begin

        DestData.AddSearchRec(Directory,sr);

        if ((sr.Attr and faDirectory) <> ) and FOwner.WatchSubTree then AppendDirContents(Directory + '\' + sr.Name);

      end;

      FindClose(sr);

    end;

  end;  

begin

  for i :=  to FDirectories.Count do AppendDirContents(FDirectories[i-]);

end;  

procedure TReadDirChangesThread.Reset;

begin

  ReleaseHandle;

  if (FDirectories.Count = ) then Exit;

  AllocateHandle;

  if (FHandles.Count > ) then Resume;

end;  

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

//       TOxygenDirectorySpy

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

constructor TOxygenDirectorySpy.Create(AOwner : TComponent);

begin

  inherited Create(AOwner);

  FEnabled := False;

  FWatchSubTree := False;

  FDirectories := TStringList.Create;

  TStringList(FDirectories).Sorted := True;

  TStringList(FDirectories).Duplicates := dupIgnore;

  FOnChangeDirectory := nil;

  FThread := nil;

{$IFDEF O2_SW}

  if (MessageDlg('This version of TOxygenDirectorySpy is NOT REGISTERED. '+##+

                 'Press Ok to visit http://www.oxygensoftware.com and register.',

                 mtWarning,[mbOk,mbCancel],) = mrOk) then ShellExecute(,'open','http://www.oxygensoftware.com',nil,nil,SW_SHOWNORMAL);

{$ENDIF}

end;  

procedure TOxygenDirectorySpy.SetEnabled(const Value : Boolean);

begin

  if (csDesigning in ComponentState) then Exit;

  if (Value = FEnabled) then Exit;

  CheckDirectories;

  if (FDirectories.Count = ) then FEnabled := False else FEnabled := Value;

  if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) then FWatchSubTree := False;

  if FEnabled then begin

    FThread := TReadDirChangesThread.Create(Self);

    FThread.FDirectories.Clear;

    FThread.FDirectories.AddStrings(FDirectories);

    FThread.Reset;

  end

  else if (FThread <> nil) then begin

    FThread.Terminate;

    FThread.WaitFor;

    //TerminateThread(FThread.Handle,0);

    FThread := nil;

  end;

end;  

procedure TOxygenDirectorySpy.CheckDirectories;

  var i : Integer;

      s : String;

begin

  for i := FDirectories.Count downto  do begin

    s := Trim(FDirectories[i-]);

    if (s = '') or (not DirectoryExists(s)) then FDirectories.Delete(i-);

  end;

  while (FDirectories.Count > MAXIMUM_WAIT_OBJECTS) do FDirectories.Delete(FDirectories.Count - );

end;  

procedure TOxygenDirectorySpy.SetDirectories(const Value : TStrings);

begin

  FDirectories.Clear;

  FDirectories.AddStrings(Value);

  CheckDirectories;

  if FEnabled then begin

    SetEnabled(False);

    SetEnabled(True);

  end;

end;  

procedure TOxygenDirectorySpy.SetWatchSubTree(const Value : Boolean);

begin

  if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) then begin

    FWatchSubTree := False;

    Exit;

  end;

  if (FWatchSubTree = Value) then Exit;

  FWatchSubTree := Value;

  if FEnabled then begin

    SetEnabled(False);

    SetEnabled(True);

  end;

end;  

procedure TOxygenDirectorySpy.DoChangeDirectory(ChangeRecord : TDirectoryChangeRecord);

begin

  if Assigned(FOnChangeDirectory) then FOnChangeDirectory(Self, ChangeRecord);

end;  

destructor TOxygenDirectorySpy.Destroy;

begin

  if (FThread <> nil) then begin

    FThread.Terminate;

    FThread.WaitFor;

    //TerminateThread(FThread.Handle,0);

    //FThread.Free;

    FThread := nil;

  end;

  inherited Destroy;

end;  

procedure Register;

begin

  RegisterComponents('Oxygen', [TOxygenDirectorySpy]);

end;  

end.  

调用单元

[delphi]

unit utMain;  

interface  

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ExtCtrls, O2DirSpy, FileCtrl;  

type

  TMainForm = class(TForm)

    lstChanges: TListBox;

    pnl1: TPanel;

    pnl2: TPanel;

    pnl3: TPanel;

    btnAdd: TButton;

    btnRemove: TButton;

    pnl4: TPanel;

    lstDirectoriesListBox: TListBox;

    pnl5: TPanel;

    lbl1: TLabel;

    chkWatchSubTree: TCheckBox;

    procedure btnAddClick(Sender: TObject);

    procedure btnRemoveClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure chkWatchSubTreeClick(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

  private

    OxygenDirectorySpy1: TOxygenDirectorySpy;

    procedure OxygenDirectorySpy1ChangeDirectory(Sender: TObject;

      ChangeRecord: TDirectoryChangeRecord);

    { Private declarations }

  public

    { Public declarations }

  end;  

var

  MainForm: TMainForm;  

implementation  

{$R *.dfm}  

procedure TMainForm.btnAddClick(Sender: TObject);

  var s : String;

begin

  if not SelectDirectory(s, [sdAllowCreate, sdPerformCreate, sdPrompt],) then Exit;

  with OxygenDirectorySpy1 do begin

    Enabled := False;

    Directories.Add(s);

    Enabled := True;

  end;  

  with lstDirectoriesListBox do try

    Items.Clear;

    Items.AddStrings(OxygenDirectorySpy1.Directories);

    ItemIndex := ;

  except end;

  btnRemove.Enabled := True;  

end;  

procedure TMainForm.btnRemoveClick(Sender: TObject);

var

  i : Integer;

begin

  if (lstDirectoriesListBox.Items.Count = ) then Exit;

  i := lstDirectoriesListBox.ItemIndex;

  if (i = -) then Exit;

  lstDirectoriesListBox.Items.Delete(i);

  with OxygenDirectorySpy1 do begin

    Enabled := False;

    Directories.Delete(i);

    if (Directories.Count > ) then begin

      Enabled := True;

      lstDirectoriesListBox.ItemIndex := ;

    end;

  end;

  btnRemove.Enabled := (lstDirectoriesListBox.Items.Count > );

end;  

procedure TMainForm.chkWatchSubTreeClick(Sender: TObject);

begin

  OxygenDirectorySpy1.WatchSubTree := chkWatchSubTree.Checked;

end;  

procedure TMainForm.FormCreate(Sender: TObject);

begin

  OxygenDirectorySpy1 := TOxygenDirectorySpy.Create(Self);

  OxygenDirectorySpy1.OnChangeDirectory := OxygenDirectorySpy1ChangeDirectory;

  SendMessage(lstChanges.Handle,LB_SETHORIZONTALEXTENT,,);

end;  

procedure TMainForm.FormDestroy(Sender: TObject);

begin

  OxygenDirectorySpy1.Free;

end;  

procedure TMainForm.OxygenDirectorySpy1ChangeDirectory(Sender: TObject; ChangeRecord: TDirectoryChangeRecord);

begin

  lstChanges.Items.Add(DateTimeToStr(SysUtils.Now) + '  ' + ChangeRecord2String(ChangeRecord));

  with lstChanges do if (Items.Count > ) then ItemIndex := Items.Count - ;

end;  

end.  

调用窗体

[delphi]

object MainForm: TMainForm

  Left =

  Top =

  Caption = 'MainForm'

  ClientHeight =

  ClientWidth =

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  OnCreate = FormCreate

  OnDestroy = FormDestroy

  PixelsPerInch =

  TextHeight =

  object lstChanges: TListBox

    Left =

    Top =

    Width =

    Height =

    Align = alClient

    ItemHeight =

    TabOrder =

  end

  object pnl1: TPanel

    Left =

    Top =

    Width =

    Height =

    Align = alTop

    TabOrder =

    object pnl2: TPanel

      Left =

      Top =

      Width =

      Height =

      Align = alRight

      BevelOuter = bvNone

      TabOrder =

      object pnl3: TPanel

        Left =

        Top =

        Width =

        Height =

        Align = alRight

        BevelOuter = bvNone

        TabOrder =

        object btnAdd: TButton

          Left =

          Top =

          Width =

          Height =

          Caption = 'Add'

          TabOrder =

          OnClick = btnAddClick

        end

        object btnRemove: TButton

          Left =

          Top =

          Width =

          Height =

          Caption = 'Remove'

          Enabled = False

          TabOrder =

          OnClick = btnRemoveClick

        end

      end

    end

    object pnl4: TPanel

      Left =

      Top =

      Width =

      Height =

      Align = alClient

      BevelOuter = bvNone

      TabOrder =

      object lstDirectoriesListBox: TListBox

        Left =

        Top =

        Width =

        Height =

        Align = alClient

        ItemHeight =

        TabOrder =

      end

      object pnl5: TPanel

        Left =

        Top =

        Width =

        Height =

        Align = alTop

        BevelOuter = bvNone

        TabOrder =

        object lbl1: TLabel

          Left =

          Top =

          Width =

          Height =

          Caption = 'Directories to watch:'

        end

        object chkWatchSubTree: TCheckBox

          Left =

          Top =

          Width =

          Height =   www.2cto.com

          Caption = 'Watch subdirectories'

          Checked = True

          State = cbChecked

          TabOrder =

          OnClick = chkWatchSubTreeClick

        end

      end

    end

  end

end

监控文件夹

const

  SHCNE_RENAMEITEM = $;

  SHCNE_Create = $;

  SHCNE_Delete = $;

  SHCNE_MKDIR = $;

  SHCNE_RMDIR = $;

  SHCNE_MEDIAInsertED = $;

  SHCNE_MEDIAREMOVED = $;

  SHCNE_DRIVEREMOVED = $;

  SHCNE_DRIVEADD = $;

  SHCNE_NETSHARE = $;

  SHCNE_NETUNSHARE = $;

  SHCNE_ATTRIBUTES = $;

  SHCNE_UpdateDIR = $;

  SHCNE_UpdateITEM = $;

  SHCNE_SERVERDISCONNECT = $;

  SHCNE_UpdateIMAGE = $;

  SHCNE_DRIVEADDGUI = $;

  SHCNE_RENAMEFOLDER = $;

  SHCNE_FREESPACE = $;

  SHCNE_ASSOCCHANGED = $;

  SHCNE_DISKEVENTS = $2381F;

  SHCNE_GLOBALEVENTS = $C0581E0;

  SHCNE_ALLEVENTS = $7FFFFFFF;

  SHCNE_INTERRUPT = $;

  SHCNF_IDLIST = ;

  // LPITEMIDLIST

  SHCNF_PATHA = $;

  // path name

  SHCNF_PRINTERA = $;

  // printer friendly name

  SHCNF_DWORD = $;

  // DWORD

  SHCNF_PATHW = $;

  // path name

  SHCNF_PRINTERW = $;

  // printer friendly name

  SHCNF_TYPE = $FF;

  SHCNF_FLUSH = $;

  SHCNF_FLUSHNOWAIT = $;

  SHCNF_PATH = SHCNF_PATHW;

  SHCNF_PRINTER = SHCNF_PRINTERW;

  WM_SHNOTIFY = $;

  NOERROR = ;

type

  TForm1 = class(TForm)

    Button1: TButton;

    Memo1: TMemo;

    procedure Button1Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private

    procedure WMShellReg(var Message: TMessage); message WM_SHNOTIFY;

  public

    { Public declarations }

  end;

type

  PSHNOTIFYSTRUCT = ^SHNOTIFYSTRUCT;

  SHNOTIFYSTRUCT = record

    dwItem1: PItemIDList;

    dwItem2: PItemIDList;

  end;

type

  PSHFileInfoByte = ^SHFileInfoByte;

  _SHFileInfoByte = record

    hIcon: Integer;

    iIcon: Integer;

    dwAttributes: Integer;

    szDisplayName: array [ .. ] of char;

    szTypeName: array [ .. ] of char;

  end;

  SHFileInfoByte = _SHFileInfoByte;

type

  PIDLSTRUCT = ^IDLSTRUCT;

  _IDLSTRUCT = record

    pidl: PItemIDList;

    bWatchSubFolders: Integer;

  end;

  IDLSTRUCT = _IDLSTRUCT;

function SHNotify_Register(hWnd: Integer): Bool;

function SHNotify_UnRegister: Bool;

function SHEventName(strPath1, strPath2: string; lParam: Integer): string;

function SHChangeNotifyDeregister(hNotify: Integer): Integer; stdcall;

external 'Shell32.dll' index ;

function SHChangeNotifyRegister(hWnd, uFlags, dwEventID, uMSG,

  cItems: LongWord; lpps: PIDLSTRUCT): Integer; stdcall;

external 'Shell32.dll' index ;

function SHGetFileInfoPidl(pidl: PItemIDList; dwFileAttributes: Integer;

  psfib: PSHFileInfoByte; cbFileInfo: Integer; uFlags: Integer): Integer;

  stdcall; external 'Shell32.dll' name 'SHGetFileInfoA';

var

  Form1: TForm1;

  m_hSHNotify: Integer;

  m_pidlDesktop: PItemIDList;

implementation

{ uses

  Graphics;

}

{$R *.dfm}

function SHEventName(strPath1, strPath2: string; lParam: Integer): string;

var

  sEvent: string;

begin

  case lParam of // 根据参数设置提示消息

    SHCNE_RENAMEITEM:

      sEvent := '重命名文件' + strPath1 + '为' + strPath2;

    SHCNE_Create:

      sEvent := '建立文件 文件名：' + strPath1;

    SHCNE_Delete:

      sEvent := '删除文件 文件名：' + strPath1;

    SHCNE_MKDIR:

      sEvent := '新建目录 目录名：' + strPath1;

    SHCNE_RMDIR:

      sEvent := '删除目录 目录名：' + strPath1;

    SHCNE_MEDIAInsertED:

      sEvent := strPath1 + '中插入可移动存储介质';

    SHCNE_MEDIAREMOVED:

      sEvent := strPath1 + '中移去可移动存储介质' + strPath1 + ' ' + strPath2;

    SHCNE_DRIVEREMOVED:

      sEvent := '移去驱动器' + strPath1;

    SHCNE_DRIVEADD:

      sEvent := '添加驱动器' + strPath1;

    SHCNE_NETSHARE:

      sEvent := '改变目录' + strPath1 + '的共享属性';

    SHCNE_ATTRIBUTES:

      sEvent := '改变文件目录属性 文件名' + strPath1;

    SHCNE_UpdateDIR:

      sEvent := '更新目录' + strPath1;

    SHCNE_UpdateITEM:

      sEvent := '更新文件 文件名：' + strPath1;

    SHCNE_SERVERDISCONNECT:

      sEvent := '断开与服务器的连接' + strPath1 + ' ' + strPath2;

    SHCNE_UpdateIMAGE:

      sEvent := 'SHCNE_UpdateIMAGE';

    SHCNE_DRIVEADDGUI:

      sEvent := 'SHCNE_DRIVEADDGUI';

    SHCNE_RENAMEFOLDER:

      sEvent := '重命名文件夹' + strPath1 + '为' + strPath2;

    SHCNE_FREESPACE:

      sEvent := '磁盘空间大小改变';

    SHCNE_ASSOCCHANGED:

      sEvent := '改变文件关联';

  else

    sEvent := '未知操作' + IntToStr(lParam);

  end;

  Result := sEvent;

end;

function SHNotify_Register(hWnd: Integer): Bool;

var

  ps: IDLSTRUCT;

begin

{$R-}

  Result := False;

  if m_hSHNotify =  then

  begin

    // 获取桌面文件夹的Pidl

    if SHGetSpecialFolderLocation(, CSIDL_DESKTOP, m_pidlDesktop)

      <> NOERROR then

    begin

      Form1.close;

    end;

    if Boolean(m_pidlDesktop) then

    begin

      ps.bWatchSubFolders := ;

      ps.pidl := m_pidlDesktop;

      // 利用SHChangeNotifyRegister函数注册系统消息处理

      m_hSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE or SHCNF_IDLIST),

        (SHCNE_ALLEVENTS or SHCNE_INTERRUPT), WM_SHNOTIFY, , @ps);

      Result := Boolean(m_hSHNotify); // mmmmmmmm

    end

    else

      // 如果出现错误就使用 CoTaskMemFree函数来释放句柄

      CoTaskMemFree(m_pidlDesktop);

  end;

{$R+ }

end;

function SHNotify_UnRegister: Bool;

begin

  Result := False;

  if Boolean(m_hSHNotify) then

  begin

    // 取消系统消息监视，同时释放桌面的Pidl

    if Boolean(SHChangeNotifyDeregister(m_hSHNotify)) then

    begin

{$R-}

      m_hSHNotify := ;

      CoTaskMemFree(m_pidlDesktop);

      Result := True;

{$R-}

    end;

  end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  m_hSHNotify := ;

  if SHNotify_Register(self.Handle) then

  begin // 注册Shell监视

    ShowMessage('Shell监视程序成功注册');

    Button1.Enabled := False;

  end

  else

    ShowMessage('Shell监视程序注册失败');

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  if Boolean(m_pidlDesktop) then

    SHNotify_UnRegister;

end;

procedure TForm1.WMShellReg(var Message: TMessage);

var

  strPath1, strPath2: string;

  charPath: array [ .. ] of char;

  pidlItem: PSHNOTIFYSTRUCT;

begin

  pidlItem := PSHNOTIFYSTRUCT(Message.wParam);

  // 获得系统消息相关得路径

  SHGetPathFromIDList(pidlItem.dwItem1, charPath);

  strPath1 := charPath;

  SHGetPathFromIDList(pidlItem.dwItem2, charPath);

  strPath2 := charPath;

  Memo1.Lines.Add(SHEventName(strPath1, strPath2, Message.lParam) + chr()

      + chr());

end;

end.

文件监控

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ExtCtrls, shlobj, Activex;

const

  WM_SHNOTIFY = $;

type

  TForm1 = class(TForm)

    Panel1: TPanel;

    Panel2: TPanel;

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    MM: TMemo;

    procedure FormCreate(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

  private { Private declarations }

    procedure WMShellReg(var Message: TMessage); message WM_SHNOTIFY;

  public { Public declarations }

  end;

type

  PIDLSTRUCT = ^IDLSTRUCT;

  _IDLSTRUCT = record

    pidl: PItemIDList;

    bWatchSubFolders: Integer;

  end;

  IDLSTRUCT = _IDLSTRUCT;

type

  PSHNOTIFYSTRUCT = ^SHNOTIFYSTRUCT;

  SHNOTIFYSTRUCT = record

    dwItem1: PItemIDList;

    dwItem2: PItemIDList;

  end;

  // 注册通知消息

function RegSHNotify(hWnd: Integer): Bool;

// 解除通知注册

function UnregSHNotify: Bool;

// 获取消息具体内容

function NotifyReceipt(wParam: wParam; lParam: lParam): string;

// 定义未公开API函数

Function SHChangeNotifyDeregister(hNotify: Integer): Integer; stdcall;

external ' Shell32.dll ' index ;

Function SHChangeNotifyRegister(hWnd, uFlags, dwEventID, uMSG,

  cItems: LongWord; lpps: PIDLSTRUCT): Integer; stdcall;

external ' Shell32.dll ' index ;

var

  Form1: TForm1;

  g_HSHNotify: Integer;

  g_pidlDesktop: PItemIDList;

implementation

{$R *.dfm}

// 获取消息具体内容

function NotifyReceipt(wParam: wParam; lParam: lParam): string;

var

  strEvent: String;

  strPath1, strPath2: String;

  szBuf: array [ .. MAX_PATH] of char;

  pidlItem: PSHNOTIFYSTRUCT;

begin

  pidlItem := PSHNOTIFYSTRUCT(wParam);

  // 获得系统消息相关的路径

  SHGetPathFromIDList(pidlItem.dwItem1, szBuf);

  strPath1 := szBuf;

  SHGetPathFromIDList(pidlItem.dwItem2, szBuf);

  strPath2 := szBuf;

  // 根据参数设置提示消息

  case lParam of

    SHCNE_RENAMEITEM:

      strEvent := ' 重命名文件: ' + strPath1 + ' 为 ' + strPath2;

    SHCNE_CREATE:

      strEvent := ' 建立文件, 文件名: ' + strPath1;

    SHCNE_DELETE:

      strEvent := ' 删除文件, 文件名 ： ' + strPath1;

    SHCNE_MKDIR:

      strEvent := ' 新建目录, 目录名 ： ' + strPath1;

    SHCNE_RMDIR:

      strEvent := ' 删除目录, 目录名 ： ' + strPath1;

    SHCNE_ATTRIBUTES:

      strEvent := ' 改变文件目录属性, 文件名 ： ' + strPath1;

    SHCNE_MEDIAINSERTED:

      strEvent := strPath1 + ' 中插入可移动存储介质 ';

    SHCNE_MEDIAREMOVED:

      strEvent := strPath1 + ' 中移去可移动存储介质 ';

    SHCNE_DRIVEREMOVED:

      strEvent := ' 移去驱动器: ' + strPath1;

    SHCNE_DRIVEADD:

      strEvent := ' 添加驱动器: ' + strPath1;

    SHCNE_NETSHARE:

      strEvent := ' 改变目录 ' + strPath1 + ' 的共享属性 ';

    SHCNE_UPDATEDIR:

      strEvent := ' 更新目录: ' + strPath1;

    SHCNE_UPDATEITEM:

      strEvent := ' 更新文件, 文件名: ' + strPath1;

    SHCNE_SERVERDISCONNECT:

      strEvent := ' 断开与服务器的连接: ' + strPath1 + ' ' + strPath2;

    SHCNE_UPDATEIMAGE:

      strEvent := ' 更新图标: ' + strPath1 + ' ' + strPath2;

    SHCNE_DRIVEADDGUI:

      strEvent := ' 添加并显示驱动器: ' + strPath1;

    SHCNE_RENAMEFOLDER:

      strEvent := ' 重命名文件夹: ' + strPath1 + ' 为 ' + strPath2;

    SHCNE_FREESPACE:

      strEvent := ' 磁盘空间大小改变: ' + strPath1 + ' ' + strPath2;

    SHCNE_ASSOCCHANGED:

      strEvent := ' 改变文件关联 ' + strPath1 + ' ' + strPath2;

  else

    strEvent := ' 其他操作 ' + IntToStr(lParam);

  end;

  Result := strEvent;

end;

// 注册通知消息

function RegSHNotify(hWnd: Integer): Bool;

var

  ps: PIDLSTRUCT;

begin

  Result := False;

  If g_HSHNotify =  then

  begin

    // 取得桌面的IDL

    SHGetSpecialFolderLocation(, CSIDL_DESKTOP

      { CSIDL_DRIVES } , g_pidlDesktop);

    // if SHGetSpecialFolderLocation(0, CSIDL_DESKTOP,g_pidlDesktop)<> NOERROR then

    // Form1.close;

    if Boolean(g_pidlDesktop) then

    begin

      getmem(ps, sizeof(IDLSTRUCT));

      ps.bWatchSubFolders := ;

      ps.pidl := g_pidlDesktop;

      // 注册Windows监视

      g_HSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE Or SHCNF_IDLIST),

        (SHCNE_ALLEVENTS Or SHCNE_INTERRUPT), WM_SHNOTIFY, , ps);

      Result := Boolean(g_HSHNotify);

    end

    else

      // 如果出现错误就使用 CoTaskMemFree函数来释放句柄

      CoTaskMemFree(g_pidlDesktop);

  end;

end;

// 解除通知注册

function UnregSHNotify: Bool;

begin

  Result := False;

  if Boolean(g_HSHNotify) Then

  begin

    // 取消系统消息监视，同时释放桌面的IDL

    if Boolean(SHChangeNotifyDeregister(g_HSHNotify)) Then

    begin

      g_HSHNotify := ;

      CoTaskMemFree(g_pidlDesktop);

      // Boolean(g_pidlDesktop) :=0;

      Result := True;

    end;

  end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  g_HSHNotify := ;

  MM.Lines.Clear;

  if RegSHNotify(Handle) then

  begin

    MM.Lines.Add('开始监视程序-->成功!');

    Button1.Enabled := False;

  end

  else

    MM.Lines.Add('开始监视程序-->失败!');

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

  if Boolean(g_pidlDesktop) then

  begin

    if UnregSHNotify then

    begin

      MM.Lines.Add('停止监视程序-->成功!');

      Button1.Enabled := True;

    end

    else

      MM.Lines.Add('停止监视程序-->失败!');

  end;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

  MessageBox(, '文件监视功能演示' + ## + 'Coded By: hnxyy' + ## +

      'Homepage: http://www.wrsky.com' + ## + 'Contact: QQ:19026695',

    '火狐出品', );

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  // 在程序退出的同时删除监视

  if Boolean(g_pidlDesktop) then

    UnregSHNotify;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  Caption := Application.Title;

end;

procedure TForm1.WMShellReg(var Message: TMessage);

begin

  MM.Lines.Add(NotifyReceipt(Message.wParam, Message.lParam));

  // +chr(13)+chr(10));

end;

end.

秒客网

delphi 文件夹操作（监控）

相关文章