Delphi 实时的监控一个目录
2012-11-28 16:51
411 查看
http://hi.baidu.com/t810509/item/ac0b0a978f6c984df1421582
在WIN32下用DELPHI侦测目录变化，可用WIN32提供的文件改变通知API来完成。FindFirstChangeNotification, FindNextChangeNotification，FindCloseChangeNotification。
在应用程序中调用这些函数时，产生一个监控这个变化的句柄，可用WAIT函数集来等待这个变化。这样，当监控程序运行时，可以达到监控文件变化的动作。更进一步，可把此程序做成一个状态区图标（TRAY）来完成监控。
Windows在删除、复制、移动、访问文件时并不发送消息，当然截获不到。要截取这些操作过程的唯一办法就是截获API，这又需要你编写Vxd程序了，杀毒软件都是这样作的。你注意一下杀毒软件一般都带有一个vxd程序。光有vxd还不行，还需截获文件API。还有另外一个办法，就是CIH病毒采用的办法，直接跳到系统零层去操作。具体办法如下：
一、SIDT指令（ 将中断描述符表寄存器IDTR－－64位宽，16～47Bit存有中断描述符表IDT基地址－－的内容存入指定地址单元）不是特权指令，就是说我们可以在Ring3下执行该指令，获得IDT的基地址，从而修改IDT，增加一个中断门安置我们的中断服务，一旦Ring3程序中产生此中断，VMM就会调用此中断服务程序，而此中断服务程序就运行在Ring0下了。这一点与在DOS下非常相似。
二、要实现对系统中所有文件I/O操作的实时监视，还要用到另一种关键技－FileHooking，通过挂接一个处理函数，截获所有与文件I/O操作有关的系 统调用。Windows9x使用32位保护模式可安装文件系统(IFS)，由可安装文件系统管理器(IFSManager)协调对文件系统和设备的访问，它接收以Win32API函数调用形式向系统发出的文件I/O请求，再将请求转给文件系统驱动程序FSD，由它调用低级别的IOS系统实现最终访问。每个文件I/OAPI调用都有一个特定的FSD函数与之对应，IFSManager负责完成由API到FSD的参数装配工作，在完成文件I/OAPI函数参数的装配之后转相应FSD执行之前，它会调用一个称为FileSystemApiHookFunction的Hooker函数。通过安装自己的Hooker函数，就可以截获系统内所有对文件I/O的API调用，从而实现实时监控。
=========================================
procedure TForm1.Button2Click(Sender: TObject);
begin
{establish a notification for file name changes on the selected directory}
NotificationHandle := FindFirstChangeNotification(PChar(DirectoryListBox1.Directory), FALSE,FILE_NOTIFY_CHANGE_FILE_NAME);
{if the notification was set up correctly, modify some UI elements...}
if (NotificationHandle <> INVALID_HANDLE_VALUE) then
begin
Button1.Enabled := TRUE;
Button2.Enabled := FALSE;
end
else
begin
{...otherwise indicate that there was an error}
ShowMessage('There was an error setting the notification');
Exit;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
dwResult: DWORD; // holds the result of waiting on the notification
Waiting: Boolean; // loop control variable
begin
{setup the loop control for a continuous loop}
Waiting := TRUE;
{indicate that the application is waiting for the change notification to fire}
Button1.Enabled := FALSE;
StatusBar1.SimpleText := 'Now waiting for a filename change';
Application.ProcessMessages;
{enter the loop}
while Waiting do
begin
{at this point, the application is suspended until the notification
object is signaled that a filename change has occured in the
selected directory (this includes file deletions)}
dwResult := WaitForSingleObject(NotificationHandle,INFINITE);
if (dwResult = WAIT_OBJECT_0) then
begin
{indicate that the notification object was signaled}
ShowMessage('The selected directory signaled a filename change');
{query the user to see if they wish to continue monitoring this
directory}
if Application.MessageBox('Do you wish to continue monitoring this directory?', 'Continue?', MB_ICONQUESTION or
MB_YESNO) = IDYES then
{if the user wishes to continue monitoring the directory, reset
the notification object and continue the loop...}
FindNextChangeNotification(NotificationHandle)
else
{...otherwise break out of the loop}
Waiting := FALSE;
end;
end;
{close the notification object}
FindCloseChangeNotification(NotificationHandle);
{reset UI elements}
Button1.Enabled := FALSE;
Button2.Enabled := TRUE;
StatusBar1.SimpleText := '';
FileListBox1.Update;
end;
===========================================
下面是一个监视的控件：
unit dirnotify;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs;
type
EDirNotificationError = class(Exception);
TDirNotify = class;
TNotifyFilter = (nfFileName, nfDirName, nfAttributes, nfSize, nfLastWrite,
nfSecurity);
TNotifyFilters = set of TNotifyFilter;
TNotificationThread = class(TThread)
Owner: TDirNotify;
procedure Execute; override;
procedure DoChange;
end;
TDirNotify = class(TComponent)
private
FEnabled: Boolean;
FOnChange: TNotifyEvent;
FNotificationThread: TNotificationThread;
FPath: String;
FWatchSubTree: Boolean;
FFilter: TNotifyFilters;
procedure SetEnabled( Value: Boolean );
procedure SetOnChange( Value: TNotifyEvent );
procedure SetPath( Value: String );
procedure SetWatchSubTree( Value: Boolean );
procedure SetFilter( Value: TNotifyFilters );
procedure RecreateThread;
protected
procedure Change;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Enabled: Boolean read FEnabled write SetEnabled default True;
property OnChange: TNotifyEvent read FOnChange write SetOnChange;
property Path: String read FPath write SetPath;
property WatchSubTree: Boolean read FWatchSubTree write SetWatchSubTree;
property Filter: TNotifyFilters read FFilter write SetFilter default [nfFileName, nfDirName, nfAttributes, nfLastWrite, nfSecurity];
end;
procedure Register;
implementation
const
LASTERRORTEXTLENGTH = 500;
var
LastErrorText: array [0..LASTERRORTEXTLENGTH] of char;
function GetLastErrorText: PChar;
begin
FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM,
nil, GetLastError, 0, LastErrorText, LASTERRORTEXTLENGTH, nil );
Result := LastErrorText;
end;
procedure TNotificationThread.Execute;
var
h: THandle;
nf: Longint;
wst: LongBool;
begin
nf := 0;
if (nfFileName in Owner.Filter) then nf := FILE_NOTIFY_CHANGE_FILE_NAME;
if (nfDirName in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_DIR_NAME;
if (nfAttributes in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_ATTRIBUTES;
if (nfSize in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_SIZE;
if (nfLastWrite in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_LAST_WRITE;
if (nfSecurity in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_SECURITY;
// yeahh, this one is stupid but Win98 malfunctions in any other value than 0 or 1
if Owner.FWatchSubTree then wst := Longbool(1)
else wst := Longbool(0);
h := FindFirstChangeNotification( Pointer(Owner.Path), wst, nf );
if (h = INVALID_HANDLE_VALUE) then
raise EDirNotificationError.Create( GetLastErrorText );
repeat
if (WaitForSingleObject( h, 1000 ) = WAIT_OBJECT_0) then
begin
Synchronize(DoChange);
if not FindNextChangeNotification( h ) then
raise EDirNotificationError.Create( GetLastErrorText );
end;
until Terminated;
end;
procedure TNotificationThread.DoChange;
begin
Owner.Change;
end;
constructor TDirNotify.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEnabled := True;
FFilter := [nfFileName];
end;
destructor TDirNotify.Destroy;
begin
FNotificationThread.Free;
inherited Destroy;
end;
procedure TDirNotify.Loaded;
begin
inherited;
RecreateThread;
end;
procedure TDirNotify.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
RecreateThread;
end;
end;
procedure TDirNotify.SetPath( Value: String );
begin
if Value <> FPath then
begin
FPath := Value;
RecreateThread;
end;
end;
procedure TDirNotify.SetWatchSubTree( Value: Boolean );
begin
if Value <> FWatchSubTree then
begin
FWatchSubTree := Value;
RecreateThread;
end;
end;
procedure TDirNotify.SetFilter( Value: TNotifyFilters );
begin
if Value <> FFilter then
begin
FFilter := Value;
RecreateThread;
end;
end;
procedure TDirNotify.SetOnChange(Value: TNotifyEvent);
begin
FOnChange := Value;
end;
procedure TDirNotify.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TDirNotify.RecreateThread;
begin
// destroy thread
FNotificationThread.Free;
FNotificationThread := nil;
if FEnabled and not(csDesigning in ComponentState)
and not(csLoading in ComponentState) and (FPath <> '') then
begin
// create thread
FNotificationThread := TNotificationThread.Create(True);
FNotificationThread.Owner := self;
FNotificationThread.Resume;
end;
end;
procedure Register;
begin
RegisterComponents('System', [TDirNotify]);
end;
end.
在WIN32下用DELPHI侦测目录变化，可用WIN32提供的文件改变通知API来完成。FindFirstChangeNotification, FindNextChangeNotification，FindCloseChangeNotification。
在应用程序中调用这些函数时，产生一个监控这个变化的句柄，可用WAIT函数集来等待这个变化。这样，当监控程序运行时，可以达到监控文件变化的动作。更进一步，可把此程序做成一个状态区图标（TRAY）来完成监控。
Windows在删除、复制、移动、访问文件时并不发送消息，当然截获不到。要截取这些操作过程的唯一办法就是截获API，这又需要你编写Vxd程序了，杀毒软件都是这样作的。你注意一下杀毒软件一般都带有一个vxd程序。光有vxd还不行，还需截获文件API。还有另外一个办法，就是CIH病毒采用的办法，直接跳到系统零层去操作。具体办法如下：
一、SIDT指令（ 将中断描述符表寄存器IDTR－－64位宽，16～47Bit存有中断描述符表IDT基地址－－的内容存入指定地址单元）不是特权指令，就是说我们可以在Ring3下执行该指令，获得IDT的基地址，从而修改IDT，增加一个中断门安置我们的中断服务，一旦Ring3程序中产生此中断，VMM就会调用此中断服务程序，而此中断服务程序就运行在Ring0下了。这一点与在DOS下非常相似。
二、要实现对系统中所有文件I/O操作的实时监视，还要用到另一种关键技－FileHooking，通过挂接一个处理函数，截获所有与文件I/O操作有关的系 统调用。Windows9x使用32位保护模式可安装文件系统(IFS)，由可安装文件系统管理器(IFSManager)协调对文件系统和设备的访问，它接收以Win32API函数调用形式向系统发出的文件I/O请求，再将请求转给文件系统驱动程序FSD，由它调用低级别的IOS系统实现最终访问。每个文件I/OAPI调用都有一个特定的FSD函数与之对应，IFSManager负责完成由API到FSD的参数装配工作，在完成文件I/OAPI函数参数的装配之后转相应FSD执行之前，它会调用一个称为FileSystemApiHookFunction的Hooker函数。通过安装自己的Hooker函数，就可以截获系统内所有对文件I/O的API调用，从而实现实时监控。
=========================================
procedure TForm1.Button2Click(Sender: TObject);
begin
{establish a notification for file name changes on the selected directory}
NotificationHandle := FindFirstChangeNotification(PChar(DirectoryListBox1.Directory), FALSE,FILE_NOTIFY_CHANGE_FILE_NAME);
{if the notification was set up correctly, modify some UI elements...}
if (NotificationHandle <> INVALID_HANDLE_VALUE) then
begin
Button1.Enabled := TRUE;
Button2.Enabled := FALSE;
end
else
begin
{...otherwise indicate that there was an error}
ShowMessage('There was an error setting the notification');
Exit;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
dwResult: DWORD; // holds the result of waiting on the notification
Waiting: Boolean; // loop control variable
begin
{setup the loop control for a continuous loop}
Waiting := TRUE;
{indicate that the application is waiting for the change notification to fire}
Button1.Enabled := FALSE;
StatusBar1.SimpleText := 'Now waiting for a filename change';
Application.ProcessMessages;
{enter the loop}
while Waiting do
begin
{at this point, the application is suspended until the notification
object is signaled that a filename change has occured in the
selected directory (this includes file deletions)}
dwResult := WaitForSingleObject(NotificationHandle,INFINITE);
if (dwResult = WAIT_OBJECT_0) then
begin
{indicate that the notification object was signaled}
ShowMessage('The selected directory signaled a filename change');
{query the user to see if they wish to continue monitoring this
directory}
if Application.MessageBox('Do you wish to continue monitoring this directory?', 'Continue?', MB_ICONQUESTION or
MB_YESNO) = IDYES then
{if the user wishes to continue monitoring the directory, reset
the notification object and continue the loop...}
FindNextChangeNotification(NotificationHandle)
else
{...otherwise break out of the loop}
Waiting := FALSE;
end;
end;
{close the notification object}
FindCloseChangeNotification(NotificationHandle);
{reset UI elements}
Button1.Enabled := FALSE;
Button2.Enabled := TRUE;
StatusBar1.SimpleText := '';
FileListBox1.Update;
end;
===========================================
下面是一个监视的控件：
unit dirnotify;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs;
type
EDirNotificationError = class(Exception);
TDirNotify = class;
TNotifyFilter = (nfFileName, nfDirName, nfAttributes, nfSize, nfLastWrite,
nfSecurity);
TNotifyFilters = set of TNotifyFilter;
TNotificationThread = class(TThread)
Owner: TDirNotify;
procedure Execute; override;
procedure DoChange;
end;
TDirNotify = class(TComponent)
private
FEnabled: Boolean;
FOnChange: TNotifyEvent;
FNotificationThread: TNotificationThread;
FPath: String;
FWatchSubTree: Boolean;
FFilter: TNotifyFilters;
procedure SetEnabled( Value: Boolean );
procedure SetOnChange( Value: TNotifyEvent );
procedure SetPath( Value: String );
procedure SetWatchSubTree( Value: Boolean );
procedure SetFilter( Value: TNotifyFilters );
procedure RecreateThread;
protected
procedure Change;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Enabled: Boolean read FEnabled write SetEnabled default True;
property OnChange: TNotifyEvent read FOnChange write SetOnChange;
property Path: String read FPath write SetPath;
property WatchSubTree: Boolean read FWatchSubTree write SetWatchSubTree;
property Filter: TNotifyFilters read FFilter write SetFilter default [nfFileName, nfDirName, nfAttributes, nfLastWrite, nfSecurity];
end;
procedure Register;
implementation
const
LASTERRORTEXTLENGTH = 500;
var
LastErrorText: array [0..LASTERRORTEXTLENGTH] of char;
function GetLastErrorText: PChar;
begin
FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM,
nil, GetLastError, 0, LastErrorText, LASTERRORTEXTLENGTH, nil );
Result := LastErrorText;
end;
procedure TNotificationThread.Execute;
var
h: THandle;
nf: Longint;
wst: LongBool;
begin
nf := 0;
if (nfFileName in Owner.Filter) then nf := FILE_NOTIFY_CHANGE_FILE_NAME;
if (nfDirName in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_DIR_NAME;
if (nfAttributes in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_ATTRIBUTES;
if (nfSize in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_SIZE;
if (nfLastWrite in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_LAST_WRITE;
if (nfSecurity in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_SECURITY;
// yeahh, this one is stupid but Win98 malfunctions in any other value than 0 or 1
if Owner.FWatchSubTree then wst := Longbool(1)
else wst := Longbool(0);
h := FindFirstChangeNotification( Pointer(Owner.Path), wst, nf );
if (h = INVALID_HANDLE_VALUE) then
raise EDirNotificationError.Create( GetLastErrorText );
repeat
if (WaitForSingleObject( h, 1000 ) = WAIT_OBJECT_0) then
begin
Synchronize(DoChange);
if not FindNextChangeNotification( h ) then
raise EDirNotificationError.Create( GetLastErrorText );
end;
until Terminated;
end;
procedure TNotificationThread.DoChange;
begin
Owner.Change;
end;
constructor TDirNotify.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEnabled := True;
FFilter := [nfFileName];
end;
destructor TDirNotify.Destroy;
begin
FNotificationThread.Free;
inherited Destroy;
end;
procedure TDirNotify.Loaded;
begin
inherited;
RecreateThread;
end;
procedure TDirNotify.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
RecreateThread;
end;
end;
procedure TDirNotify.SetPath( Value: String );
begin
if Value <> FPath then
begin
FPath := Value;
RecreateThread;
end;
end;
procedure TDirNotify.SetWatchSubTree( Value: Boolean );
begin
if Value <> FWatchSubTree then
begin
FWatchSubTree := Value;
RecreateThread;
end;
end;
procedure TDirNotify.SetFilter( Value: TNotifyFilters );
begin
if Value <> FFilter then
begin
FFilter := Value;
RecreateThread;
end;
end;
procedure TDirNotify.SetOnChange(Value: TNotifyEvent);
begin
FOnChange := Value;
end;
procedure TDirNotify.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TDirNotify.RecreateThread;
begin
// destroy thread
FNotificationThread.Free;
FNotificationThread := nil;
if FEnabled and not(csDesigning in ComponentState)
and not(csLoading in ComponentState) and (FPath <> '') then
begin
// create thread
FNotificationThread := TNotificationThread.Create(True);
FNotificationThread.Owner := self;
FNotificationThread.Resume;
end;
end;
procedure Register;
begin
RegisterComponents('System', [TDirNotify]);
end;
end.
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- 在Delphi中实现实时监控目录
- 实时的监控一个目录
- 实时的监控一个目录
- inotifywait 是一个可以实时监控文件变动的工具
- C＃实现对文件目录的实时监控
- Flume实时抽取监控目录数据
- 用python 10min手写一个简易的实时内存监控系统
- 如何得到一个指定目录下的所有文件名 [Thanks:Delphi On Me,terry_lzs,panyongze]
- Delphi 删除或清空一个目录(包含多级)
- 用python 10min手写一个简易的实时内存监控系统
- 每天一个小练习--监控网卡实时流量
- 使用jQuery图表插件Sparklines来开发一个实用的网站PV(page view)实时监控应用
- android 里的receiver 就像一个实时监控 总线数据，或者消息（intent）队列的东西，回调函数类似
- 一个得到目录对话框的函数【Delphi】
- [转]用python 10min手写一个简易的实时内存监控系统
- 使用jQuery图表插件Sparklines来开发一个实用的网站PV(page view)实时监控应用
- 一个监控LINUX目录和文件变化的Shell脚本分享
- inotify结合rsync监控目录的实时变化
- 写一个实时监控网络流量的脚本
- 分布式日志收集框架Flume：监控一个文件实时采集新增的数据输出到控制台