Festplattenzugriffe

[Christian Seehase]

Moin Zusammen,

Zitat von Kernel32.DLL:

Zitat von Christian Seehase:

Wenn Du ein NT basiertes Betriebssystem verwendest, könntest Du die Zugriffe mit ReadDirectoryChangesW überwachen, und entsprechende Änderungen verarbeiten.
Ggf. genügt ja auch FindFirstChangeNotification.

Zitat von Delphi - PRAXiS:

Suche leider ergebnislos

Tja....

Aber es gibt ja noch die OH

Es hätte ja zumindest dieser Thread gefunden werden müssen

Nun gut, ich hab' mal eine Demo herausgesucht:
Man nehme ein Formular, einen Button und ein Memo und:

Delphi-Quellcode:

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.