在Delphi中实现实时监控目录

最新推荐文章于 2026-04-23 02:38:40 发布

原创最新推荐文章于 2026-04-23 02:38:40 发布 · 3k 阅读

2 ·

本内容遵循CC 4.0 BY-SA版权协议

标签

#delphi #warnings #integer #attributes #function

Delphi 专栏收录该内容

5 篇文章

订阅专栏

该博客介绍了如何在Delphi中实现实时监控目录的功能。通过调用Windows API函数SHChangeNotifyRegister和SHChangeNotifyDeregister，监听SHCNF_TYPE或SHCNF_IDLIST类型的SHCNE_ALLEVENTS事件，并在WM_SHNOTIFY消息中处理文件或目录的各种变更，如重命名、创建、删除等。

unit TestNotify;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShlObj, ShellAPI;

const
WM_SHNOTIFY = WM_USER + 10;

type
TFormTestNotify = class(TForm)
    MemoNotifyLog: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
private
    { Private declarations }
    FNotifyHandle: THandle;
    procedure WMSHNOTIFY(var Msg: TMessage); message WM_SHNOTIFY;
public
    { Public declarations }
end;

var
FormTestNotify: TFormTestNotify;

implementation

{$R *.dfm}

type
NOTIFYREGISTER = packed record
pidlPath: PItemIDList;
bWatchSubtree: BOOL;
end;
PNotifyRegister = ^NOTIFYREGISTER;

{$WARNINGS OFF}
function SHChangeNotifyRegister(hWnd: HWND; dwFlags: Integer;
wEventMask: Cardinal; uMsg: UINT; cItems: Integer;
lpItems: PNotifyRegister): HWND; stdcall; external Shell32 index 2;

function SHChangeNotifyDeregister(hWnd: HWND): Boolean; stdcall;
external Shell32 index 4;

function SHILCreateFromPath(pszPath: PChar; ppidl: PItemIDList;
rgflnOut: PDWORD): HResult; stdcall; external Shell32 index 28;
{$WARNINGS ON}

procedure TFormTestNotify.FormCreate(Sender: TObject);
var
vNotifyRegister: NOTIFYREGISTER;
vAttributes: WORD;
vItemIDList: PItemIDList;
begin
SHILCreatefromPath('c:/temp', @vItemIDList, @vAttributes);
vNotifyRegister.pidlPath := vItemIDList;
vNotifyRegister.bWatchSubtree := True;

FNotifyHandle := SHChangeNotifyRegister(Handle,
SHCNF_TYPE or SHCNF_IDLIST,
SHCNE_ALLEVENTS or SHCNE_INTERRUPT, WM_SHNOTIFY, 1, @vNotifyRegister);

MemoNotifyLog.Clear;
end;

procedure TFormTestNotify.FormDestroy(Sender: TObject);
begin
SHChangeNotifyDeregister(FNotifyHandle);
end;

procedure TFormTestNotify.WMSHNOTIFY(var Msg: TMessage);
type
PSHNOTIFYSTRUCT = ^SHNOTIFYSTRUCT;
SHNOTIFYSTRUCT = packed record
    dwItem1: PItemIDList;
    dwItem2: PItemIDList;
end;
var
vBuffer: array[0..MAX_PATH] of Char;
pidlItem: PSHNOTIFYSTRUCT;
S: string;
begin
pidlItem := PSHNOTIFYSTRUCT(Msg.wParam);
SHGetPathFromIDList(pidlItem.dwItem1, vBuffer);
S := vBuffer;
SHGetPathFromIDList(pidlItem.dwItem2, vBuffer);
case Msg.lParam of //根据参数设置提示消息
    SHCNE_RENAMEITEM: S := '重命名文件' + S + '为' + vBuffer;
    SHCNE_CREATE: S := '建立文件文件名：' + S;
    SHCNE_DELETE: S := '删除文件文件名：' + S;
    SHCNE_MKDIR: S := '新建目录目录名：' + S;
    SHCNE_RMDIR: S := '删除目录目录名：' + S;
    SHCNE_MEDIAINSERTED: S := S + '中插入可移动存储介质';
    SHCNE_MEDIAREMOVED: S := S + '中移去可移动存储介质' + S + ' ' + vBuffer;
    SHCNE_DRIVEREMOVED: S := '移去驱动器' + S;
    SHCNE_DRIVEADD: S := '添加驱动器' + S;
    SHCNE_NETSHARE: S := '改变目录' + S + '的共享属性';
    SHCNE_ATTRIBUTES: S := '改变文件目录属性文件名' + S;
    SHCNE_UPDATEDIR: S := '更新目录' + S;
    SHCNE_UPDATEITEM: S := '更新文件文件名：' + S;
    SHCNE_SERVERDISCONNECT: S := '断开与服务器的连接' + S + ' ' + vBuffer;
    SHCNE_UPDATEIMAGE: S := 'SHCNE_UPDATEIMAGE';
    SHCNE_DRIVEADDGUI: S := 'SHCNE_DRIVEADDGUI';
    SHCNE_RENAMEFOLDER: S := '重命名文件夹' + S + '为' + vBuffer;
    SHCNE_FREESPACE: S := '磁盘空间大小改变';
    SHCNE_ASSOCCHANGED: S := '改变文件关联';
else S := '未知操作' + IntToStr(Msg.lParam);
end;
MemoNotifyLog.Lines.Add(S);
end;

end.