Festplattenzugriffe

[Slavik]

Hallo,

ich habe ein Problem bei der Realisierung eines Projektes. Ich will versuchen jegliche Schreibzugriffe auf eine bestimmte Festplatte zu spiegeln und eine Auswahl dieser Zugriffe auf eine andere Festplatte weiterleiten. Das dies nicht gerade einfach ist, ist mir klar. Hat jemand eine Idee dafür oder Anregungen wo ich nachlesen könnte? Das würde mir enorm helfen.

THX Slavik

[Robert Marquardt]

Das geht sicher nicht ohne Treiber. Warum benutzt du nicht ein Software RAID? Windows kann das.

[Slavik]

Danke für deine Antwort doch leider kann ich dies nicht realisieren. Es wäre für mich auch möglich ein Hardware RAID zu nutzen, jedoch möchte ich kein RAID aufbauen, da ich eine der 2 Platten regelmässig entferne, um als Sicherungskopie zuhause zu bleiben wenn die andere auf Reisen geht. Daher dieses lustige Problem.

THX Slavik

[Robert Marquardt]

Eine Festplatte regelmaeesig zu klonen ist nicht so schwierig.
Entweder man benutzt Tools wie Norton Ghost oder man schreibt sich das selber.
Ab Win 2000 kann man als Admin die Fstplatten oder die Volumes direkt oeffnen.
Der Pfad ist '\\.\HARDDISK0' (da bin ich nicht ganz sicher) bzw '\\.\C:'.
Ba da ist es reines Blocklesen und Blockschreiben.

[Christian Seehase]

Moin Slavik,

erst einmal herzlich willkommen hier in der Delphi-PRAXiS.

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.

[Kernel32.DLL]

Zitat:

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:

Zitat von Delphi - PRAXiS

Suche leider ergebnislos

Tja....

Aber es gibt ja noch die OH

[SirThornberry]

Zitat:

Zitat von Robert Marquardt

Eine Festplatte regelmaeesig zu klonen ist nicht so schwierig.
Entweder man benutzt Tools wie Norton Ghost oder man schreibt sich das selber.
Ab Win 2000 kann man als Admin die Fstplatten oder die Volumes direkt oeffnen.
Der Pfad ist '\\.\HARDDISK0' (da bin ich nicht ganz sicher) bzw '\\.\C:'.
Ba da ist es reines Blocklesen und Blockschreiben.

Laut meinen Sourcen geht es per (um die erste Festplatte zu öffnen)

Delphi-Quellcode:

