Wer seine Festplatte im Hintergrund überwachen möchte, um zu ermitteln, was Programme alles so anstellen, kann dieses Projekt dafür verwenden.
Man benötigt eine EditBox, 2xButton und eine ListBox.
In die EditBox muss der Festplattenbuchstabe mit Doppelpunkt eingetragen werden, wie z. B. : "C:"
Der Sniffer ist schnell und belastet die Festplatte nur in geringen Maßen.
{$I Directives.inc}
unit DirSniffer;
interface
{unit DirSniffer.pas}
uses
Windows, SysUtils, Classes;
type
TDirChangeNotifier = class;
TDirChangeNotification = (dcnFileAdd, dcnFileRemove, dcnRenameFile,
dcnRenameDir, dcnModified, dcnLastWrite, dcnLastAccess,
dcnCreationTime);
TDirChangeNotifications = set of TDirChangeNotification;
TDirChangeEvent = procedure (Sender: TDirChangeNotifier;
const FileName, OtherFileName: WideString;
Action: TDirChangeNotification) of object;
TDirChangeNotifier = class(TThread)
private
FDir: WideString;
FDirHandle: THandle;
FNotifList: TDirChangeNotifications;
FTermEvent: THandle;
FOverlapped: TOverlapped;
FOnChange: TDirChangeEvent;
FFileName: WideString;
FOtherFileName: WideString;
FAction: TDirChangeNotification;
protected
function WhichAttrChanged(const AFileName: WideString): TDirChangeNotification;
procedure Execute; override;
procedure DoChange;
public
constructor Create(const ADirectory: WideString;
WantedNotifications: TDirChangeNotifications);
destructor Destroy; override;
procedure Terminate; reintroduce;
property OnChange: TDirChangeEvent read FOnChange write FOnChange;
end;
const
FILE_LIST_DIRECTORY = $0001;
FILE_READ_ATTRIBUTES = $0080;
CNotificationFilters: array[TDirChangeNotification] of Cardinal = (0, 0,
FILE_NOTIFY_CHANGE_FILE_NAME,
FILE_NOTIFY_CHANGE_DIR_NAME,
FILE_NOTIFY_CHANGE_SIZE,
FILE_NOTIFY_CHANGE_LAST_WRITE,
FILE_NOTIFY_CHANGE_LAST_ACCESS,
FILE_NOTIFY_CHANGE_CREATION);
CAllNotifications: TDirChangeNotifications = [dcnFileAdd, dcnFileRemove,
dcnRenameFile, dcnRenameDir, dcnModified, dcnLastWrite,
dcnLastAccess, dcnCreationTime];
implementation
constructor TDirChangeNotifier.Create(const ADirectory: WideString;
WantedNotifications: TDirChangeNotifications);
begin
inherited Create(False);
FreeOnTerminate := True;
FDir := ExcludeTrailingPathDelimiter(ADirectory);
FNotifList := WantedNotifications;
end;
destructor TDirChangeNotifier.Destroy;
begin
//
inherited Destroy;
end;
function FileTimeToDateTime(FileTime: TFileTime): TDateTime;
var
SysTime: TSystemTime;
TimeZoneInfo: TTimeZoneInformation;
Bias: Double;
begin
FileTimeToSystemTime(FileTime, SysTime);
GetTimeZoneInformation(TimeZoneInfo);
Bias := TimeZoneInfo.Bias / 1440; // = 60 * 24
Result := SystemTimeToDateTime(SysTime) - Bias;
end;
function TDirChangeNotifier.WhichAttrChanged(const AFileName: WideString):
TDirChangeNotification;
var
hFile: THandle;
FCreation, FModification, FAccess: TFileTime;
Creation, Modification, Access: TDateTime;
begin
hFile := CreateFileW(PWideChar(AFileName), FILE_READ_ATTRIBUTES,
FILE_SHARE_READ or FILE_SHARE_DELETE or FILE_SHARE_WRITE, nil,
OPEN_EXISTING, 0, 0);
if hFile = 0 then
begin
Result := dcnModified;
Exit;
end;
GetFileTime(hFile, @FCreation, @FAccess, @FModification);
Creation := FileTimeToDateTime(FCreation);
Access := FileTimeToDateTime(FAccess);
Modification := FileTimeToDateTime(FModification);
if Now - Access <= 20.0 then
Result := dcnLastAccess
else if Now - Modification <= 20.0 then
Result := dcnLastWrite
else if Now - Creation <= 20.0 then
Result := dcnCreationTime
else
Result := dcnModified;
CloseHandle(hFile);
end;
procedure TDirChangeNotifier.Execute;
var
Buffer: array[0..4095] of Byte;
BytesReturned: Cardinal;
WaitHandles: array[0..1] of THandle;
NotifyFilter, I, Next, Action, FileNameLength: Cardinal;
FileName: WideString;
FmtSettings: TFormatSettings;
N: TDirChangeNotification;
begin
FTermEvent := CreateEvent(nil, True, False, nil);
FillChar(FOverlapped, SizeOf(TOverlapped), 0);
FOverlapped.hEvent := CreateEvent(nil, True, False, nil);
FDirHandle := CreateFileW(PWideChar(FDir), FILE_LIST_DIRECTORY,
FILE_SHARE_READ or FILE_SHARE_DELETE or FILE_SHARE_WRITE, nil,
OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED, 0);
WaitHandles[0] := FTermEvent;
WaitHandles[1] := FOverlapped.hEvent;
GetLocaleFormatSettings(LOCALE_USER_DEFAULT, FmtSettings);
NotifyFilter := 0;
for N := Low(TDirChangeNotification) to High(TDirChangeNotification) do
if N in FNotifList then
Inc(NotifyFilter, CNotificationFilters[N]);
while True do
begin
ReadDirectoryChangesW(FDirHandle, @Buffer, SizeOf(Buffer), True,
NotifyFilter, nil, @FOverlapped, nil);
if WaitForMultipleObjects(2, @WaitHandles, False,
INFINITE) = WAIT_OBJECT_0 then
Break;
GetOverlappedResult(FDirHandle, FOverlapped, BytesReturned, False);
I := 0;
repeat
Move(Buffer[I], Next, 4);
Move(Buffer[I + 4], Action, 4);
case Action of
FILE_ACTION_ADDED: FAction := dcnFileAdd;
FILE_ACTION_REMOVED: FAction := dcnFileRemove;
FILE_ACTION_MODIFIED: FAction := dcnModified;
FILE_ACTION_RENAMED_OLD_NAME,
FILE_ACTION_RENAMED_NEW_NAME: FAction := dcnRenameFile;
end;
Move(Buffer[I + 8], FileNameLength, 4);
SetLength(FileName, FileNameLength div 2);
Move(Buffer[I + 12], FileName[1], FileNameLength);
if (FAction = dcnModified) and FileExists(FDir + '\' + FileName) then
FAction := WhichAttrChanged(FDir + '\' + FileName);
if Action = FILE_ACTION_RENAMED_NEW_NAME then
begin
FOtherFileName := FDir + '\' + FileName;
if DirectoryExists(FOtherFileName) then
FAction := dcnRenameDir;
end
else
begin
FFileName := FDir + '\' + FileName;
FOtherFileName := '';
end;
if (Action <> FILE_ACTION_RENAMED_OLD_NAME)
and (FAction in FNotifList) then
Synchronize(DoChange);
Inc(I, Next);
until Next = 0;
end;
CloseHandle(FTermEvent);
FTermEvent := 0;
CloseHandle(FOverlapped.hEvent);
CloseHandle(FDirHandle);
end;
procedure TDirChangeNotifier.Terminate;
begin
if FTermEvent <> 0 then
SetEvent(FTermEvent);
end;
procedure TDirChangeNotifier.DoChange;
begin
if Assigned(FOnChange) then
FOnChange(Self, FFileName, FOtherFileName, FAction);
end;
end.
{ debugging }
{$DEFINE Debugging}
{$IFDEF FinalVersion}
{$UNDEF Debugging}
{$ENDIF}
{ Version of Delphi }
{$IFDEF VER180}
{$DEFINE DELPHI_10}
{$DEFINE DELPHI_9}
{$DEFINE DELPHI_8}
{$DEFINE DELPHI_7}
{$DEFINE DELPHI_6}
{$DEFINE DELPHI_5}
{$ENDIF}
{$IFDEF VER170}
{$DEFINE DELPHI_9}
{$DEFINE DELPHI_8}
{$DEFINE DELPHI_7}
{$DEFINE DELPHI_6}
{$DEFINE DELPHI_5}
{$ENDIF}
{$IFDEF VER160}
{$DEFINE DELPHI_8}
{$DEFINE DELPHI_7}
{$DEFINE DELPHI_6}
{$DEFINE DELPHI_5}
{$ENDIF}
{$IFDEF VER150}
{$DEFINE DELPHI_7}
{$DEFINE DELPHI_6}
{$DEFINE DELPHI_5}
{$ENDIF}
{$IFDEF VER140}
{$DEFINE DELPHI_6}
{$DEFINE DELPHI_5}
{$ENDIF}
{$IFDEF VER130}
{$DEFINE DELPHI_5}
{$ENDIF}
{$IFDEF DELPHI_7}
{$DEFINE EnableXPMan}
{$ENDIF}
{$IFDEF DELPHI_9}
{$DEFINE EnableRGN}
{$DEFINE EnableInline}
{$ENDIF}
(*
{$IFDEF EnableXPMan}, XPMan{$ENDIF}
{$IFDEF EnableRGN}{$REGION ''}{$ENDIF}
{$IFDEF EnableRGN}{$ENDREGION}{$ENDIF}
{$IFDEF EnableInline}inline;{$ENDIF}
{$IFDEF EnableInline}{$INLINE ON}{$ENDIF}
*)
{$ALIGN 8}
{$LONGSTRINGS ON}
{$WRITEABLECONST OFF}
{$IOCHECKS ON}
{$BOOLEVAL OFF}
{$IFDEF HighDebugging}
{$OPTIMIZATION OFF}
{$ELSE}
{$OPTIMIZATION ON}
{$ENDIF}
{$SAFEDIVIDE OFF}
{$IFDEF Debugging}
{$ASSERTIONS ON}
{$DEBUGINFO ON}
{$OVERFLOWCHECKS ON}
{$RANGECHECKS ON}
{$ELSE}
{$ASSERTIONS OFF}
{$DEBUGINFO OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$ENDIF}
uses DirSniffer,
{$WARNINGS OFF}FileCtrl{$WARNINGS ON}
{$IFDEF EnableXPMan}, XPMan{$ENDIF}
//
private
FChangeThread: TDirChangeNotifier;
procedure SthChange(Sender: TDirChangeNotifier; const FileName,
OtherFileName: WideString; Action: TDirChangeNotification);
procedure ThreadTerminated(Sender: TObject);
//
procedure TForm1.FormCreate(Sender: TObject);
var
Buf: array[0..255] of Char;
begin
GetWindowsDirectory(@Buf, SizeOf(Buf));
EdtDir.Text := ExtractFileDrive(Buf);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(FChangeThread) then
FChangeThread.Terminate;
end;
procedure TForm1.StatusBar1Resize(Sender: TObject);
begin
StatusBar1.Panels[0].Width := StatusBar1.ClientWidth - 150;
end;
procedure TForm1.SthChange(Sender: TDirChangeNotifier;
const FileName, OtherFileName: WideString; Action: TDirChangeNotification);
var
Fmt, Line: WideString;
begin
case Action of
dcnFileAdd: Fmt := 'Creation file %s';
dcnFileRemove: Fmt := 'Remove file %s';
dcnRenameFile, dcnRenameDir: Fmt := '%s renamed to %s';
dcnModified: Fmt := 'Modification file %s';
dcnLastAccess: Fmt := 'Date last access file %s modified';
dcnLastWrite: Fmt := 'Date last write file %s modified';
dcnCreationTime: Fmt := 'Create time file %s modified';
end;
Line := FormatDateTime('"["hh":"nn":"ss","zzz"] "', Now);
Line := Line + Format(Fmt, [FileName, OtherFileName]);
ListBox1.Items.Insert(0, Line);
if ListBox1.Items.Count > 1 then
StatusBar1.Panels[1].Text := Format('%d elements', [ListBox1.Items.Count])
else
StatusBar1.Panels[1].Text := '1 element';
end;
procedure TForm1.ThreadTerminated(Sender: TObject);
begin
FChangeThread := nil;
Button1.Enabled := True;
Button2.Enabled := False;
StatusBar1.Panels[0].Text := 'Sniffer stopped';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FChangeThread := TDirChangeNotifier.Create(EdtDir.Text, CAllNotifications);
FChangeThread.OnChange := SthChange;
FChangeThread.OnTerminate := ThreadTerminated;
Button1.Enabled := False;
Button2.Enabled := True;
ListBox1.Items.Clear;
StatusBar1.Panels[1].Text := '0 element';
StatusBar1.Panels[0].Text := 'Sniff on File System Changes';
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FChangeThread.Terminate;
end;
Keine Kommentare:
Kommentar veröffentlichen