有没有办法感知一个目录内增加或者减少文件？(100分)

silicon · 2001-11-29

这个问题好象有点烦？

tianhf · 2001-11-29

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Component:    TDirMon Description:  This component encapsulate the Win 32 API function               FindFirstChangeNotification. The primary purpose of this component               is to monitor changes in a given directory and fire an event               when a change occurs (file creation, deletion, ...). Version:      1.00 Created:      March 27, 1997 Author:       Fran&ccedil;ois PIETTE Email:        francois.piette@ping.be  http://www.rtfm.be/fpiette               francois.piette@f2202.n293.z2.fidonet.org               2:293/2202@fidonet.org, BBS +32-4-3651395 Support:      Please ask your question in the following newsgroup:               news://forums.borland.com/borland.public.delphi.vcl.components.using Legal issues: Copyright (C) 1997 by Fran&ccedil;ois PIETTE <francois.piette@ping.be>               This software is provided 'as-is', without any express or               implied warranty.  In no event will the author be held liable               for any  damages arising from the use of this software.               Permission is granted to anyone to use this software for any               purpose, including commercial applications, and to alter it               and redistribute it freely, subject to the following               restrictions:               1. The origin of this software must not be misrepresented,                  you must not claim that you wrote the original software.                  If you use this software in a product, an acknowledgment                  in the product documentation would be appreciated but is                  not required.               2. Altered source versions must be plainly marked as such, and                  must not be misrepresented as being the original software.               3. This notice may not be removed or altered from any source                  distribution. Modification History: Aug 07, 1997 V1.0 Added some comments  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} unit DirMon; interface uses     Windows,     SysUtils,     Messages,     Classes,     Graphics,     Controls,     Forms,     Dialogs,     Menus; const   WM_DIRCHANGE= WM_USER + 1; type     TDirMonValue = (dmcFileName,                     dmcDirName,                     dmcAttributes,                     dmcSize,                     dmcLastWrite,                     dmcSecurity);     TDirMonType = set of TDirMonValue;     TDirMon = class(TComponent)     private         FDirectory    : String;         FNotifyFilter : DWORD;         FWindowHandle : HWND;         FParamPtr     : Pointer;         FMutexHandle  : THandle;         FThreadHandle : THandle;         FThreadID     : DWORD;         FOnDirChange  : TNotifyEvent;         FOnStart      : TNotifyEvent;         FOnStop       : TNotifyEvent;         procedure WndProc(var MsgRec: TMessage);         procedure WMDirChange(var aMsg: TMessage); message WM_DIRCHANGE;     protected         procedure SetNotifyFilter(newValue : TDirMonType);         function  GetNotifyFilter : TDirMonType;         procedure SetDirectory(newValue : String);         procedure TriggerDirChangeEvent; virtual;         procedure TriggerStartEvent; virtual;         procedure TriggerStopEvent; virtual;     public         constructor Create(AOwner : TComponent); override;         destructor  Destroy; override;         procedure   Start;         procedure   Stop;     published         { Published properties and events }         property Directory : String             read  FDirectory                                                 write SetDirectory;         property NotifyFilter : TDirMonType read  GetNotifyFilter                                                 write SetNotifyFilter;         property OnDirChange : TNotifyEvent     read  FOnDirChange                                                 write FOnDirChange;         property Handle : HWND                  read  FWindowHandle;         property OnStart : TNotifyEvent read FOnStart write FOnStart;         property OnStop : TNotifyEvent read FOnStop write FOnStop;     end; procedure Register; implementation type   TDirMonParams = record       WindowHandle : HWND;       hMutex       : THandle;       Directory    : array [0..255] of char;       NotifyFilter : DWORD;   end;   PDirMonParams = ^TDirMonParams; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure Register; begin     RegisterComponents('FPiette', [TDirMon]); end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure TDirMon.SetDirectory(newValue : String); begin     if newValue = FDirectory then         Exit;     if FThreadHandle <> 0 then         raise Exception.Create('Unable to change Directory ' +                                'when DirMon is running');     FDirectory := newValue; end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure TDirMon.SetNotifyFilter(newValue : TDirMonType); begin     if FThreadHandle <> 0 then         raise Exception.Create('Unable to change NotifyFilter ' +                                'when DirMon is running');     FNotifyFilter := 0;     if dmcFileName in newValue then         FNotifyFilter := (FNotifyFilter or FILE_NOTIFY_CHANGE_FILE_NAME);     if dmcDirName in newValue then         FNotifyFilter := (FNotifyFilter or FILE_NOTIFY_CHANGE_DIR_NAME);     if dmcAttributes in newValue then         FNotifyFilter := (FNotifyFilter or FILE_NOTIFY_CHANGE_ATTRIBUTES);     if dmcSize in newValue then         FNotifyFilter := (FNotifyFilter or FILE_NOTIFY_CHANGE_SIZE);     if dmcLastWrite in newValue then         FNotifyFilter := (FNotifyFilter or FILE_NOTIFY_CHANGE_LAST_WRITE);     if dmcSecurity in newValue then         FNotifyFilter := (FNotifyFilter or FILE_NOTIFY_CHANGE_SECURITY); end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} function TDirMon.GetNotifyFilter : TDirMonType; begin     Result := [];     if (FNotifyFilter and FILE_NOTIFY_CHANGE_FILE_NAME) <> 0 then         Result := Result + [dmcFileName];     if (FNotifyFilter and FILE_NOTIFY_CHANGE_DIR_NAME) <> 0 then         Result := Result + [dmcDirName];     if (FNotifyFilter and FILE_NOTIFY_CHANGE_ATTRIBUTES) <> 0 then         Result := Result + [dmcAttributes];     if (FNotifyFilter and FILE_NOTIFY_CHANGE_SIZE) <> 0 then         Result := Result + [dmcSize];     if (FNotifyFilter and FILE_NOTIFY_CHANGE_LAST_WRITE) <> 0 then         Result := Result + [dmcLastWrite];     if (FNotifyFilter and FILE_NOTIFY_CHANGE_SECURITY) <> 0 then         Result := Result + [dmcSecurity]; end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure TDirMon.TriggerDirChangeEvent; begin     if assigned(FOnDirChange) then begin         try             FOnDirChange(Self);         except         end;     end; end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure TDirMon.TriggerStartEvent; begin     if assigned(FOnStart) then         FOnStart(Self); end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure TDirMon.TriggerStopEvent; begin     if assigned(FOnStop) then         FOnStop(Self); end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} constructor TDirMon.Create(AOwner : TComponent); begin     inherited Create(AOwner);     FWindowHandle := AllocateHWnd(WndProc);     FNotifyFilter := FILE_NOTIFY_CHANGE_FILE_NAME; end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} destructor TDirMon.Destroy; begin     if FThreadHandle <> 0 then begin         ReleaseMutex(FMutexHandle);         WaitForSingleObject(FThreadHandle, INFINITE);     end;     if FParamPtr <> nil then begin         FreeMem(FParamPtr);         FParamPtr := nil;     end;     if FMutexHandle <> 0 then begin         CloseHandle(FMutexHandle);         FMutexHandle := 0;     end;     DeallocateHWnd(FWindowHandle);     inherited Destroy; end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure TDirMon.WndProc(var MsgRec: TMessage); begin      with MsgRec do begin          if Msg = WM_DIRCHANGE then              WMDirChange(MsgRec)          else              Result := DefWindowProc(Handle, Msg, wParam, lParam);     end; end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure TDirMon.WMDirChange(var aMsg: TMessage); begin     TriggerDirChangeEvent; end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} function MonitorThread(Prm : Pointer) : DWORD; stdcall; var     Hdl          : THandle;     Status       : DWORD;     pParams      : PDirMonParams;     hObjects     : array [0..1] of THandle; begin     if Prm = nil then         ExitThread(1);     pParams := PDirMonParams(Prm);     Hdl := FindFirstChangeNotification(pParams^.Directory,                                        FALSE,                                        pParams^.NotifyFilter);     if Hdl = INVALID_HANDLE_VALUE then begin         Application.MessageBox('FindFirstChangeNotification() failed',                                'Warning', mb_OK);         ExitThread(GetLastError);     end;     while (TRUE) do begin         hObjects[0] := Hdl;         hObjects[1] := pParams.hMutex;         Status      := WaitForMultipleObjects(2, @hObjects, FALSE, INFINITE);         if Status = WAIT_OBJECT_0 then begin             PostMessage(pParams^.WindowHandle, WM_DIRCHANGE, 0, 0);             if not FindNextChangeNotification(Hdl) then begin                 FindCloseChangeNotification(Hdl);                 ExitThread(GetLastError);             end;         end;         if Status = (WAIT_OBJECT_0 + 1) then begin             FindCloseChangeNotification(Hdl);             ReleaseMutex(pParams.hMutex);             ExitThread(0);         end;     end; end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure TDirMon.Start; var     p : PDirMonParams; begin     if FThreadHandle <> 0 then         raise Exception.Create('DirMon already started');     // Create mutex for stopping thread when needed     FMutexHandle := CreateMutex(nil, TRUE, nil);     if FMutexHandle = 0 then         raise Exception.Create('CreateMutex failed');     // Allocate some memory for thread parameters     GetMem(p, SizeOf(TDirMonParams));     FParamPtr       := p;     p^.WindowHandle := FWindowHandle;     p^.hMutex       := FMutexHandle;     p^.NotifyFilter := FNotifyFilter;     StrCopy(p^.Directory, PChar(FDirectory));     // Start the working thread     FThreadHandle := CreateThread(                nil,              // pointer to thread security attributes                0,              // initial thread stack size, in bytes                @MonitorThread,        // pointer to thread function                FParamPtr,             // argument for new thread                0,                // creation flags                FThreadId);      // pointer to returned thread identifier     if FThreadHandle = 0 then         raise Exception.Create('CreateThread failed');     TriggerStartEvent; end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure TDirMon.Stop; begin     if FThreadHandle = 0 then         raise Exception.Create('DirMon not started');     if FMutexHandle <> 0 then         ReleaseMutex(FMutexHandle);     if FThreadHandle <> 0 then begin         WaitForSingleObject(FThreadHandle, INFINITE);         FThreadHandle := 0;         FThreadID     := 0;     end;     if FMutexHandle <> 0 then begin         CloseHandle(FMutexHandle);         FMutexHandle := 0;     end;     if FParamPtr <> nil then begin         FreeMem(FParamPtr);         FParamPtr := nil;     end;     TriggerStopEvent; end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} end. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

tianhf · 2001-11-29

使用这个目录监控控件即可.

silicon · 2001-12-04

！TKS

有没有办法感知一个目录内增加或者减少文件？(100分)

silicon

Unregistered / Unconfirmed

tianhf

Unregistered / Unconfirmed

tianhf

Unregistered / Unconfirmed

silicon

Unregistered / Unconfirmed

Similar threads