hDevice := CreateFile('\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );

[Christian Seehase]

Moin Zusammen,

Zitat:

Zitat von Kernel32.DLL

Zitat:

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:

Zitat von Delphi - PRAXiS

Suche leider ergebnislos

Tja....

Aber es gibt ja noch die OH

:shock:

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

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.

[Slavik]

Also ich möchte erst einmal allen Danken für die zahlreichen Antworten.
@Christian Seehase: Danke für den Quelltext, doch leider funktioniert dieser bei mir nicht [Es wird nichts ausgegeben, auch wenn heftig auf die Platte geschrieben wird]. Ich hatte auch versucht ihn zu überarbeiten, hatte dabei bis jetzt aber keinen Erfolg.

THX Slavik

[Christian Seehase]

Moin Slavik,

wie gesagt, ich hab' da einen Demo Source herausgesucht, ihn allerdings vorher noch einmal getestet.
Unter W2K und XP (Pro) läuft das.
:gruebel:

Zeig' doch mal Deine Variante, dann kann man vielleicht etwas finden.

[w3seek]

Stichwort: storage filter driver
damit kann man alle lese/schreibzugriffe auf die platte protokollieren, unabhaengig ob man direkt als datei auf die festplatte oder partition schreibt und auch egal welches dateisystem verwendet wird.

[Kernel32.DLL]

Zitat:

Zitat von w3seek

Stichwort: storage filter driver
damit kann man alle lese/schreibzugriffe auf die platte protokollieren, unabhaengig ob man direkt als datei auf die festplatte oder partition schreibt und auch egal welches dateisystem verwendet wird.

Hast du konkrete beispiele, auf die man von delphi aus zugreifen könnte, ohne großartig mit C/C++ arbeiten zu müssen?

(evtl. fertigkompiliert?)

[w3seek]

dazu braucht man erst mal einen filter treiber den man schreiben muss. Das Zugreifen auf den Treiber mit CreateFile und DeviceIoControl ist dann eine leichtigkeit.

[Kernel32.DLL]

Zitat:

Zitat von w3seek

dazu braucht man erst mal einen filter treiber den man schreiben muss.

Mönsch, wenns weiter nichts is... :mrgreen: *zu googeln anfang*

[Slavik]

So, nach langem hin und her habe ich die ganze sache nun komplett einfach gelöst:

Ich habe die eine Festplatte in einen Wechselrahmen verfrachtet und syncronisiere sie wöchentlich 1 mal mit der anderen Platte. Zwar kein 100% Schutz aber ich denke für mich reichts.

THX Slavik

[Luckie]

Ich habe jetzt mal Christian Seehases Thread benutzt, um ein Netzwerklaufwerk zu überwachen. Die Aufgabe besteht darin neue Dateien in ein lokales Verzeichnis zu kopieren. Allerdings habe ich mit seinem Code etwas Probleme:

Delphi-Quellcode:

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);

          if FNI.dwAction = FILE_ACTION_ADDED then
          begin
            Synchronize(AddReasonToMemo);
            Synchronize(AddFileToMemo);
            FError := MoveChangedFiles(FFPATH + FsFileName);
            if FError <> 0 then
              Synchronize(AddErrorToMemo);
          end;

          PChar(pWork) := PChar(pBuf) + FNI.dwNextEntryOffset;
        until FNI.dwNextEntryOffset = 0;
        Create(FFPATH);
      end
      else
      begin
        break;
      end;
    end;
  finally
    FreeMem(pBuf, dwBufLen);
  end;
end;

Es wird aber immer nur die letzte Datei verschoben. Und ich bekomme Fehlermeldungen, dass auf die Datei nicht zugegriffen werden kann.

[Luckie]

Hm. Kopiere ich jede Datei einzeln geht es wie gewünscht. Ich kann mir aber leider nicht sicher sein, dass sie in einem so schönen abstand in dem Verzeichnis abegelegt werden. Und kopiere ich dann mal meherere Dateien gleichzeitig, dann schreibt er an dauernd ins Memo, dass eine von den Dateien andauernd geändert wird und nicht geht mehr :gruebel:

[Luckie]

Ich muss das noch mal nach oben holen, weil es wichtig wird.

[Christian Seehase]

Moin Luckie,

vielleicht klappt es asynchron besser.

