Мониторинг изменений на диске
01.01.2007
Как определяешь наличие новых файлов? По таймеру или через ReadDirectoryChangesW? Если по таймеру, то оставь его и попробуй вот такой код (тебя интересует флаг FILE_NOTIFY_CHANGE_CREATION):
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
PFileNotifyInformation = ^TFileNotifyInformation;
TFileNotifyInformation = record
NextEntryOffset: DWORD;
Action: DWORD;
FileNameLength: DWORD;
FileName: array [0..MAX_PATH - 1] of WideChar;
end;
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
const
Filter = FILE_NOTIFY_CHANGE_FILE_NAME or
FILE_NOTIFY_CHANGE_DIR_NAME or
FILE_NOTIFY_CHANGE_ATTRIBUTES or
FILE_NOTIFY_CHANGE_SIZE or
FILE_NOTIFY_CHANGE_LAST_WRITE or
FILE_NOTIFY_CHANGE_LAST_ACCESS or
FILE_NOTIFY_CHANGE_CREATION or
FILE_NOTIFY_CHANGE_SECURITY;
var
Dir: THandle;
Notify: TFileNotifyInformation;
BytesReturned: DWORD;
begin
Dir := CreateFile('d:\', GENERIC_READ,
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
if Dir <> INVALID_HANDLE_VALUE then
try
if not ReadDirectoryChangesW(Dir, @Notify, SizeOf(TFileNotifyInformation),
False, Filter, @BytesReturned, nil, nil) then
raise Exception.Create(SysErrorMessage(GetLastError))
else
case Notify.Action of
FILE_ACTION_ADDED: ShowMessage('New file' + Notify.FileName);
FILE_ACTION_REMOVED: ShowMessage('Delete file' + Notify.FileName);
FILE_ACTION_MODIFIED: ShowMessage('Modify file' + Notify.FileName);
FILE_ACTION_RENAMED_OLD_NAME: ShowMessage('Old Name file' + Notify.FileName);
FILE_ACTION_RENAMED_NEW_NAME: ShowMessage('New Name file' + Notify.FileName);
end;
finally
CloseHandle(Dir);
end;
end;
end.
Взято из https://forum.sources.ru
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: только для NT/2000/XP/2003
Взято из https://forum.sources.ru