Вверх ↑
Ответов: 3349
Рейтинг: 233
#1: 2011-02-08 17:01:18 ЛС | профиль | цитата
ntcn
------------ Дoбавленo в 17.00:
unit hiDirectoryChanges;

interface

uses Windows,kol,Share,Debug;

const
FILE_LIST_DIRECTORY = $0001;
const
MAX_THREAD_COUNT = 10;

function ReadDirectoryChanges(hDirectory: THandle; lpBuffer: Pointer;
nBufferLength: DWORD; bWatchSubtree: Bool; dwNotifyFilter: DWORD;
lpBytesReturned: LPDWORD; lpOverlapped: POverlapped;
lpCompletionRoutine: FARPROC): BOOL; stdcall;
external kernel32 name 'ReadDirectoryChangesW';

type
PFileNotifyInformation = ^TFileNotifyInformation;
TFileNotifyInformation = record
NextEntryOffset : DWORD;
Action : DWORD;
FileNameLength : DWORD;
FileName : array[0..0] of WideChar;
end;

// Структура с информацией об изменении в структуре наблюдаемых папок (передается в callback процедуру)

PInfoCallBack = ^TInfoCallBack;
TInfoCallBack = record
FAction : Integer; // тип изменения (константы FILE_ACTION_XXX)
FDrive : string; // диск, на котором было изменение
FOldFileName : string; // имя файла до переименования
FNewFileName : string; // имя файла после переименования
end;

// callback процедура, вызываемая при изменении в структуре наблюдаемых папок
//
TWatchFileSystemCallBack = procedure (pInfo: TInfoCallBack; Tag: DWord);

type
// Собственно, наш HiAsm класс
//
THiDirectoryChanges = class(TDebug)
private
sSubTree : boolean;
WFS : PThread;
FName : string;
FFilter : Cardinal;
FSubTree : boolean;
FInfoCallBack : TWatchFileSystemCallBack;
FWatchHandle : THandle;
FWatchBuf : array[0..4096] of Byte;
FOverLapp : TOverlapped;
FPOverLapp : POverlapped;
FBytesWritte : DWORD;
FCompletionPort : THandle;
IOCP : THandle;
FNumBytes : Cardinal;
FOldFileName : string;
sTag : DWord;
sOldFileName : string;
sNewFileName : string;
procedure StartWatch(pName: string; pFilter: cardinal; pSubTree: boolean; pInfoCallBack: TWatchFileSystemCallBack);
procedure StopWatch;
function CreateDirHandle(aDir: string): THandle;
procedure HandleEvent;
function Execute(Sender:PThread): Integer;
public
_prop_Flags : integer;
_prop_DirName : string;
_event_onError : THI_Event;
_event_onChange : THI_Event;
_data_DirName : THI_Event;
_data_Flags : THI_Event;

property _prop_SubTree:boolean write sSubTree;

destructor Destroy; override;
procedure _work_doStartWatch(var _Data:TData; Index:word);
procedure _work_doStopWatch(var _Data:TData; Index:word);
procedure _work_doSubTree(var _Data:TData; Index:word);
procedure _var_OldFileName(var _Data:TData; Index:word);
procedure _var_NewFileName(var _Data:TData; Index:word);
end;

implementation

// Запуск мониторинга изменений структуры папок
// Праметры:
// pName - имя папки для мониторинга
// pFilter - комбинация констант FILE_NOTIFY_XXX
// pSubTree - мониторить ли все подпапки заданной папки
// pInfoCallBack - адрес callback процедуры, вызываемой при изменении в структуре наблюдаемых папок
//
procedure THiDirectoryChanges.StartWatch(pName: string; pFilter: cardinal; pSubTree: boolean; pInfoCallBack: TWatchFileSystemCallBack);
begin
StopWatch;
sTag := LongInt(Self);
FName := IncludeTrailingChar(pName, '\');
FFilter := pFilter;
FSubTree := pSubTree;
FOldFileName := '';
ZeroMemory(@FOverLapp, SizeOf(TOverLapped));
FPOverLapp:=@FOverLapp;
ZeroMemory(@FWatchBuf, SizeOf(FWatchBuf));
FInfoCallBack := pInfoCallBack;
IOCP := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, MAX_THREAD_COUNT);
WFS := {$ifdef F_P}NewThreadforFPC{$else}NewThread{$endif};
WFS.OnExecute := Execute;
WFS.Resume;
end;

// Остановка мониторинга
//
procedure THiDirectoryChanges.StopWatch;
var Temp : PThread;
begin
if Assigned(WFS) then
begin
PostQueuedCompletionStatus(FCompletionPort, 0, 0, nil);
if Assigned(WFS) then
begin
Temp := WFS;
WFS := nil;
Temp.Terminate;
Temp.WaitFor;
free_and_nil(Temp);
end;
CloseHandle(FWatchHandle);
FWatchHandle := 0;
CloseHandle(FCompletionPort);
FCompletionPort := 0;
CloseHandle(IOCP);
IOCP := 0;
end;
end;

destructor THiDirectoryChanges.Destroy;
begin
StopWatch;
inherited;
end;

function THiDirectoryChanges.CreateDirHandle(aDir: string): THandle;
begin
Result := CreateFile(PChar(aDir), FILE_LIST_DIRECTORY, FILE_SHARE_READ+FILE_SHARE_DELETE+FILE_SHARE_WRITE,
nil,OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED, 0);
end;