Hier mal ein, leicht zusammengestrichenes Beispiel (was Du für Deinen Zweck wohl auch noch umsortieren müsstest:

Delphi-Quellcode:

const
  _iFilenameLength = MAX_PATH*2;

type
  PFILE_NOTIFY_INFORMATION = ^FILE_NOTIFY_INFORMATION;

  FILE_NOTIFY_INFORMATION = packed record
    dwNextEntryOffset : DWORD;
    dwAction          : DWORD;
    dwFileNameLength  : DWORD;
    wFilename         : array [1.._iFilenameLength] of WCHAR;
  end;

var
  pBuf     : Pointer;
  pWork    : Pointer;
  dwBufLen : DWORD;
  dwDummy  : DWORD;
  sResult   : string;
  FNI       : FILE_NOTIFY_INFORMATION;
  dwRead    : DWORD;
  dwKey     : DWORD;
  pOVL      : POVERLAPPED;
  iCopyLen  : integer;  // Prevent Buffer Overflow


begin
  // Normalerweise im Konstruktor erzeugt
  FhDir     := CreateFile(PChar(FsPath),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);
  FhComPort := CreateIoCompletionPort(FhDir,0,$1234ABCD,0);
  FillChar(Fovl,SizeOf(Fovl),0);
  // Execute
  pOVL     := @Fovl;
  dwBufLen := 65536;
  GetMem(pBuf,dwBufLen);
  try
    while not Terminated do begin
      ZeroMemory(pBuf,dwBufLen);
      if not ReadDirectoryChangesW(FhDir,pBuf,dwBufLen,true,FILE_NOTIFY_CHANGE_LAST_WRITE,@dwDummy,@Fovl,nil) then Terminate;
      if Terminated then break;
      if not GetQueuedCompletionStatus(FhComPort,dwRead,dwKey,pOVL,INFINITE) then begin
        Terminate;
      end else begin
        if Terminated then break;
        pWork := pBuf;
        repeat
          CopyMemory(@FNI,pWork,12);
          iCopyLen := FNI.dwFileNameLength;
          if iCopyLen > _iFilenameLength then iCopyLen := _iFilenameLength;
          CopyMemory(@FNI.wFilename[1],PChar(pWork)+12,iCopyLen);
          PChar(pWork) := PChar(pWork)+FNI.dwNextEntryOffset;
        until FNI.dwNextEntryOffset = 0;
        SetLength(sResult,iCopyLen);
        ZeroMemory(@sResult[1],length(sResult));
        if WideCharToMultiByte(GetACP,WC_NO_BEST_FIT_CHARS,@FNI.wFilename,iCopyLen,@sResult[1],iCopyLen,nil,nil) <> 0 then begin
        end;
      end;
    end;
  finally
    FreeMem(pBuf,dwBufLen);
  end;
  // Destruktor
  if (FhDir <> INVALID_HANDLE_VALUE) and (FhDir <> 0) then CloseHandle(FhDir);
  if FhComPort <> 0 then CloseHandle(FhComPort);

Ausserdem solltest Du auch einmal prüfen, welche Pfade/Dateien in der Schleife angezeigt werden.

Dass Du auf die Datei nicht zugreifen kannst, wird wohl daran liegen, dass Du sie verschieben willst, sie aber noch von einem anderen Prozess im Zugriff ist (Explorer?)
Ausserdem solltest Du einmal prüfen, ob bei Dir das ReadDirectoryChangesW für jede Veränderung doppelt aufgerufen wird (dazu habe ich hier auch einen Thread offen :?)

Ich habe mir die asynchrone Lösung erstellt, da ich den Thread ansonsten nicht sauber beenden konnte, wenn ReadDirectoryChangesW auf eine Veränderung gewartet hat.

[Luckie]

Dank dir. Ich werde das morgen mal an der Arbheit ausprobieren.

[Luckie]

Hallo Christian. Ich habe es jetzt so:

Delphi-Quellcode:

procedure TcsDirThread.Execute;
var
  pBuf              : Pointer;
  pWork             : Pointer;
  dwBufLen          : DWORD;
  dwDummy           : DWORD;
  sResult           : string;
  FNI               : FILE_NOTIFY_INFORMATION;
  dwRead            : DWORD;
  dwKey             : DWORD;
  pOVL              : POVERLAPPED;
  iCopyLen          : integer; // Prevent Buffer Overflow
begin
  // Normalerweise im Konstruktor erzeugt
  FhFile := CreateFile(PChar(FsDirPath), 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);
  FhComPort := CreateIoCompletionPort(FhFile, 0, $1234ABCD, 0);
  FillChar(Fovl, SizeOf(Fovl), 0);
  // Execute
  pOVL := @Fovl;
  dwBufLen := 65536;
  GetMem(pBuf, dwBufLen);
  try
    while not Terminated do
    begin
      ZeroMemory(pBuf, dwBufLen);
      if not ReadDirectoryChangesW(FhFile, pBuf, dwBufLen, true, FILE_NOTIFY_CHANGE_LAST_WRITE, @dwDummy, @Fovl, nil)
        then
        Terminate;
      if Terminated then
        break;
      if not GetQueuedCompletionStatus(FhComPort, dwRead, dwKey, pOVL, INFINITE) then
      begin
        Terminate;
      end
      else
      begin
        if Terminated then
          break;
        pWork := pBuf;
        repeat
          CopyMemory(@FNI, pWork, 12);
          iCopyLen := FNI.dwFileNameLength;
          if iCopyLen > _iFilenameLength then
            iCopyLen := _iFilenameLength;
          CopyMemory(@FNI.wFilename[1], PChar(pWork) + 12, iCopyLen);
          PChar(pWork) := PChar(pWork) + FNI.dwNextEntryOffset;
          FsReason := GetReason(FNI.dwAction);

          if FNI.dwAction = FILE_ACTION_ADDED then
          begin
            Synchronize(AddReasonToMemo);
            Synchronize(AddFileToMemo);
            FError := MoveChangedFiles(FFPATH + FsFileName);
            if FError <> 0 then
              Synchronize(AddErrorToMemo);
          end;
          
        until FNI.dwNextEntryOffset = 0;
        SetLength(sResult, iCopyLen);
        ZeroMemory(@sResult[1], length(sResult));
        (*if WideCharToMultiByte(GetACP, WC_NO_BEST_FIT_CHARS, @FNI.wFilename, iCopyLen, @sResult[1], iCopyLen, nil, nil)
          <> 0 then
        begin
        end;*)
      end;
    end;
  finally
    FreeMem(pBuf, dwBufLen);
  end;
  // Destruktor
  if (FhFile <> INVALID_HANDLE_VALUE) and (FhFile <> 0) then
    CloseHandle(FhFile);
  if FhComPort <> 0 then
    CloseHandle(FhComPort);
end;

Aber wenn ich debugge und einen Breakpunkt auf die Zeile 42 setze, dann kommt er nie dort an, weil er von GetQueuedCompletionStatus nie zurückkommt. :(

[Christian Seehase]

Moin Luckie,

teil das doch erst einmal so auf, dass die Teile die in den Konstruktor sollten auch da hinkommen, analog gilt dass dann natürlich auch für die Zeilen, die in den Destruktor gehören.
(Die mit F beginnenden Variablen sind private Felder der Klasse)
Ausserdem solltest Du noch die Filterbedingung (FILE_NOTIFY_CHANGE_LAST_WRITE usw.) Deinen Erfordernissen anpassen, denn wenn GetQueuedCompletionStatus nicht zurückkehrt, ist bislang keine der Bedingungen eingetreten.

[Luckie]

So getan. Nur bekomme ich jetzt jedes mal ein "Zugriff verweigert", während hingegen die aller werste Version funktioniert hat bei einzelnen Dateien. Im Memo sehe ich aber jetzt alle Dateien. :gruebel: Irgned wie hat eine API Funktion noch ihre Finger auf der datei, wenn ich sie verschieben will. :?

[Christian Seehase]

Moin Luckie,

da stellt sich mir dann die Frage, wie die Dateien da hinkommen, von wo Du sie verschieben willst.

[Luckie]

Also zu Testzwecken verschiebe ich sie lokal in das Verzeichnis, was ich über die Freigabe überwache: '\\Nestor\Sambafreigabe'. Letztendlich liegt das verzeichnis aber auf einem Linux Laufwerk, welches über eine Sambafreigabe zu erreichen ist. Die Daten die da abgelegt werden, kommen von einem Drucker. Kommt eine neue hinzu, muss sie auf den lokalen Rechner verschoben werden.

[Luckie]

Ich werden nachher mal probieren, was passiert, wenn ich sie erst kopiere und dann lösche, ob das funktioniert.

[Luckie]

So erste Problem ist gelöst. Wenn ich ein Ereigniss auslöse dann kann ich auch gleichzeitig miot dem Explorer mehrere Dateien in die Freigabe verschieben und er bekommt alles mit. Er kopiert auch alle Dateien, so wie er es soll. Nur löschen kann ich sie nicht, weil mir der Zugriff verweigert wird. Dafür bräuchte ich auch noch eine Lösung.

[Luckie]

Das zweite Problem mit dem Löschen besteht immer noch und ich bräuchte dafür eine Lösung. Bisher sieht es so aus:

Delphi-Quellcode:

procedure TcsDirThread.Execute;
const
  WC_NO_BEST_FIT_CHARS = $00000400;
var
  pBuf              : Pointer;
  pWork             : Pointer;
  dwBufLen          : DWORD;
  dwDummy           : DWORD;
  FNI               : FILE_NOTIFY_INFORMATION;
  dwRead            : DWORD;
  dwKey             : DWORD;
  pOVL              : POVERLAPPED;
  iCopyLen          : integer; // Prevent Buffer Overflow
begin
  pOVL := @Fovl;
  dwBufLen := 65536;
  GetMem(pBuf, dwBufLen);
  try
    while not Terminated do
    begin
      ZeroMemory(pBuf, dwBufLen);
      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},
        @dwDummy, @Fovl, nil) then
      begin
        if Terminated then
          break;
        if not GetQueuedCompletionStatus(FhComPort, dwRead, dwKey, pOVL, INFINITE) then
        begin
          Terminate;
        end
        else
        begin
          if Terminated then
            break;
          pWork := pBuf;
          repeat
            CopyMemory(@FNI, pWork, 12);
            iCopyLen := FNI.dwFileNameLength;
            if iCopyLen > _iFilenameLength then
              iCopyLen := _iFilenameLength;
            CopyMemory(@FNI.wFilename[1], PChar(pWork) + 12, iCopyLen);
            PChar(pWork) := PChar(pWork) + FNI.dwNextEntryOffset;
            FsReason := GetReason(FNI.dwAction);
            FsFileName := TrimString(FNI.wFilename);
            // raise event
            if Assigned(OnDirectoryChanges) then
              FOnDirectoryChanges(self, FsFileName, FsReason);

          until FNI.dwNextEntryOffset = 0;
        end;
      end
      else
      begin
        if Assigned(OnDirectoryChangesError) then
          FOnDirectoryChangesError(self, GetLastError, SysErrorMessage(GetLastError));
        Terminate;
      end;
    end;
  finally
    FreeMem(pBuf, dwBufLen);
  end;
