Отслеживание действий Windows

[yw64]

Доброе время суток! Подскажите, как отслеживать изменения (создание, переименование, удаление и т.д. файлов и директорий на ВСЕХ дисках?

 

[yw64]

Спасибо, конечно. Но мне бы исходник на Delphi, а не использовать сторонние программы.По одному диску я могу шерстить действия. Другое дело, когда дисков несколько. Вот тут то я голову и сломал :bac:. Может есть что попроще? Использую DirLogger:=TDDirLogThread.Create(False);

 

[ONIM]

Реализация через поток

Спойлер

unit wfsU;

interface

type

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

PInfoCallback = ^TInfoCallback;

TInfoCallback = record

FAction : Integer; // тип изменения (константы FILE_ACTION_XXX)

FDrive : string; // диск, на котором было изменение

FOldFileName : string; // имя файла до переименования

FNewFileName : string; // имя файла после переименования

end;

// callback процедура, вызываемая при изменении в файловой системе

TWatchFileSystemCallback = procedure (pInfo: TInfoCallback);

{ Запуск мониторинга файловой системы

Праметры:

pName - имя папки для мониторинга

pFilter - комбинация констант FILE_NOTIFY_XXX

pSubTree - мониторить ли все подпапки заданной папки

pInfoCallback - адрес callback процедуры, вызываемой при изменении в файловой системе}

procedure StartWatch(pName: string; pFilter: cardinal; pSubTree: boolean; pInfoCallback: TWatchFileSystemCallback);

// Остановка мониторинга

procedure StopWatch;

implementation

uses

Classes, Windows, SysUtils;

const

FILE_LIST_DIRECTORY = $0001;

type

PFileNotifyInformation = ^TFileNotifyInformation;

TFileNotifyInformation = record

NextEntryOffset : DWORD;

Action : DWORD;

FileNameLength : DWORD;

FileName : array[0..0] of WideChar;

end;

WFSError = class(Exception);

TWFS = class(TThread)

private

FName : string;

FFilter : Cardinal;

FSubTree : boolean;

FInfoCallback : TWatchFileSystemCallback;

FWatchHandle : THandle;

FWatchBuf : array[0..4096] of Byte;

FOverLapp : TOverlapped;

FPOverLapp : POverlapped;

FBytesWritte : DWORD;

FCompletionPort : THandle;

FNumBytes : Cardinal;

FOldFileName : string;

function CreateDirHandle(aDir: string): THandle;

procedure WatchEvent;

procedure HandleEvent;

protected

procedure Execute; override;

public

constructor Create(pName: string; pFilter: cardinal; pSubTree: boolean; pInfoCallback: TWatchFileSystemCallback);

destructor Destroy; override;

end;

var

WFS : TWFS;

procedure StartWatch(pName: string; pFilter: cardinal; pSubTree: boolean; pInfoCallback: TWatchFileSystemCallback);

begin

WFS:=TWFS.Create(pName, pFilter, pSubTree, pInfoCallback);

end;

procedure StopWatch;

var

Temp : TWFS;

begin

if Assigned(WFS) then

begin

PostQueuedCompletionStatus(WFS.FCompletionPort, 0, 0, nil);

Temp := WFS;

WFS:=nil;

Temp.Terminate;

end;

end;

constructor TWFS.Create(pName: string; pFilter: cardinal; pSubTree: boolean; pInfoCallback: TWatchFileSystemCallback);

begin

inherited Create(True);

FreeOnTerminate:=True;

FName:=IncludeTrailingBackslash(pName);

FFilter:=pFilter;

FSubTree:=pSubTree;

FOldFileName:=EmptyStr;

ZeroMemory(@FOverLapp, SizeOf(TOverLapped));

FPOverLapp:=@FOverLapp;

ZeroMemory(@FWatchBuf, SizeOf(FWatchBuf));

FInfoCallback:=pInfoCallback;

Resume

end;

destructor TWFS.Destroy;

begin

PostQueuedCompletionStatus(FCompletionPort, 0, 0, nil);

CloseHandle(FWatchHandle);

FWatchHandle:=0;

CloseHandle(FCompletionPort);

FCompletionPort:=0;

inherited Destroy;

end;

function TWFS.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;

procedure TWFS.Execute;

begin

FWatchHandle:=CreateDirHandle(FName);

WatchEvent;

end;

procedure TWFS.HandleEvent;

var

FileNotifyInfo : PFileNotifyInformation;

InfoCallback : TInfoCallback;

Offset : Longint;

begin

Pointer(FileNotifyInfo) := @FWatchBuf[0];

repeat

Offset:=FileNotifyInfo^.NextEntryOffset;

InfoCallback.FAction:=FileNotifyInfo^.Action;

InfoCallback.FDrive:=FName;

SetString(InfoCallback.FNewFileName,FileNotifyInfo^.FileName,FileNotifyInfo^.FileNameLength);

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);