function THiDirectoryChanges.Execute;
var CompletionKey: Cardinal;
begin
Result := 0;
FWatchHandle := CreateDirHandle(FName);
FCompletionPort := CreateIoCompletionPort(FWatchHandle, IOCP, Longint(pointer(Self)), 0);
ZeroMemory(@FWatchBuf, SizeOf(FWatchBuf));
if not ReadDirectoryChanges(FWatchHandle, @FWatchBuf, SizeOf(FWatchBuf), FSubTree,
FFilter, @FBytesWritte, @FOverLapp, nil) then
begin
_hi_onEvent(_event_onError, SysErrorMessage(GetLastError));
Sender.Terminate;
end else
begin
while not Sender.Terminated do
begin
GetQueuedCompletionStatus(FCompletionPort, FNumBytes, CompletionKey, FPOverLapp, INFINITE);
if CompletionKey <> 0 then
begin
Sender.Synchronize(HandleEvent);
ZeroMemory(@FWatchBuf, SizeOf(FWatchBuf));
FBytesWritte := 0;
ReadDirectoryChanges(FWatchHandle, @FWatchBuf, SizeOf(FWatchBuf), FSubTree,
FFilter, @FBytesWritte, @FOverLapp, nil);
end else Sender.Terminate;
end;
end;
end;

procedure THiDirectoryChanges.HandleEvent;
var FileNotifyInfo : PFileNotifyInformation;
InfoCallBack : TInfoCallBack;
Offset : Longint;
begin
Pointer(FileNotifyInfo) := @FWatchBuf[0];
repeat
Offset:=FileNotifyInfo^.NextEntryOffset;
InfoCallBack.FAction := FileNotifyInfo^.Action;
InfoCallBack.FDrive := FName;
InfoCallBack.FNewFileName := WideCharToString(@(FileNotifyInfo^.FileName[0]));
InfoCallBack.FNewFileName := Trim(InfoCallBack.FNewFileName);
case FileNotifyInfo^.Action of
FILE_ACTION_RENAMED_OLD_NAME: FOldFileName := Trim(WideCharToString(@(FileNotifyInfo^.FileName[0])));
FILE_ACTION_RENAMED_NEW_NAME: InfoCallBack.FOldFileName := FOldFileName;
end;
FInfoCallBack(InfoCallBack, sTag);
PChar(FileNotifyInfo) := PChar(FileNotifyInfo) + Offset;
until (Offset=0) or WFS.Terminated or (WFS = nil);
end;

procedure MyInfoCallBack(pInfo: TInfoCallBack; Tag: DWord);
var Self: THiDirectoryChanges;
begin
Self := THiDirectoryChanges(Tag);
Self.sOldFileName := '';
Self.sNewFileName := '';
if pInfo.FAction = FILE_ACTION_RENAMED_OLD_NAME then exit;
Self.sNewFileName := pInfo.FDrive + pInfo.FNewFileName;
if pInfo.FAction = FILE_ACTION_RENAMED_NEW_NAME then
Self.sOldFileName := pInfo.FDrive + pInfo.FOldFileName;
_hi_onEvent(Self._event_onChange, pInfo.FAction);
end;

{
FILE_ACTION_ADDED = $00000001;//создание
FILE_ACTION_REMOVED = $00000002;//удаление
FILE_ACTION_MODIFIED = $00000003;//изменение
FILE_ACTION_RENAMED_OLD_NAME = $00000004;//старое имя файла
FILE_ACTION_RENAMED_NEW_NAME = $00000005;//новое имя файла

FILE_NOTIFY_CHANGE_FILE_NAME = $00000001; //изменение имени файла
FILE_NOTIFY_CHANGE_DIR_NAME = $00000002; //изменение имени папки
FILE_NOTIFY_CHANGE_ATTRIBUTES = $00000004; //изменение атрибутов файла
FILE_NOTIFY_CHANGE_SIZE = $00000008; //изменение размера
FILE_NOTIFY_CHANGE_LAST_WRITE = $00000010; //изменение времени последней записи
FILE_NOTIFY_CHANGE_LAST_ACCESS = $00000020; //изменение времени последнего доступа
FILE_NOTIFY_CHANGE_CREATION = $00000040; //изменение времени создания
FILE_NOTIFY_CHANGE_SECURITY = $00000100; //изменение прав доступа
}

procedure THiDirectoryChanges._work_doStartWatch;
var _Flags: Cardinal;
_DirName: string;
begin
_DirName := ReadString(_Data, _data_DirName, _prop_DirName);
_Flags := ReadInteger(_Data, _data_Flags, _prop_Flags);
if _Flags = 0 then exit;
StartWatch(_DirName, _Flags, sSubTree, @MyInfoCallBack);
end;

procedure THiDirectoryChanges._work_doStopWatch;
begin
StopWatch;
end;

procedure THiDirectoryChanges._work_doSubTree;
begin
sSubTree := ReadBool(_Data);
end;

procedure THiDirectoryChanges._var_OldFileName;
begin
dtString(_Data, sOldFileName);
end;

procedure THiDirectoryChanges._var_NewFileName;
begin
dtString(_Data, sNewFileName);
end;

end.


------------ Дoбавленo в 17.01:
10 c
карма: 1

0