end;

Ändert sich etwas, wird also ein Event ausgelöst in dem ich auf die Änderung reagiere:

Delphi-Quellcode:

{*
 *  Procedure: TForm1.MyOnDirectoryChanges
 *  Change occured
 *  Author    : michael.puff
 *  Date      : 2006-03-10
 *}
procedure TForm1.MyOnDirectoryChanges(Sender: TObject; const Filename,
  Reason: string);

  function GetProjectPath: String;
  begin
    result := copy(ExtractFilepath(ParamStr(0)), 1, length(ExtractFilepath(ParamStr(0))) - 4);
    //ShowMessage(result);
  end;

begin
  Memo1.Lines.Add(Format('neue / geänderte Datei %s [%s]', [Trim(Filename), Reason]));
  if CopyFile(PChar(DIRPATH + '\' + Filename), PChar(GetProjectPath + '\' + Filename), False) then
  begin
    Memo1.Lines.Add(Format('Datei %s kopiert', [Filename]));
    Memo1.Refresh;
    Sleep(2000);
    Application.ProcessMessages;
    if DeleteFile(DIRPATH + '\' + Filename) then
      Memo1.Lines.Add(Format('Datei %s gelöscht', [Filename]))
    else
      Memo1.Lines.Add(Format('Fehler beim Löschen von Datei %s [%s]', [Filename, SysErrorMessage(GetLastError)]));
  end
  else
    Memo1.Lines.Add(Format('%s [%s]', [Filename, SysErrorMessage(GetLastError)]));
end;

Aber leider bekomme ich beim Löschen immer ein "Zugriff verweigert". Die Überwachung erst zu unterbrechen, die Dateien zu löschen und dann die Überwachung wieder zu starten, ist leider nicht so schön, da während der Unterbrechung neue dateien hinzugekommen sein könnten. Dies müsste ich dann auch behandlen und würde einen zusätzlichen Verwaltungsaufwand bedeuten. Was sehr unschön wäre.

[Luckie]

So, ich habe jetzt die Events synchronisiert, was allerdings immer noch nichts an dem Problem äöndert. Hat jemand eine Idee woran das liegen könnte und wie man dem Abhilfe schaffen könnte? Mit dem Explorer geht das Löschen, wenn das Verzeichnis überwacht wird ohne Probleme. Also wie schafft es der Explorer?

[Christian Seehase]

Moin Luckie,

versuche doch mal die Datei(en) mit SHFileOperation zu löschen, und nicht mit DeleteFile.

[Luckie]

Das wäre eine Idee. Den Dialog kann man ja auch unsichtbar machen oder?

[Luckie]

Ich habe es jetzt auch mal mit dieser Unit probiert: http://www.delphipraxis.net/internal...=342496#342496 aber das hat leider auch nicht geholfen.

[runger]

Hallo,

das geht doch ganz einfach. Windoof setzt bei jeder Änderung einer Datei das Archivierungsbit.
Du erstellst eine Batchdatei mit folgendem Inhalt:

xcopy quelle ziel /S /m

hier wird alles kopiert was unter quelle liegt und dessen Archivierungsbit gesetzt ist.
Du kannst das von Windoof automatisch durchführen lassen oder von Hand.
Mag zwar primitiv aussehen ist aber enorm wirkunsvoll.
/s alle subdirectories
/m nur Dateien mit gesetztem Archivierungsbit
/y keine Nachfrage beim Überschreiben.

Beispiel

Delphi-Quellcode:

@echo off
xcopy e:\rcrset\*.* L:\rcrset\*.* /S /y /m

Das Ganze lässt sich auch von Delphi starten.

Rainer

[himitsu]

Zitat:

Zitat von runger

das geht doch ganz einfach. Windoof setzt bei jeder Änderung einer Datei das Archivierungsbit.

was die von M$ machen is mir eigentlich vollkommen schnuppe ... in meinen Programmen behandle ich diese Attribut selber und bei bestimmten "Änderungen" wird es eben mal nicht gesetzt, also ist diese Methode da nicht immer anwendbar ;)

[Vjay]

Hallo Luckie,

ich gebe mal auch meinen Senf dazu.
Ich habe mal etwas ähnliches realisiert und mit dem Löschen/öffnen ebenfalls Probleme gehabt. Ich habe es lösen können, indem ich es mehrmals versuche in einem gewissen Zeitraum. Sprich while fileExists do deleteFile + sleep.
Und noch etwas, ich weiss zwar nicht welche Sambar-Version auf diesem einen Server läuft, jedoch bekomme ich keine CHange-Notification, wenn jemand anderes eine Datei dort ändert. Sprich ich musste leider auf Polling zurückgreifen. Auf einem Windows-Rechner lief es hingegen. Nur dass du diesen evtl. Fall mitbedenkst.

@runger: Und danach attrib * -a? Funktioniert dann nur in Fällen, in denen selten Änderungen erfolgen. Bei ständigen Schreibzugriffen wird dir sonst der Zeitabstand xcopy -> attrib zum Verhängnis.

MfG
V.

[Luckie]

Es hat sich Gott sei dank erledigt. das Programm wird jetzt über den Taskplaner nachts gestartet oder eben manuell.

[runger]

Hallo,

Zitat:

was die von M$ machen is mir eigentlich vollkommen schnuppe ... in meinen Programmen behandle ich diese Attribut selber und bei bestimmten "Änderungen" wird es eben mal nicht gesetzt, also ist diese Methode da nicht immer anwendbar

Wer ist dir denn auf den Schlips getreten.
Das Archivierungsbit zu manipulieren ist absolut schlechter Stil. Fast alles was es an Backup-Software gibt benutzt dieses flag.
Bei uns wird soetwas nicht akzeptiert.

Rainer

[himitsu]

Ich hab z.B. ein winziges Progie, welches in Dateien den Zeilenumbruch an das im Windows übliche #13#10 anpaßt, dabei werden ja das Archivattribut, sowie das Anderungsdatum der Datei geändert, allerdings ändert sich ja nicht "wirklich" was am Dateiinhalt, daher setze ich z.B. in diesem Fall diese Werte wieder zurück, damit ich den tatsächlichen, "inhaltlichen" Zustand der Datei noch an diesen Werten erkennen kann :zwinker:

[himitsu]

So, dann mach ich auch mal mit ... irgendwas stimmt wohl wirklich mit den Befehlen nicht.

In diesem Code (ist im Grunde vom Aufbau her wie der Erste hier im Thread) reagiert Find*ChangeNotification/WaitForSingleObject sehr oft auf Änderungen (aber auch nicht immer), wobei ReadDirectoryChangesW entweger garnichts zurückgibt und die Ausführung dort zum Stehen kommt, oder ebenfalls nur die letzte Änderung ankommt.

Delphi-Quellcode:

Function DCSourceChangesThread(DC: TDirectoryCompare): LongWord; StdCall;
  Const BufferSize = 4096{65536};

  Var DH, NH: THandle;
    Buffer, P: PWideChar;
    Name: Widestring;
    Status: TDCObjStatus;
    i: Integer;
    W: LongWord;

  Label LExit;

  Begin
    Result := 0;
    DH := CreateFileW(PWideChar(Copy(DC._SourceRoot, 1, Length(DC._SourceRoot) - 1)), GENERIC_READ or FILE_LIST_DIRECTORY,
      FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
    NH := FindFirstChangeNotificationW(PWideChar(Copy(DC._SourceRoot, 1, Length(DC._SourceRoot) - 1)),
      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_CREATION);
    Buffer := GetMemory(BufferSize);
    If (DH <> INVALID_HANDLE_VALUE) and (NH <> INVALID_HANDLE_VALUE) and (Buffer <> nil) Then
      Repeat
        If (DC._DestChangesThread = INVALID_HANDLE_VALUE) or (DC._Pause = 2) Then GoTo LExit;
        Case WaitForSingleObject(NH, 1000) of
          WAIT_FAILED: Break;
          WAIT_OBJECT_0:
            If ReadDirectoryChangesW(DH, Buffer, BufferSize, 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_CREATION, @W, nil, nil) Then Begin
              P := Buffer;
              Repeat
                SetLength(Name, PFileNotifiInformation(P)^.FileNameLength div 2);
                Move(PFileNotifiInformation(P)^.FileName, Name[1], PFileNotifiInformation(P)^.FileNameLength + 1);
                Case PFileNotifiInformation(P)^.Action of
                  FILE_ACTION_ADDED:            Status := [dcsDeleted];
                  FILE_ACTION_REMOVED:          Status := [dcsCreated];
                  FILE_ACTION_MODIFIED:         Status := [dcsSize..dcsLastWriteTime, dcsContent..dcsAttrEncrypted];
                  FILE_ACTION_RENAMED_OLD_NAME: Status := [dcsName];
                  FILE_ACTION_RENAMED_NEW_NAME: Status := [dcsName];
                  Else                          Status := [dcsSize..dcsAttrEncrypted];
                End;
                Lock(DC._Lock);
                i := High(DC._SourceChangesList);
                While i >= 0 do
                  If WideSameText(DC._SourceChangesList[i].Name, Name) Then Break
                  Else Dec(i);
                If i < 0 Then Begin
                  i := Length(DC._SourceChangesList);
                  SetLength(DC._SourceChangesList, i + 1);
                  DC._SourceChangesList[i].Name := Name;
                  //UniqueString(DC._SourceChangesList[i].Name);  // WideString/OLE-String is always an UniqueString.
                  DC._SourceChangesList[i].Changes := [];
                End;
                DC._SourceChangesList[i].Changes := DC._SourceChangesList[i].Changes + Status;
                DC._SourceChangesList[i].Time := GetTickCount;
                Unlock(DC._Lock);
                P := Buffer + PFileNotifiInformation(P)^.NextEntryOffset;
              Until PFileNotifiInformation(P)^.NextEntryOffset = 0;
            End Else Break;
        End;
      Until not FindNextChangeNotification(NH);
    DC._CallStatusProc(dcsErrorSourceDirChangesThread, '', Integer(DC));

    LExit:
    FreeMemory(Buffer);
    FindCloseChangeNotification(NH);
    CloseHandle(DH);
    LockedSet(DC._SourceChangesThread, INVALID_HANDLE_VALUE);
  End;

Probleme mit dem Dateizugriff sollte es nicht geben, da hier nicht auf die Dateien zugegriffen wird, dieses würde erst Zeitversetzt ein einem anderem Thread geschehen.

[Mackhack]

Hi,

da ich grade auch an so einem Problem stehe und ich mir den Code von Christian mal ansah... Es ist ja schon interessant was so alles geschieht selbst wenn man glaubt der Rechner ist in Idle-Mode!