Thema: Delphi Festplattenzugriffe

Einzelnen Beitrag anzeigen

Christian Seehase
(Co-Admin)

Registriert seit: 29. Mai 2002
Ort: Hamburg
11.105 Beiträge
 
Delphi 11 Alexandria
 

Re: Festplattenzugriffe

  Alt 21. Nov 2004, 11:47
Moin Zusammen,

Zitat von Kernel32.DLL:
Zitat von Christian Seehase:
Wenn Du ein NT basiertes Betriebssystem verwendest, könntest Du die Zugriffe mit Hier im Forum suchenReadDirectoryChangesW überwachen, und entsprechende Änderungen verarbeiten.
Ggf. genügt ja auch Hier im Forum suchenFindFirstChangeNotification.
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.
Tschüss Chris
Die drei Feinde des Programmierers: Sonne, Frischluft und dieses unerträgliche Gebrüll der Vögel.
Der Klügere gibt solange nach bis er der Dumme ist
  Mit Zitat antworten Zitat