PChar(FileNotifyInfo):=PChar(FileNotifyInfo)+Offset;

until (Offset=0) or Terminated;

end;

procedure TWFS.WatchEvent;

var

CompletionKey: Cardinal;

begin

FCompletionPort:=CreateIoCompletionPort(FWatchHandle, 0, Longint(pointer(self)), 0);

ZeroMemory(@FWatchBuf, SizeOf(FWatchBuf));

if not ReadDirectoryChanges(FWatchHandle, @FWatchBuf, SizeOf(FWatchBuf), FSubTree,

FFilter, @FBytesWritte, @FOverLapp, nil) then

begin

raise WFSError.Create(SysErrorMessage(GetLastError));

Terminate;

end else

begin

while not Terminated do

begin

GetQueuedCompletionStatus(FCompletionPort, FNumBytes, CompletionKey, FPOverLapp, INFINITE);

if CompletionKey<>0 then

begin

Synchronize(HandleEvent);

ZeroMemory(@FWatchBuf, SizeOf(FWatchBuf));

FBytesWritte:=0;

ReadDirectoryChanges(FWatchHandle, @FWatchBuf, SizeOf(FWatchBuf), FSubTree, FFilter,
@FBytesWritte, @FOverLapp, nil);

end else Terminate;

end

end

end;

end.

Пример использования

Спойлер

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Memo1: TMemo;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

uses wfsU;

procedure MyInfoCallback(pInfo: TInfoCallback);

const

Action: array[1..3] of String = ('Создание: %s', 'Удаление: %s', 'Изменение: %s');

begin

case pInfo.FAction of

FILE_ACTION_RENAMED_NEW_NAME: Form1.Memo1.Lines.Add(Format('Переименование: %s в %s',

[pInfo.FDrive+pInfo.FOldFileName,pInfo.FDrive+pInfo.FNewFileName]));

else

if pInfo.FAction<FILE_ACTION_RENAMED_OLD_NAME then

Form1.Memo1.Lines.Add(Format(Action[pInfo.Faction], [pInfo.FDrive+pInfo.FNewFileName]));

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

// мониторим, например, изменения всех папок на диске C: (создание, удаление, переименование)

StartWatch('C:\', FILE_NOTIFY_CHANGE_DIR_NAME, True, @MyInfoCallback);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

StopWatch

end;

end.

PS: код не мой, сам не проверял, но как основа по данному вопросу, думаю, вполне сгодится.

 

[yw64]

Спасибо за поддержку.
Но по строке видно, что должен шерститься только диск C.
// мониторим, например, изменения всех папок на диске C: (создание, удаление, переименование)
StartWatch('C:\', FILE_NOTIFY_CHANGE_DIR_NAME, True, @MyInfoCallback);

А мне надо, чтобы еще отслеживались диск D,E,F ... Z.
У меня Delphi5. Скомпилировал - не пашет.;(

 

[makssimka]

Спасибо за поддержку.
Но по строке видно, что должен шерститься только диск C.
// мониторим, например, изменения всех папок на диске C: (создание, удаление, переименование)
StartWatch('C:\', FILE_NOTIFY_CHANGE_DIR_NAME, True, @MyInfoCallback);

А мне надо, чтобы еще отслеживались диск D,E,F ... Z.
У меня Delphi5. Скомпилировал - не пашет.;(

Это всего лишь пример.
Ну вызови для всех дисков ее.

 

[yw64]

Ну вызови для всех дисков ее.

Пробовал. Берёт последний по списку диск.Это надо где то внутри процедуры менять. Вот только где? Похоже, что хожу где то с ответом. :bac:

 

[ONIM]

yw64, для каждого диска надо создавать отдельный поток, затем его запускать и останавливать по аналогии со StartWatch и StopWatch! Возьми эти процедуры за основу и напиши свои для нескольких дисков.

 

[yw64]

Доброе время суток. Создаю потоки вроде для всех дисков: C:\, D:\, E:\, F:\
Все равно работает только с последним из указанных. Предыдущие чисто игнорирует.