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 [0..259] of char; szTypeName : array [0..79] 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 4; Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;lpps:PIDLSTRUCT):integer;stdcall;external 'Shell32.dll' index 2; 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;
function SHNotify_Register(hWnd : Integer) : Bool; var ps: pidlstruct; begin {$R-} result := false; if m_hshnotify = 0 then begin //获取桌面文件夹的pidl if shgetspecialfolderlocation(0, CSIDL_DESKTOP, m_pidldesktop) <> noerror then form1.close; if boolean(m_pidldesktop) then begin new(ps); try ps.bwatchsubfolders := 1; ps.pidl := m_pidldesktop;
// 利用shchangenotifyregister函数注册系统消息处理 m_hshnotify := shchangenotifyregister(hwnd, (shcnf_type or shcnf_idlist), (shcne_allevents or shcne_interrupt), wm_shnotify, 1, 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 := 0; CoTaskMemFree(m_pidlDesktop); Result := True; {$R-} End; end;
procedure TForm1.WMShellReg(var Message: TMessage); //file://系统消息处理函数 var strPath1,strPath2:String; charPath:array[0..259]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(13)+chr(10)); 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:=0; if SHNotify_Register(Form1.Handle) then begin //file://注册Shell监视 ShowMessage('Shell监视程序成功注册'); Button1.Enabled := False; end else ShowMessage('Shell监视程序注册失败'); end;
function TDyjPlatDirMonitor.RegisterDirMonitor(hWnd: Integer; aPath: string): Boolean; var _vP : PWideChar; _vPs : IDLSTRUCT; begin {$R-} Result := False; if FSHNotify = 0 then begin _vP := PWideChar(WideString(aPath)); FPathPidl := SHSimpleIDListFromPath(_vP); if Boolean(FPathPidl) then begin _vPs.bWatchSubFolders := 1; _vPs.pidl := FPathPidl; FSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE or SHCNF_IDLIST), (SHCNE_ALLEVENTS or SHCNE_INTERRUPT), WM_SHNOTIFY, 1, @_vPs); Result := Boolean(FSHNotify); end else CoTaskMemFree(FPathPidl); end; {$R+ } end;