winxp下文件夹监视无法检测到内存流输出的文件新建事件
在win7下用delphi XE5 编写文件夹监视程序,在win7下可以检测到内存流输出的文件新建事件,但在winxp下却无法检测到。
在winxp下可以检测到鼠标右键新建文件事件。
程序如下
unit UnitDirMonitor;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Winapi.ShlObj, Winapi.ShellAPI, Vcl.StdCtrls,
Vcl.ExtCtrls, Vcl.Menus, Vcl.ImgList, VCL.FileCtrl;
const
WM_SHNOTIFY = WM_USER + 10;
type
TFormTestNotify = class(TForm)
MemoNotifyLog: TMemo;
Button1: TButton;
TrayIcon1: TTrayIcon;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
ImageList1: TImageList;
Button3: TButton;
N3: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure CreateParams(var Params:TCreateParams);override;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TrayIcon1DblClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure N2Click(Sender: TObject);
procedure Button2Click(Sender: TObject);// 窗体悬浮方案 1
private
{ Private declarations }
FNotifyHandle: THandle;
procedure WMSHNOTIFY(var Msg: TMessage); message WM_SHNOTIFY;
procedure WndProc(var Message: TMessage);override;//窗体磁性吸附
procedure WMsyscommand(var msg: Twmsyscommand);message wm_syscommand;
public
{ Public declarations }
end;
var
FormTestNotify: TFormTestNotify;
Dir:String;
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: PWideChar; ppidl: PItemIDList;
rgflnOut: PDWORD): HResult; stdcall; external Shell32 index 28;
{$WARNINGS ON}
procedure TFormTestNotify.Button2Click(Sender: TObject);
begin
MemoNotifyLog.Clear;
end;
procedure TFormTestNotify.CreateParams(var Params:TCreateParams);
begin
inherited CreateParams(Params);
//去掉窗口标题区
//Params.Style:=Params.Style and WS_CAPTION;
//Params.Style:=Params.Style or WS_POPUP;
//设为总在最上面
Params.ExStyle:=Params.ExStyle or WS_EX_TOPMOST;
//设Windows Owner为Desktop Window,连messagebox都跑到他后面!!
Params.WndParent:=GetDesktopWindow();
end;
procedure TFormTestNotify.WMsyscommand(var msg : Twmsyscommand);
begin
if msg.CmdType = SC_MAXIMIZE then
begin
//showmessage('现在最大化')
end
else if msg.CmdType = SC_MINIMIZE then
begin
FormTestNotify.Hide;
end;
inherited;
end;
procedure TFormTestNotify.WndProc(var Message: TMessage);
var
pos:PWINDOWPOS;
w,h,Rw:integer;//Rd
Gap:integer;
begin
case Message.Msg of
WM_WINDOWPOSCHANGING:begin
w:=screen.width;
h:=screen.height;
Gap:=30;
pos := PWINDOWPOS(Message.LParam);
if (self.Height < h-(Gap*2)-1) then begin //如果窗体的高度小于吸附距离乘以2 则
if(pos^.y<Gap) then
pos^.y := 0;
end;
if (self.Width < w-(Gap*2)-1) then begin //如果窗体的宽度小于吸附距离乘以2 则
if (pos^.x<Gap) then //如果窗体的左边距离小于等于吸附距离
pos^.x := 0;
Rw:=w-(self.Width+pos^.x); //计算窗体右边距离
if (Rw <=Gap) then
pos^.x:=w-self.Width;
end
end;
end;
inherited WndProc(Message);
end;
procedure TFormTestNotify.Button1Click(Sender: TObject);
begin
FormTestNotify.Hide;
end;
procedure TFormTestNotify.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//AnimateWindow(Self.Handle, 500,AW_BLEND or AW_HIDE);//窗体淡出
end;
procedure TFormTestNotify.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
CanClose:=false;
Application.Minimize;
FormTestNotify.hide;
end;
procedure TFormTestNotify.FormCreate(Sender: TObject);
var
vNotifyRegister: NOTIFYREGISTER;
vAttributes: WORD;
vItemIDList: PItemIDList;
begin
if SelectDirectory('Select Directory','',Dir) then
begin
SHILCreatefromPath(PWideChar(Dir), @vItemIDList, @vAttributes); //需将'C:\Temp'强制转换为WideChar类型。
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;
end;
procedure TFormTestNotify.FormShow(Sender: TObject);
begin
AnimateWindow(Self.Handle, 500, AW_BLEND or AW_ACTIVATE); //窗体淡入
//ANimateWindow(Handle,1000,AW_SLIDE+AW_VER_NEGATIVE);
//窗体悬浮方案2
with Application do
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) and
not WS_EX_APPWINDOW or WS_EX_TOOLWINDOW);
SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;
procedure TFormTestNotify.N1Click(Sender: TObject);
begin
FormTestNotify.Show;
end;
procedure TFormTestNotify.N2Click(Sender: TObject);
begin
application.Terminate;
end;
procedure TFormTestNotify.TrayIcon1DblClick(Sender: TObject);
begin
FormTestNotify.Show;
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 := 'Rename File' + S + 'to' + vBuffer;
SHCNE_CREATE:
begin
S := 'Create File:' + S;
end;
SHCNE_DELETE: S := 'Del File:' + S;
SHCNE_MKDIR: S := 'Create Dir:' + S;
SHCNE_RMDIR: S := 'Del Dir' + S;
SHCNE_MEDIAINSERTED: S := S + 'insert Removable Storage Media';
SHCNE_MEDIAREMOVED: S := S + 'Remove Removable Storage Media' + S + ' ' + vBuffer;
SHCNE_DRIVEREMOVED: S := 'Remove Drive' + S;
SHCNE_DRIVEADD: S := 'Add Drive' + S;
SHCNE_NETSHARE: S := 'Change Dir' + S + 'Attribution';
SHCNE_ATTRIBUTES: S := 'Change File Dir Attribution:' + S;
SHCNE_UPDATEDIR: S := 'Update Dir' + S;
SHCNE_UPDATEITEM: S := 'Update File:' + S;
SHCNE_SERVERDISCONNECT: S := 'Disconnect with Server' + S + ' ' + vBuffer;
SHCNE_UPDATEIMAGE: S := 'SHCNE_UPDATEIMAGE';
SHCNE_DRIVEADDGUI: S := 'SHCNE_DRIVEADDGUI';
SHCNE_RENAMEFOLDER: S := 'Rename Dir' + S + '为' + vBuffer;
SHCNE_FREESPACE: S := 'Disk Space Changed';
SHCNE_ASSOCCHANGED: S := 'Change File Link';
else
S := 'Unknown Operation' + IntToStr(Msg.lParam);
end;
MemoNotifyLog.Lines.Add(inttostr(Msg.lParam)+'-'+S);
MemoNotifyLog.SelStart := Length(MemoNotifyLog.Text);
MemoNotifyLog.SelLength:= Length(MemoNotifyLog.Text);//0;
end;
end.