Форум: "Основная";
Текущий архив: 2005.10.23;
Скачать: [xml.tar.bz2];

Вниз

Изменения в директории (появление файла)   Найти похожие ветки 

← →
Chuck Loon   (2005-10-01 15:03) [0]

Как отлавливать изменения в конкретной директории - появление нового файла ?

---

← →
begin...end ©   (2005-10-01 15:09) [1]

1. FindFirstChangeNotification / FindNextChangeNotification / FindCloseChangeNotification
2. ReadDirectoryChangesW (только для NT-систем)

Описания функций см. в справке по API.

---

← →
Джо ©   (2005-10-01 22:22) [2]

Выковырял из старого проекта.

(*
 Класс TDirectorySpy.
 Слежение за изменениями в указанной директории.
 Цикл ожидания работает в отдельном потоке,
 при указанном изменении срабатывает пользовательское событие.
 Автор: Каминский С.
 Последние изменения: 9.01.2003
 ---
 Использование:

   TForm1 = class(TForm)
     Memo1: TMemo;
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
   private
     FSpy: TDirectorySpy;
     procedure OnEvent (Sender: TObject; var ContinueWatching: Boolean);
   public
   end;
   ...
   implementation
   ...
   procedure TForm1.FormCreate(Sender: TObject);
   begin
     FSpy := TDirectorySpy.Create("D:\spy",FILE_NOTIFY_CHANGE_FILE_NAME);
     FSpy.OnEvent := OnEvent;
   end;

   procedure TForm1.FormDestroy(Sender: TObject);
   begin
     FSpy.Free;
   end;

   procedure TForm1.OnEvent(Sender: TObject;
     var ContinueWatching: Boolean);
   begin
     Memo1.Lines.Add("Fired");
     // если слежение больше не нужно с этого момента,
     // устанавливаем ContinueWatching := False;
   end;

   ----
   Константы:

   ChangeType может быть скомбинирован (OR) из следующих значений:
   FILE_NOTIFY_CHANGE_FILE_NAME -
     любое изменение имени файла: переименование, создание, удаление

   FILE_NOTIFY_CHANGE_DIR_NAME -
     любое изменение имени директории: переименование, создание, удаление

   FILE_NOTIFY_CHANGE_ATTRIBUTES -
     любое изменение атрибутов

   FILE_NOTIFY_CHANGE_SIZE -
     изменение размера файла -

   FILE_NOTIFY_CHANGE_LAST_WRITE -
     изменение времени последней записи файла

   FILE_NOTIFY_CHANGE_SECURITY -
     изменения security-descriptor

*)

{$WARN SYMBOL_PLATFORM OFF}

unit FileSpy;

interface
uses Windows, SysUtils, Classes, Dialogs;

type

 TDirectorySpy = class; // forward reference

 // служебный Thread, в котором идет процесс ожидания события
 TWaitThread = class (TThread)
 private
   FWaitHandle: THandle;
   FSpy: TDirectorySpy;
 protected
   procedure Execute; override;
   procedure FireEvent;
 public
   constructor Create (ASpy: TDirectorySpy);
 end;

 TSpyEvent = procedure (Sender: TObject;
   var ContinueWatching: Boolean) of object;

 TDirectorySpy = class
 private
   FDirName: string;
   FHandle: THandle;
   FThread: TThread;
   FChangeType: DWORD;
   FOnEvent: TSpyEvent;
   FWatchSubtree: Boolean;
   procedure OpenDirectory;
   procedure CloseDirectory;
   procedure CreateThread;
   procedure StopThread;
   procedure DestroyThread;
   procedure SetOnEvent(const Value: TSpyEvent);
   procedure DoOnEvent;
 public
   constructor Create (ADirName: string; AChangeType: DWORD;
     AWatchSubTree: Boolean = False);
   destructor Destroy; override;
   {пользовательское событие}
   property OnEvent: TSpyEvent read FOnEvent write SetOnEvent;
 end;

implementation

procedure TDirectorySpy.CloseDirectory;
begin
 if FHandle <> INVALID_HANDLE_VALUE then
   FindCloseChangeNotification(FHandle);
end;

constructor TDirectorySpy.Create(ADirName: string;
 AChangeType: DWORD; AWatchSubTree: Boolean = False);
begin
 inherited Create ;
 FDirName := ADirName;
 FChangeType := DWord(AChangeType);
 FWatchSubtree := AWatchSubTree;

 OpenDirectory;
 CreateThread;
end;

destructor TDirectorySpy.Destroy;
begin
 StopThread;
 DestroyThread;
 CloseDirectory;
 inherited;
end;

procedure TDirectorySpy.DoOnEvent;
var
 ContinueWatching: Boolean;
begin
 if Assigned (FOnEvent) then
 begin
   ContinueWatching := True;
   OnEvent (Self,ContinueWatching);
   if not ContinueWatching then
     StopThread;
 end
end;

procedure TDirectorySpy.OpenDirectory;
begin
 FHandle := FindFirstChangeNotification(
   PChar(FDirName),
   FWatchSubtree,
   FChangeType);

 Win32Check (FHandle <> INVALID_HANDLE_VALUE);
end;

procedure TDirectorySpy.SetOnEvent(const Value: TSpyEvent);
begin
 FOnEvent := Value;
end;

procedure TDirectorySpy.CreateThread;
begin
 FThread := TWaitThread.Create(Self);
 FThread.FreeOnTerminate := False;
 FThread.Resume;
end;

procedure TDirectorySpy.StopThread;
begin
 FThread.Terminate;
end;

{ TWaitThread }

constructor TWaitThread.Create(ASpy: TDirectorySpy);
begin
 inherited Create (True);
 FWaitHandle := ASpy.FHandle;
 FSpy := ASpy;
end;

procedure ContinueWatching;
begin
 // если тайм-аут закончен, опять начинаем слежение
 // на следующей итерации цикла
end;

procedure TWaitThread.Execute;
const
 // не задавать слишком большим, чтобы приложение
 // могло завершаться без видимой задержки
 TIME_OUT = 100;
var
 AStatus: DWORD;
begin
 {
   При ошибках вызовов WaitForSingleObject & FindNextChangeNotification
   исключения НЕ возбуждаются, осуществляется простой выход из процедуры
 }

 while not Terminated do
 begin
   AStatus := WaitForSingleObject(FWaitHandle, TIME_OUT);

   case AStatus of

     WAIT_TIMEOUT:
       ContinueWatching;

     WAIT_OBJECT_0:
       begin
         Synchronize(FireEvent); // вызов пользовательского события
         if not FindNextChangeNotification(FSpy.FHandle) then
           Terminate;
       end;
       
     WAIT_FAILED:
       Terminate;
   end;
 end
end;

procedure TWaitThread.FireEvent;
begin
 FSpy.DoOnEvent
end;

procedure TDirectorySpy.DestroyThread;
begin
 FThread.Free;  
end;

end.



---

← →
Джо ©   (2005-10-01 22:29) [3]

П.С. Только сейчас заметил - из uses можно убрать Dialogs. Видимо, еще от отладки осталось :)

---

← →
Newman   (2005-10-01 22:36) [4]

> Chuck Loon   (01.10.05 15:03)

В Делфи 7 есть стандартный компонент TShellChangeNotifier.

---

← →
Джо ©   (2005-10-01 22:44) [5]

> [2] Джо ©   (01.10.05 22:22)

А, блин... Полезно иногда старые исходники просматривать.

procedure TDirectorySpy.StopThread;
begin
 if Assigned (FThread) then
   FThread.Terminate;
end;


---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.10.23;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.041 c