我的主页：http://www.tommstudio.com/

unit Unit2;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, shlobj, activex, StdCtrls, FileCtrl,strUtils;constshcne_renameitem = $1;shcne_create = $2;shcne_delete = $4;shcne_mkdir = $8;shcne_rmdir = $10;shcne_mediainserted = $20;shcne_mediaremoved = $40;shcne_driveremoved = $80;shcne_driveadd = $100;shcne_netshare = $200;shcne_netunshare = $400;shcne_attributes = $800;shcne_updatedir = $1000;shcne_updateitem = $2000;shcne_serverdisconnect = $4000;shcne_updateimage = $8000;shcne_driveaddgui = $10000;shcne_renamefolder = $20000;shcne_freespace = $40000;shcne_assocchanged = $8000000;shcne_diskevents = $2381F;shcne_globalevents = $C0581E0;shcne_allevents = $7FFFFFFF;shcne_interrupt = $80000000;shcnf_idlist = 0; // lpitemidlist shcnf_patha = $1; // path name shcnf_printera = $2; // printer friendly name shcnf_dword = $3; // dword shcnf_pathw = $5; // path name shcnf_printerw = $6; // printer friendly name shcnf_type = $FF;shcnf_flush = $1000;shcnf_flushnowait = $2000;shcnf_path = shcnf_pathw;shcnf_printer = shcnf_printerw;wm_shnotify = $401;noerror = 0;typeTForm1 = class(TForm)Button1: TButton;Memo1: TMemo;DirectoryListBox1: TDirectoryListBox;DriveComboBox1: TDriveComboBox;Label1: TLabel;Button2: TButton;procedure FormClose(Sender: TObject; var Action: TCloseAction);procedure Button1Click(Sender: TObject);procedure Button2Click(Sender: TObject);private{ Private declarations }procedure wmshellreg(var message: tmessage); message wm_shnotify;public{ Public declarations }end;type pshnotifystruct = ^shnotifystruct;shnotifystruct = recorddwitem1: pitemidlist;dwitem2: pitemidlist;end;type pshfileinfobyte = ^shfileinfobyte;_shfileinfobyte = recordhicon: integer;iicon: integer;dwattributes: integer;szdisplayname: array[0..259] of char;sztypename: array[0..79] of char;end;shfileinfobyte = _shfileinfobyte;type pidlstruct = ^idlstruct;_idlstruct = recordpidl: 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';varForm1: TForm1;m_hshnotify: integer;m_pidldesktop: pitemidlist;implementation{$R *.dfm}function sheventname(strpath1, strpath2: string; lparam: integer): string;varsevent: string;begin case lparam of //根据参数设置提示消息 shcne_renameitem: sevent := 'rename' + 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;varps: 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); //系统消息处理函数var strpath1, strpath2: string; charpath: array[0..259] of char; pidlitem: pshnotifystruct; vPath,vFile:string; begin pidlitem := pshnotifystruct(message.wparam); // 获得系统消息相关得路径 shgetpathfromidlist(pidlitem.dwitem1, charpath); strpath1 := charpath; shgetpathfromidlist(pidlitem.dwitem2, charpath); strpath2 := charpath; vPath:=ExtractFilePath(strPath1); vFile:=ExtractFileName(strPath1); if (message.lparam=shcne_create) and (vPath=(Label1.Caption+'\')) then begin // memo1.lines.add(sheventname(strpath1, strpath2, message.lparam) + chr(13) + chr(10)); if not AnsiContainsText(Memo1.Lines.Text,vFile) then memo1.lines.add(vFile); end; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin //在程序退出的同时删除监视 if boolean(m_pidldesktop) then shnotify_unregister; end; procedure TForm1.Button1Click(Sender: TObject); begin Memo1.Clear; m_hshnotify := 0; if shnotify_register(form1.handle) then begin //注册shell监视 showmessage('shell监视程序成功注册'); button1.enabled := false; end else showmessage('shell监视程序注册失败'); end; procedure TForm1.Button2Click(Sender: TObject); var i:integer; begin i:=Memo1.Lines.IndexOf(Memo1.SelText); Memo1.Lines.Delete(i); end; end.