{*
 *  Authors    : Michael Puff - http://www.michael-puff.de, Christian Seehase
 *  Unit Name  : ReadDirectoryChangesCls
 *  Date       : 2006-03-10
 *  Comment    : Thread Class by Christian Seehase
 *               Enhancements by michae.puff
 *}

(*======================================================================*
 |                                                                      |
 |                        COPYRIGHT NOTICE                              |
 |                                                                      |
 | Copyright (c) 2001-2006, Michael Puff ["copyright holder(s)"]        |
 | All rights reserved.                                                 |
 |                                                                      |
 | Redistribution and use in source and binary forms, with or without   |
 | modification, are permitted provided that the following conditions   |
 | are met:                                                             |
 |                                                                      |
 | 1. Redistributions of source code must retain the above copyright    |
 |    notice, this list of conditions and the following disclaimer.     |
 | 2. Redistributions in binary form must reproduce the above copyright |
 |    notice, this list of conditions and the following disclaimer in   |
 |    the documentation and/or other materials provided with the        |
 |    distribution.                                                     |
 | 3. The name(s) of the copyright holder(s) may not be used to endorse |
 |    or promote products derived from this software without specific   |
 |    prior written permission.                                         |
 |                                                                      |
 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS  |
 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT    |
 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS    |
 | FORA PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE        |
 | REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,          |
 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, |
 | BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;     |
 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER     |
 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT   |
 | LIABILITY, OR TORT INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY |
 | WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE          |
 | POSSIBILITY OF SUCH DAMAGE.                                          |
 |                                                                      |
 *======================================================================*)


unit MpuReadDirectoryChangesCls;

interface

uses
  Windows,
  Classes,
  SysUtils;

const
  _iFilenameLength  = MAX_PATH * 2;
  FILE_LIST_DIRECTORY = $0001;

type
  LPOVERLAPPED = Pointer;
  LPOVERLAPPED_COMPLETION_ROUTINE = Pointer;

type
  TcsDirThread = class;

  TOnDirectoryChanges = procedure(Sender: TcsDirThread) of object;
  TOnDirectoryChangesError = procedure(Sender: TObject; ErrorCode: Integer; const ErrorMsg: string) of object;

  TcsDirThread = class(TThread)
  private
    FhFile: DWORD;
    FsDirPath: string;
    FhComPort: THandle;
    Fovl: TOverlapped;
    FsFileName: string;
    FsReason: string;
    FOnDirectoryChanges: TOnDirectoryChanges;
    FOnDirectoryChangesError: TOnDirectoryChangesError;
  private
    function GetReason(const AdwReasonCode: DWORD): string;
    procedure DoError;
    procedure DoNotify;
  protected
    procedure Execute; override;
    procedure DoTerminate; override;
  public
    constructor Create(const AsDirPath: string);
    destructor Destroy; override;
    property Filename: string read FsFileName;
    property Reason: string read FsReason;
    property OnDirectoryChanges: TOnDirectoryChanges read FOnDirectoryChanges write FOnDirectoryChanges;
    property OnDirectoryChangesError: TOnDirectoryChangesError read FOnDirectoryChangesError write
      FOnDirectoryChangesError;
  end;

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;

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

var
  dt                : TcsDirThread;

implementation

uses
  Unit1;

////////////////////////////////////////////////////////////////////////////////
// Procedure : TrimString
// Author    : michael.puff
// Date      : 2006-03-10
// Comment   : Cuts off the #0's
function TrimString(s: string): string;
var
  i                 : Integer;
begin
  i := 1;
  while (s[i] <> #0) do
    Inc(i);
  result := copy(s, 1, i - 1);
end;

constructor TcsDirThread.Create(const AsDirPath: string);
begin
  inherited Create(false);
  FsDirPath := AsDirPath;
  FreeOnTerminate := true;

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

destructor TcsDirThread.Destroy;
begin
  if (FhFile <> INVALID_HANDLE_VALUE) and (FhFile <> 0) then
    CloseHandle(FhFile);
  if FhComPort <> 0 then
    CloseHandle(FhComPort);
end;

{*
 *  Procedure: TcsDirThread.DoError
 *  Raises the error event
 *  Author    : michael.puff
 *  Date      : 2006-03-16
 *}
procedure TcsDirThread.DoError;
begin
  try
    if Assigned(OnDirectoryChangesError) then
      FOnDirectoryChangesError(self, GetLastError, SysErrorMessage(GetLastError));
  except
    // do nothing
  end;
end;

{*
 *  Procedure: TcsDirThread.DoNotify
 *  Raises the notify event
 *  Author    : michael.puff
 *  Date      : 2006-03-16
 *}
procedure TcsDirThread.DoNotify;
begin
  try
    if Assigned(OnDirectoryChanges) then
      FOnDirectoryChanges(self);
  except
    // do nothing;
  end;
end;

procedure TcsDirThread.DoTerminate;
begin
  inherited;
  if FhFile <> 0 then
    CloseHandle(FhFile);
  if FhComPort <> 0 then
    CloseHandle(FhComPort);
end;

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 the notify event synchronized
            Synchronize(DoNotify);
          until FNI.dwNextEntryOffset = 0;
        end;
      end
      else
      begin
        // raise the error event synchronized
        Synchronize(DoError);
        Terminate;
      end;
    end;
  finally
    FreeMem(pBuf, dwBufLen);
  end;
end;

{*
 *  Procedure: TcsDirThread.GetReason
 *  Gets the notify reason 
 *  Author    : michael.puff
 *  Date      : 2006-03-16
 *}
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.