Форум: "Основная";
Текущий архив: 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