Z
zqw0117
Unregistered / Unconfirmed
GUEST, unregistred user!
内问涉及的关键字（写上这些方便以后大家在离线数据包中搜索）：
Delphi深度探索
ShellChangeNotifier
ShellNotify
源码
PItemIDList
WindowsME
Activex
SHChangeNotifyRegister
SHChangeNotifyDeregister
SHGetFileInfoPidl
感谢小雨哥的帮助，一点分数不成敬意，请笑纳。（本来准备多给点分的，但是今天收到小雨哥的回信说：“另外，你知道，分数我已经不少了，开贴别出太高的分，意思意思就可以了(比如 1 分)”，所以我尊重小雨哥的意见，正如小雨哥所说“都是 DFW 中人，没有什么大虾存在，有的只是象兄弟一样的感觉”）
我在Email中向小雨哥请教了有关《Delphi深度探索》中一个检测系统通知消息的控件错误的问题，得到小雨哥的耐心解答，并受到小雨哥的启发和指点，在此向小雨哥表示感谢，并公开我们的邮件内容，和各位富翁分享。
************************************************************************************************
小雨哥，您好！
我是DFW论坛上的zqw0117，......现在小弟遇到一个问题，想再次向您请教。......您知道Delphi深度探索这本书吧，里面有一个控件，是一个ShellNotify的检测控件，可以检测硬盘文件修改、重命名的操作等。当初买了这本书之后，虽然看到这个例子，但当时用不上所以也就没有实际研究它，当然，也有一个相信的原因，毕竟是书上的例子，而且写成了控件，应该不会有问题的。可是，最近需要写一个检测某个文件的程序时，重新拿出来这个控件一试，结果是内存读写错误！最后程序不得不退出。......我试着跟踪了控件的运行步骤，发现了产生错误的位置，代码如下：
//kbShellNotify.pas 文件
......
//第334行代码：
if (SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT) then
//由于我是ME操作系统，所以这行判断之后，程序跳到348行执行：
else begin
EventId := DWORD(TheMessage.lParam);
PIDLs := PTwoPIDLArray(TheMessage.wParam);
Self.ProcessEvent(EventID, PIDLs);
end; {else}
......
//问题出在 Self.ProcessEvent 处。书上说，9x系统传递进来的两个Message的参数(lParam、wParam)就是EventId和PIDLs的指针，对于9x系统，只要直接使用他们就可以了。于是这里，代码跳到ProcessEvent方法里面，但只要代码执行第一行的：
procedure TkbShellNotify.ProcessEvent(EventID: DWORD; PIDLs: PTwoPIDLArray);
var
EventType: TkbShellNotifyEventType;
PIDL1: PItemIDList;
PIDL2: PItemIDList;
Path1: TFileName;
Path2: TFileName;
IsInterrupt: Boolean;
begin
{Crack open the PIDL array.}
PIDL1 := PIDLs.PIDL1; //这里是第一行
PIDL2 := PIDLs.PIDL2;
.....
程序就会报告非法操作！如果程序在IDE下调试执行，Delphi也会出错，进而一起退出！
我测试控件自带的例子，同样是这个问题。我怀疑书上没有说道什么重要的东西，或者这个代码可能漏掉了什么，或者真正的9x系统下的实现方法根本不是这样！我实在没有办法了，只好请教您，麻烦您百忙之中帮我看看原因在哪里，唉，郁闷死了！
......
此致
敬礼！
=====================================================================
zqw0117 ，
由于时间不多，匆忙回信如下：
这个通知消息应该没有问题，确实是这么使用的。我附带给你的附件，
就是直接使用这个函数的 Demo ，并且已经在 Windows98 和 Window
2000 中成功编译并运行。WindowsME 是一个特殊的操作系统，它本身
既不是 98 也不是 NT ，资料也比较少。 这种没有公开的专门函数，
不建议在 ME 下执行，当然，你可以试试我带来的 EXE 文件，如果注
册消息失败，会在标题上显示出来的。如果也碰到了内存错误，那显
然是表示 ME 里，不能使用这个函数。......
祝，，，顺利。 小雨哥 11.9
=====================================================================
小雨哥,您好！
来信收到。谢谢您的指教。您的例子我这里运行了，效果很好，能够监视。刚刚测试了一下修改文件名、目录名的操作，程序有反应。不过奇怪的是，为什么当我选择资源管理器的“复制”按钮，然后再在同目录下点击粘贴按钮，程序却没有告知文件被复制，而是下面的提示：
磁盘空间大小改变
建立文件 文件名：C:/2003小青蛙网站精华集/复件 2003小青 蛙网站精华集.chm
磁盘空间大小改变
不过这个问题应该也不是很重要。
......
此致
敬礼！
=====================================================================
OK！
终于有时间检查你你寄来的例子了，结果在 Windows 98 下内存读错误，不能工作。
这，是否表示 哈巴狗 那本“深度..”书里提供的内容是错误的？我没有那本书，
所以不好下结论。至少对 98 那部分是需要修改的。
这次你信里提到的现象，是正常的。按下“复制”本身没有对文件做出改变，也没
有对磁盘进行操作，直到你按下“粘贴”为止。由于是同目录拷贝，所以 Windows
自动将它重命名，这时真正的文件复制才开始，并同时改变磁盘大小，监视程序指
出这个情况，表示它运行良好。
************************************************************************************************
上面便是小弟和小雨哥的邮件。由于小弟说话有点罗嗦（呵呵，不够精练，反正朋友都这么说我的），所以我用“......”省略了一些不重要的内容。
下面是小雨哥给我的例子的源码，下列源码版权属于小雨哥所有，如有转载，请注明是DFW上的小雨哥的代码！
//frmShell.pas 文件内容
unit frmShell;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
shlobj, Activex, StdCtrls;
const
SHCNE_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;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
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[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;
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
Result := False;
ps:=AllocMem(SizeOf(IDLSTRUCT));
if m_hSHNotify = 0 then
begin
if SHGetSpecialFolderLocation(0, CSIDL_DESKTOP,
m_pidlDesktop) <> NOERROR then
Form1.close;
if Boolean(m_pidlDesktop) then begin
ps.bWatchSubFolders := 1;
ps.pidl := m_pidlDesktop;
// 注册消息处理
m_hSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE or SHCNF_IDLIST),
(SHCNE_ALLEVENTS or SHCNE_INTERRUPT),
WM_SHNOTIFY, 1, ps);
Result := Boolean(m_hSHNotify);
end
else
CoTaskMemFree(m_pidlDesktop); // 如果错误就释放
end;
FreeMem(ps);
end;
function SHNotify_UnRegister: Bool;
begin
Result := False;
if Boolean(m_hSHNotify) then
if Boolean(SHChangeNotifyDeregister(m_hSHNotify)) then begin
m_hSHNotify := 0;
CoTaskMemFree(m_pidlDesktop);
Result := True;
end;
end;
procedure TForm1.WMShellReg(var Message: TMessage); //系统消息处理函数
var
strPath1, strPath2: string;
charPath: array[0..259] 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(13) + chr(10));
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Boolean(m_pidlDesktop) then SHNotify_Unregister;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
m_hSHNotify := 0;
if SHNotify_Register(Form1.Handle) then
Caption:=Caption+' （监视中）'
else
Caption:=Caption+' （不能在这个系统中使用）';
end;
end.
//frmShell.dfm 文件内容
object Form1: TForm1
Left = 300
Top = 182
Width = 452
Height = 184
Caption = 'Shell 消息监视 -- Demo'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 12
object Memo1: TMemo
Left = 0
Top = 0
Width = 444
Height = 157
Align = alClient
Color = clInfoBk
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
ParentFont = False
ScrollBars = ssVertical
TabOrder = 0
WordWrap = False
end
end
Delphi深度探索
ShellChangeNotifier
ShellNotify
源码
PItemIDList
WindowsME
Activex
SHChangeNotifyRegister
SHChangeNotifyDeregister
SHGetFileInfoPidl
感谢小雨哥的帮助，一点分数不成敬意，请笑纳。（本来准备多给点分的，但是今天收到小雨哥的回信说：“另外，你知道，分数我已经不少了，开贴别出太高的分，意思意思就可以了(比如 1 分)”，所以我尊重小雨哥的意见，正如小雨哥所说“都是 DFW 中人，没有什么大虾存在，有的只是象兄弟一样的感觉”）
我在Email中向小雨哥请教了有关《Delphi深度探索》中一个检测系统通知消息的控件错误的问题，得到小雨哥的耐心解答，并受到小雨哥的启发和指点，在此向小雨哥表示感谢，并公开我们的邮件内容，和各位富翁分享。
************************************************************************************************
小雨哥，您好！
我是DFW论坛上的zqw0117，......现在小弟遇到一个问题，想再次向您请教。......您知道Delphi深度探索这本书吧，里面有一个控件，是一个ShellNotify的检测控件，可以检测硬盘文件修改、重命名的操作等。当初买了这本书之后，虽然看到这个例子，但当时用不上所以也就没有实际研究它，当然，也有一个相信的原因，毕竟是书上的例子，而且写成了控件，应该不会有问题的。可是，最近需要写一个检测某个文件的程序时，重新拿出来这个控件一试，结果是内存读写错误！最后程序不得不退出。......我试着跟踪了控件的运行步骤，发现了产生错误的位置，代码如下：
//kbShellNotify.pas 文件
......
//第334行代码：
if (SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT) then
//由于我是ME操作系统，所以这行判断之后，程序跳到348行执行：
else begin
EventId := DWORD(TheMessage.lParam);
PIDLs := PTwoPIDLArray(TheMessage.wParam);
Self.ProcessEvent(EventID, PIDLs);
end; {else}
......
//问题出在 Self.ProcessEvent 处。书上说，9x系统传递进来的两个Message的参数(lParam、wParam)就是EventId和PIDLs的指针，对于9x系统，只要直接使用他们就可以了。于是这里，代码跳到ProcessEvent方法里面，但只要代码执行第一行的：
procedure TkbShellNotify.ProcessEvent(EventID: DWORD; PIDLs: PTwoPIDLArray);
var
EventType: TkbShellNotifyEventType;
PIDL1: PItemIDList;
PIDL2: PItemIDList;
Path1: TFileName;
Path2: TFileName;
IsInterrupt: Boolean;
begin
{Crack open the PIDL array.}
PIDL1 := PIDLs.PIDL1; //这里是第一行
PIDL2 := PIDLs.PIDL2;
.....
程序就会报告非法操作！如果程序在IDE下调试执行，Delphi也会出错，进而一起退出！
我测试控件自带的例子，同样是这个问题。我怀疑书上没有说道什么重要的东西，或者这个代码可能漏掉了什么，或者真正的9x系统下的实现方法根本不是这样！我实在没有办法了，只好请教您，麻烦您百忙之中帮我看看原因在哪里，唉，郁闷死了！
......
此致
敬礼！
=====================================================================
zqw0117 ，
由于时间不多，匆忙回信如下：
这个通知消息应该没有问题，确实是这么使用的。我附带给你的附件，
就是直接使用这个函数的 Demo ，并且已经在 Windows98 和 Window
2000 中成功编译并运行。WindowsME 是一个特殊的操作系统，它本身
既不是 98 也不是 NT ，资料也比较少。 这种没有公开的专门函数，
不建议在 ME 下执行，当然，你可以试试我带来的 EXE 文件，如果注
册消息失败，会在标题上显示出来的。如果也碰到了内存错误，那显
然是表示 ME 里，不能使用这个函数。......
祝，，，顺利。 小雨哥 11.9
=====================================================================
小雨哥,您好！
来信收到。谢谢您的指教。您的例子我这里运行了，效果很好，能够监视。刚刚测试了一下修改文件名、目录名的操作，程序有反应。不过奇怪的是，为什么当我选择资源管理器的“复制”按钮，然后再在同目录下点击粘贴按钮，程序却没有告知文件被复制，而是下面的提示：
磁盘空间大小改变
建立文件 文件名：C:/2003小青蛙网站精华集/复件 2003小青 蛙网站精华集.chm
磁盘空间大小改变
不过这个问题应该也不是很重要。
......
此致
敬礼！
=====================================================================
OK！
终于有时间检查你你寄来的例子了，结果在 Windows 98 下内存读错误，不能工作。
这，是否表示 哈巴狗 那本“深度..”书里提供的内容是错误的？我没有那本书，
所以不好下结论。至少对 98 那部分是需要修改的。
这次你信里提到的现象，是正常的。按下“复制”本身没有对文件做出改变，也没
有对磁盘进行操作，直到你按下“粘贴”为止。由于是同目录拷贝，所以 Windows
自动将它重命名，这时真正的文件复制才开始，并同时改变磁盘大小，监视程序指
出这个情况，表示它运行良好。
************************************************************************************************
上面便是小弟和小雨哥的邮件。由于小弟说话有点罗嗦（呵呵，不够精练，反正朋友都这么说我的），所以我用“......”省略了一些不重要的内容。
下面是小雨哥给我的例子的源码，下列源码版权属于小雨哥所有，如有转载，请注明是DFW上的小雨哥的代码！
//frmShell.pas 文件内容
unit frmShell;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
shlobj, Activex, StdCtrls;
const
SHCNE_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;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
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[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;
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
Result := False;
ps:=AllocMem(SizeOf(IDLSTRUCT));
if m_hSHNotify = 0 then
begin
if SHGetSpecialFolderLocation(0, CSIDL_DESKTOP,
m_pidlDesktop) <> NOERROR then
Form1.close;
if Boolean(m_pidlDesktop) then begin
ps.bWatchSubFolders := 1;
ps.pidl := m_pidlDesktop;
// 注册消息处理
m_hSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE or SHCNF_IDLIST),
(SHCNE_ALLEVENTS or SHCNE_INTERRUPT),
WM_SHNOTIFY, 1, ps);
Result := Boolean(m_hSHNotify);
end
else
CoTaskMemFree(m_pidlDesktop); // 如果错误就释放
end;
FreeMem(ps);
end;
function SHNotify_UnRegister: Bool;
begin
Result := False;
if Boolean(m_hSHNotify) then
if Boolean(SHChangeNotifyDeregister(m_hSHNotify)) then begin
m_hSHNotify := 0;
CoTaskMemFree(m_pidlDesktop);
Result := True;
end;
end;
procedure TForm1.WMShellReg(var Message: TMessage); //系统消息处理函数
var
strPath1, strPath2: string;
charPath: array[0..259] 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(13) + chr(10));
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Boolean(m_pidlDesktop) then SHNotify_Unregister;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
m_hSHNotify := 0;
if SHNotify_Register(Form1.Handle) then
Caption:=Caption+' （监视中）'
else
Caption:=Caption+' （不能在这个系统中使用）';
end;
end.
//frmShell.dfm 文件内容
object Form1: TForm1
Left = 300
Top = 182
Width = 452
Height = 184
Caption = 'Shell 消息监视 -- Demo'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 12
object Memo1: TMemo
Left = 0
Top = 0
Width = 444
Height = 157
Align = alClient
Color = clInfoBk
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
ParentFont = False
ScrollBars = ssVertical
TabOrder = 0
WordWrap = False
end
end