当一个固定文件夹下多了一个文件，怎样让程序立即知道，并作出响应?(77)

在网上Google，结果得到了这样的解答： 当一个固定文件夹下多了一个文件，怎样让程序立即知道，并作出响应！ 主要解答者: zswangII 提交人: hthunter 感谢: sailer_shi、xinshiji、cqbonny、dyzg 审核者: aiirii 社区对应贴子: 查看 A : 当某个固定目录下，多了一个文件，怎样让程序立即知道，并作出响应！最好不要用Ttimer! --------------------------------------------------------------- 回复人： zswangII(伴水清清)(职业清洁工) ( ) 信誉：110 2003-12-29 16:52:28 得分:150 //通过ShellAPI函数来实现比较科学～～ //注册一个事件响应～～ //代码如下～～ Delphi(Pascal) codeunit TestNotify; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ShlObj, ShellAPI; const WM_SHNOTIFY = WM_USER + 10; type TFormTestNotify = class(TForm) MemoNotifyLog: TMemo; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } FNotifyHandle: THandle; procedure WMSHNOTIFY(var Msg: TMessage); message WM_SHNOTIFY; public { Public declarations } end; var FormTestNotify: TFormTestNotify; 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: PChar; ppidl: PItemIDList; rgflnOut: PDWORD): HResult; stdcall; external Shell32 index 28; {$WARNINGS ON} procedure TFormTestNotify.FormCreate(Sender: TObject); var vNotifyRegister: NOTIFYREGISTER; vAttributes: WORD; vItemIDList: PItemIDList; begin SHILCreatefromPath('c:/temp', @vItemIDList, @vAttributes); 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; procedure TFormTestNotify.FormDestroy(Sender: TObject); begin SHChangeNotifyDeregister(FNotifyHandle); 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 := '重命名文件' + S + '为' + vBuffer; SHCNE_CREATE: S := '建立文件 文件名：' + S; SHCNE_DELETE: S := '删除文件 文件名：' + S; SHCNE_MKDIR: S := '新建目录 目录名：' + S; SHCNE_RMDIR: S := '删除目录 目录名：' + S; SHCNE_MEDIAINSERTED: S := S + '中插入可移动存储介质'; SHCNE_MEDIAREMOVED: S := S + '中移去可移动存储介质' + S + ' ' + vBuffer; SHCNE_DRIVEREMOVED: S := '移去驱动器' + S; SHCNE_DRIVEADD: S := '添加驱动器' + S; SHCNE_NETSHARE: S := '改变目录' + S + '的共享属性'; SHCNE_ATTRIBUTES: S := '改变文件目录属性 文件名' + S; SHCNE_UPDATEDIR: S := '更新目录' + S; SHCNE_UPDATEITEM: S := '更新文件 文件名：' + S; SHCNE_SERVERDISCONNECT: S := '断开与服务器的连接' + S + ' ' + vBuffer; SHCNE_UPDATEIMAGE: S := 'SHCNE_UPDATEIMAGE'; SHCNE_DRIVEADDGUI: S := 'SHCNE_DRIVEADDGUI'; SHCNE_RENAMEFOLDER: S := '重命名文件夹' + S + '为' + vBuffer; SHCNE_FREESPACE: S := '磁盘空间大小改变'; SHCNE_ASSOCCHANGED: S := '改变文件关联'; else S := '未知操作' + IntToStr(Msg.lParam); end; MemoNotifyLog.Lines.Add(S); end; end. 这个代码的确可以监视磁盘变化，但是存在的问题是：我希望监视的目录是'c:/temp'，但是代码实际执行的效果是别的目录、甚至别的磁盘驱动器发生了事件也会被监视，这是怎么回事？哪的问题？

一个封装好的控件.Path属性是要监控的路径unit dirnotify;interfaceuses 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;implementationconst 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.

不用想那么麻煩，你可以安裝CnPack，里面有個TCnFileSystemWatcher組件，在其OnChange中寫事件，像這樣（自帶的Demo）：procedure TForm1.CnFileSystemWatcherChange(FileOperation: TFileOperation; const FileName1, FileName2: String);begin case FileOperation of foAdded : Memo1.Lines.Add('Added: ' + FileName1 + '; ' + FileName2); foRemoved : Memo1.Lines.Add('Removed: ' + FileName1 + '; ' + FileName2); foModified : Memo1.Lines.Add('Modified: ' + FileName1 + '; ' + FileName2); foRenamed : Memo1.Lines.Add('Renamed: ' + FileName1 + '; ' + FileName2); end; end;具體實現代碼可以參照控件源碼。