目录监视，很急，大家来看看(100分)

zjxxln · 2002-01-11

我有一个目录，远端机器随时向这个目录写文件，我需要实时监视这个目录， 一旦有文件写入，我就将文件读入数据库并转发出去。 在2000下好像可以用文件通知函数来完成，但是我现在是在98下， 大家有没有好的解决办法?

zw84611 · 2002-01-11

对文件夹的监视，你看看这个例子： http://www.vclxx.org/DELPHI/D32SAMPL/DIRMON.ZIP 挺管用的。

zjxxln · 2002-01-11

这个例子在2000下运行很好，但是在98下不行。

zw84611 · 2002-01-11

你参考一下这个帖子呢。 http://www.delphibbs.com/delphibbs/dispq.asp?lid=840658

zjxxln · 2002-01-11

我看了这些例子，但是他们都只能用在2000下， 98下不能用。

zw84611 · 2002-01-11

win98下可能要用VXD了，自己写太困难。。。。 这个地方倒是有： http://www.alfaunits.co.yu/ 但是要购买，看一下价格 Alfa File Monitor Alfa File Monitor DevSource license. Provides components for Delphi and Library for MSVC++ to develop applications with Alfa File Monitor. Price US$499.95 Alfa File Monitor VxdSource license. Provides DevSource license plus source code for the VXD driver. Price US$1999.95 Alfa File Monitor SysSource license. Provides DevSource license plus source code for the SYS driver. Price US$3499.95 Alfa File Monitor MILSource license. Provides DevSource license, VXD source, SYS source code and AFM Service source code. Price US$4,999.95 太黑了！！！

zw84611 · 2002-01-11

看一下这个地方： http://www.torry.net/notification.htm

zjxxln · 2002-01-11

价格实在是高，确实黑。 我现在想了个笨办法，我先把待监视的目录e:/1/内的文件全部放在另外一个目录e:/下， 然后，定义一个定时器，在定时器中：   {String ff;   String f;   TSearchRec sr;   if (FindFirst("e://1//*.*", faReadOnly||faHidden||faSysFile||faDirectory||faArchive , sr) == 0)   { f="e://1//"+sr.Name;    ff="e://"+sr.Name;    MoveFileEx(f.c_str(),ff.c_str(),MOVEFILE_REPLACE_EXISTING);    执行我需要的其他操作；   } FindClose(sr); } 大家有没有比这更好的办法？

OopsWare · 2002-01-11

Delphi的Samples页的TShellChangeNotifier就是用来监视目录中文件操作的。 简单到了不用动脑子！！！！

zjxxln · 2002-01-11

to OopsWare:   是d6吧，我现在是d5,好像只可在2000下用。 to zw84611:   这个例子我下了，也是只在2000下用。

daiqingbo · 2002-01-11

不要这么执著了，不就装一台2000吗，肯定比找答案快[

]

OopsWare · 2002-01-11

D4也可以的，由 Shell32.dll 导出一份 TLB, 里面就有此控件了。

yyanghhong · 2002-01-11

all of ways above only demonstrate how to get the message when a file be copyed into, or delete, eg, TShellChangeNotifier http://www.vclxx.org/DELPHI/D32SAMPL/DIRMON.ZIP but if this file is large, how can we know when the process of copy or move is ended.

xfecczgh · 2002-01-13

procedure TForm1.Button1Click(Sender: TObject); var   Dir

Char;   re

WORD;   ProHandle:THandle; begin   re:=1;   Dir:='D:/';   //FindFirstChangeNotification函数创建一个进程，监视目录的变化   ProHandle:=FindFirstChangeNotification(Dir,false,     FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_SIZE);   //创建不成功   if ProHandle=INVALID_HANDLE_VALUE then   begin     beep;     ShowMessage(SysErrorMessage(GetLastError));     exit;   end;   //如目录确实发生变化，退出   while re<>0 do   begin     //监视前面进程执行情况，re=0表示前面的进程退出，即目录有变化     re:=WaitForSingleObject(ProHandle,100);     Application.ProcessMessages();   end;   ShowMessage('当前目录发生改变');   //循环监视目录的变化情况   while true do   begin     re:=1;     //重新执行前面定义的进程     FindNextChangeNotification(ProHandle);     while re<>0 do     begin       re:=WaitForSingleObject(ProHandle,100);       Application.ProcessMessages();     end;     ShowMessage('当前目录发生改变');   end; end; //上面的程序用到死循环，虽然能够使用，但容易死机， //最好用线程改造一下，你自己动动手

vine · 2002-01-12

一篇文章，望对你有用！ 在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.

zjxxln · 2002-03-14

多人接受答案了。

目录监视，很急，大家来看看(100分)

zjxxln

Unregistered / Unconfirmed

zw84611

Unregistered / Unconfirmed

zjxxln

Unregistered / Unconfirmed

zw84611

Unregistered / Unconfirmed

zjxxln

Unregistered / Unconfirmed

zw84611

Unregistered / Unconfirmed

zw84611

Unregistered / Unconfirmed

zjxxln

Unregistered / Unconfirmed

OopsWare

Unregistered / Unconfirmed

zjxxln

Unregistered / Unconfirmed

daiqingbo

Unregistered / Unconfirmed

OopsWare

Unregistered / Unconfirmed

yyanghhong

Unregistered / Unconfirmed

xfecczgh

Unregistered / Unconfirmed

vine

Unregistered / Unconfirmed

zjxxln

Unregistered / Unconfirmed

Similar threads