unit MAIN;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,filectrl;
type
TForm1 =
class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
type
LPOVERLAPPED = Pointer;
LPOVERLAPPED_COMPLETION_ROUTINE = Pointer;
function ReadDirectoryChangesW(
const hDirectory : DWORD;
const lpBuffer : Pointer;
const nBufferLength : DWORD;
const bWatchSubtree : Longbool;
const dwNotifyFilter : DWORD;
const lpBytesReturned : PDWORD;
const lpOverlapped : LPOVERLAPPED;
const lpCompletionRoutine : LPOVERLAPPED_COMPLETION_ROUTINE
) : Longbool;
stdcall;
external '
kernel32.dll';
const
FILE_LIST_DIRECTORY = $0001;
type
TcsDirThread =
class(TThread)
private
FhFile : DWORD;
FsDirPath :
string;
FsFileName :
string;
FsReason :
string;
procedure AddFileToMemo;
procedure AddReasonToMemo;
function GetReason(
const AdwReasonCode : DWORD) :
string;
public
constructor Create(
const AsDirPath :
string);
destructor Destroy;
override;
procedure Execute;
override;
end;
PFILE_NOTIFY_INFORMATION = ^FILE_NOTIFY_INFORMATION;
FILE_NOTIFY_INFORMATION =
packed record
dwNextEntryOffset : DWORD;
dwAction : DWORD;
dwFileNameLength : DWORD;
end;
var
dt : TcsDirThread;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
dt := TcsDirThread.Create('
c:\');
end;
{ TcsDirThread }
procedure TcsDirThread.AddFileToMemo;
begin
Form1.Memo1.Lines.Add(FsFileName);
Form1.Memo1.Refresh;
end;
procedure TcsDirThread.AddReasonToMemo;
begin
Form1.Memo1.Lines.Add(FsReason);
Form1.Memo1.Refresh;
end;
constructor TcsDirThread.Create(
const AsDirPath:
string);
begin
inherited Create(false);
FsDirPath := AsDirPath;
FreeOnTerminate := true;
end;
destructor TcsDirThread.Destroy;
begin
if FhFile <> INVALID_HANDLE_VALUE
then CloseHandle(FhFile);
end;
procedure TcsDirThread.Execute;
var
pBuf : Pointer;
dwBufLen : DWORD;
dwRead : DWORD;
FNI : FILE_NOTIFY_INFORMATION;
pWork : Pointer;
sFileName : Widestring;
begin
FhFile := CreateFile(PChar(FsDirPath),FILE_LIST_DIRECTORY
or GENERIC_READ,
FILE_SHARE_READ
or FILE_SHARE_WRITE
or FILE_SHARE_DELETE,
nil,
OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0);
if (FhFile = INVALID_HANDLE_VALUE)
or (FhFile = 0)
then exit;
dwBufLen := 65536;
pBuf := AllocMem(dwBufLen);
try
while true
do begin
if ReadDirectoryChangesW(FhFile,pBuf,dwBufLen,true,
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,
@dwRead,
nil,
nil)
then
begin
pWork := pBuf;
repeat
StrMove(@FNI,pWork,12);
PChar(pWork) := PChar(pWork)+12;
sFileName := StringOfChar(#00,FNI.dwFileNameLength);
StrMove(@sFileName[1],pWork,FNI.dwFileNameLength);
FsFileName := WideCharToString(PWideChar(sFileName));
FsFileName := copy(FsFileName,1,length(FsFileName)
shl 1);
FsReason := GetReason(FNI.dwAction);
Synchronize(AddReasonToMemo);
Synchronize(AddFileToMemo);
PChar(pWork) := PChar(pBuf)+FNI.dwNextEntryOffset;
until FNI.dwNextEntryOffset = 0;
end else begin
break;
end;
end;
finally
FreeMem(pBuf,dwBufLen);
end;
end;
function TcsDirThread.GetReason(
const AdwReasonCode: DWORD):
string;
begin
case AdwReasonCode
of
FILE_ACTION_ADDED : Result := '
Datei wurde hinzugefügt';
FILE_ACTION_REMOVED : Result := '
Datei wurde gelöscht';
FILE_ACTION_MODIFIED : Result := '
Datei wurde verändert';
FILE_ACTION_RENAMED_OLD_NAME : Result := '
Datei wurde umbenannt. Alter Name.';
FILE_ACTION_RENAMED_NEW_NAME : Result := '
Datei wurde umbenannt. Neuer Name.';
else Result := '
Ungültiger Reason Code: '+IntToHex(AdwReasonCode,8);
end;
end;
end.