?
Solved

ATFileNotification problem

Posted on 2010-11-30
7
Medium Priority
?
748 Views
Last Modified: 2012-05-10
Hi,
I`ve got problems with ATFileNotification component - it`s not working with any of event under D2010.
It`s strange becouse under D2007 it`s working perfectly.
Do you have any ideas.
0
Comment
Question by:Vaalar
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
7 Comments
 
LVL 24

Expert Comment

by:jimyX
ID: 34238683
Only to confirm, did you try this one, it says "Component made Unicode compatible" up to Delphi 2009, seems updated than yours:

http://atorg.net.ru/delphi/atfilenotification.htm
0
 

Author Comment

by:Vaalar
ID: 34238730
Yes Jimy, It`s always the first step if i have some problems with component, but thx for quick reply :)
0
 
LVL 24

Expert Comment

by:jimyX
ID: 34238834
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 24

Expert Comment

by:jimyX
ID: 34238918
Or you can consider moving to another component that supports Delphi 2010:

http://www.greatis.com/delphicb/foldmon/
0
 

Author Comment

by:Vaalar
ID: 34239136
The last one probably would solve my problem but they want casshhh :)
You have no idea what can cause such problems with atfilenotification comp.
0
 
LVL 32

Accepted Solution

by:
Ephraim Wangoya earned 2000 total points
ID: 34245384

Here is modified code.
{************************************************}
{                                                }
{  ATFileNotification Component                  }
{  Copyright (C) 2006-2007 Alexey Torgashin      }
{  http://atorg.net.ru                           }
{  support@uvviewsoft.com                        }
{                                                }
{************************************************}

{
ATFileNofitication is a modification of fisFileNotifaction component, which was
originally written by FIS House and is available on http://www.torry.net.
In 2006 year I could not contact FIS House about their original component,
since their home site www.fishouse.com was down.

Original copyright was:
------------------------------------------------------------------------------
 Unit     : fisFileNotifaction.pas
 Purpose  : File notification component
 Status   :
 Copyright: ©2000 First Internet Software House, http://www.fishouse.com
 Contact  : support@fishouse.com
-------------------------------------------------------------------------------
}

{$BOOLEVAL OFF} //Short boolean evaluation.

unit ATFileNotification;

interface

uses
  Windows, Messages, SysUtils, Classes;

type
  TATFileNotifyOption = (
    foNotifyFilename, 
    foNotifyDirname, //Applies only for a directory
    foNotifyAttributes,
    foNotifySize,
    foNotifyLastWrite,
    foNotifyLastAccess,
    foNotifyCreation,
    foNotifySecurity //Applies only for a directory
    );

  TATFileNotifyOptions = set of TATFileNotifyOption;

const
  cATFileNotifyFlags: array[TATFileNotifyOption] of DWORD = (
    FILE_NOTIFY_CHANGE_FILE_NAME,
    FILE_NOTIFY_CHANGE_DIR_NAME,
    FILE_NOTIFY_CHANGE_ATTRIBUTES,
    FILE_NOTIFY_CHANGE_SIZE,
    FILE_NOTIFY_CHANGE_LAST_WRITE,
    FILE_NOTIFY_CHANGE_LAST_ACCESS,
    FILE_NOTIFY_CHANGE_CREATION,
    FILE_NOTIFY_CHANGE_SECURITY
    );

type
  TATFileNotification = class(TComponent)
  private
    { Private declarations }
    FStarted: Boolean;
    FSubtree: Boolean;
    FOptions: TATFileNotifyOptions;
    FDirectory: WideString;
    FFileName: WideString;
    FOnChanged: TNotifyEvent;
    FDirThread: TThread;
    FLock: TRTLCriticalSection;
    procedure SetDirectory(const ADirectory: WideString);
    procedure SetFileName(const AFileName: WideString);
    procedure SetEnabled(AValue: Boolean);
    procedure FileChanged(Sender: TObject);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
    property Enabled: Boolean read FStarted write SetEnabled;
  published
    { Published declarations }
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
    property Options: TATFileNotifyOptions read FOptions write FOptions default [foNotifyFilename, foNotifyDirname, foNotifyLastWrite];
    property Subtree: Boolean read FSubtree write FSubtree default False;
    property Directory: WideString read FDirectory write SetDirectory;
    property FileName: WideString read FFileName write SetFileName;
  end;

var
  sMsgNotifError: AnsiString = 'Error';
  sMsgNotifExceptionWait: AnsiString = 'Exception while waiting for notification';
  sMsgNotifExceptionCreate: AnsiString = 'Exception while creating thread';
  sMsgNotifExceptionTerminate: AnsiString = 'Exception while terminating thread';

procedure Register;


implementation

{ Helper thread class }

type
  TDirThread = class(TThread)
  private
    prDirectory: WideString;
    prFileName: WideString;
    prKillEvent: THandle;
    prSubtree: Boolean;
    prNotifyFilter: DWORD;
    prFileChanged: TNotifyEvent;
  protected
    procedure Execute; override;
  public
    constructor Create(const ADirectory, AFileName: WideString;
                       ASubtree: Boolean;
                       ANotifyFilter: DWORD;
                       AFileChanged: TNotifyEvent);
    destructor Destroy; override;
  end;


{ Helper functions }

type
  TFileRec = record
    FExist: Boolean;
    FSizeLow,
    FSizeHigh: DWORD;
    FAttr: DWORD;
    FTimeWr,
    FTimeCr,
    FTimeAcc: TFileTime;
  end;

procedure FGetFileRec(const FileName: WideString; var Rec: TFileRec);
var
  h: THandle;
  fdA: TWin32FindDataA;
  fdW: TWin32FindDataW;
begin
  FillChar(Rec, SizeOf(Rec), 0);
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    h := FindFirstFileW(PWideChar(FileName), fdW);
    Rec.FExist := h <> INVALID_HANDLE_VALUE;
    if Rec.FExist then
    begin
      Rec.FSizeLow := fdW.nFileSizeLow;
      Rec.FSizeHigh := fdW.nFileSizeHigh;
      Rec.FAttr := fdW.dwFileAttributes;
      Rec.FTimeWr := fdW.ftLastWriteTime;
      Rec.FTimeCr := fdW.ftCreationTime;
      Rec.FTimeAcc := fdW.ftLastAccessTime;
      Windows.FindClose(h);
    end;
  end
  else
  begin
    h := FindFirstFileA(PAnsiChar(AnsiString(FileName)), fdA);
    Rec.FExist := h <> INVALID_HANDLE_VALUE;
    if Rec.FExist then
    begin
      Rec.FSizeLow := fdA.nFileSizeLow;
      Rec.FSizeHigh := fdA.nFileSizeHigh;
      Rec.FAttr := fdA.dwFileAttributes;
      Rec.FTimeWr := fdA.ftLastWriteTime;
      Rec.FTimeCr := fdA.ftCreationTime;
      Rec.FTimeAcc := fdA.ftLastAccessTime;
      Windows.FindClose(h);
    end;
  end;
end;

function FTimesDif(const Time1, Time2: TFileTime): Boolean;
begin
  Result :=
    (Time1.dwLowDateTime <> Time2.dwLowDateTime) or
    (Time1.dwHighDateTime <> Time2.dwHighDateTime);
end;

function FFileChanged(const FileName: WideString; Filter: DWORD; var OldRec: TFileRec): Boolean;
var
  NewRec: TFileRec;
begin
  FGetFileRec(FileName, NewRec);

  Result :=
    ( OldRec.FExist <> NewRec.FExist ) or
    ( ((Filter and FILE_NOTIFY_CHANGE_ATTRIBUTES) <> 0) and (OldRec.FAttr <> NewRec.FAttr) ) or
    ( ((Filter and FILE_NOTIFY_CHANGE_SIZE) <> 0) and ((OldRec.FSizeLow <> NewRec.FSizeLow) or (OldRec.FSizeHigh <> NewRec.FSizeHigh)) ) or
    ( ((Filter and FILE_NOTIFY_CHANGE_LAST_WRITE) <> 0) and FTimesDif(OldRec.FTimeWr, NewRec.FTimeWr) ) or
    ( ((Filter and FILE_NOTIFY_CHANGE_LAST_ACCESS) <> 0) and FTimesDif(OldRec.FTimeAcc, NewRec.FTimeAcc) ) or
    ( ((Filter and FILE_NOTIFY_CHANGE_CREATION) <> 0) and FTimesDif(OldRec.FTimeCr, NewRec.FTimeCr) );

  if Result then
    Move(NewRec, OldRec, SizeOf(TFileRec));
end;

function FNotifyOptionsToFlags(Options: TATFileNotifyOptions): DWORD;
var
  Opt: TATFileNotifyOption;
begin
  Result := 0;
  for Opt := Low(TATFileNotifyOption) to High(TATFileNotifyOption) do
    if Opt in Options then
      Inc(Result, cATFileNotifyFlags[Opt]);
end;

procedure MsgErr(const S: AnsiString);
begin
  MessageBoxA(0, PAnsiChar(S), PAnsiChar(sMsgNotifError), MB_OK or MB_ICONERROR or MB_APPLMODAL);
end;

{ Unicode versions of SysUtils' functions }

function LastDelimiter(const Delimiters, S: WideString): Integer;
var
  i: Integer;
begin
  for i := Length(S) downto 1 do
    if Pos(S[i], Delimiters) > 0 then
      begin Result := i; Exit end;
  Result := 0;
end;

function SExtractFileDir(const FileName: WideString): WideString;
var
  I: Integer;
begin
  I := LastDelimiter('\:', FileName);
  if (I > 1) and (FileName[I] = '\') 
    then Dec(I);
  Result := Copy(FileName, 1, I);
end;

{
function SExtractFilePath(const FileName: WideString): WideString;
var
  I: Integer;
begin
  I := LastDelimiter('\:', FileName);
  Result := Copy(FileName, 1, I);
end;
}


{ TDirThread }

constructor TDirThread.Create(const ADirectory, AFileName: WideString;
  ASubtree: Boolean; ANotifyFilter: DWORD; AFileChanged: TNotifyEvent);
begin
  inherited Create(False);
  prKillEvent := CreateEvent(nil, False, False, nil);
  prDirectory := ADirectory;
  prFileName := AFileName;
  prSubtree := ASubtree;
  prNotifyFilter := ANotifyFilter;
  prFileChanged := AFileChanged;
end;

destructor TDirThread.Destroy;
begin
  SetEvent(prKillEvent);
  CloseHandle(prKillEvent);
  inherited;
end;

procedure TDirThread.Execute;
var
  ObjList: array[0..1] of THandle;
  NotifyRes: THandle;
  ADir: WideString;
  ASubtree: Boolean;
  AFilter: DWORD;
  AFileRec: TFileRec;
  IsFile: Boolean;
begin
  FillChar(AFileRec, SizeOf(TFileRec), 0);

  IsFile := prFileName <> '';
  if IsFile then
  begin
    ADir := SExtractFileDir(prFileName);
    if (ADir <> '') and (ADir[Length(ADir)] = ':') then
      ADir := ADir + '\'; //Handle the case of 'C:\Filename'
    ASubtree := False;
    AFilter := prNotifyFilter and (not (FILE_NOTIFY_CHANGE_DIR_NAME or FILE_NOTIFY_CHANGE_SECURITY));
    FGetFileRec(prFileName, AFileRec);
  end
  else
  begin
    ADir := prDirectory;
    ASubtree := prSubtree;
    AFilter := prNotifyFilter;
  end;

  //Create notification
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    NotifyRes := FindFirstChangeNotificationW(PWideChar(ADir), ASubtree, AFilter)
  else
    NotifyRes := FindFirstChangeNotificationA(PAnsiChar(AnsiString(ADir)), ASubtree, AFilter);

  ObjList[0] := prKillEvent;
  ObjList[1] := NotifyRes;

  //Wait
  if (NotifyRes <> INVALID_HANDLE_VALUE) then
  try
    repeat
      if Terminated or //In some unknown circumstances signaling through prKillEvent may not work,
                       //so there is additional check for Terminated to stop thread
                       //during inherited TThread.Destroy.
        (WaitForMultipleObjects(2, @ObjList, False, INFINITE) = WAIT_OBJECT_0) then
      begin
        Break;
      end;
      if (not IsFile) or (FFileChanged(prFileName, AFilter, AFileRec)) then
      begin
        if Assigned(prFileChanged) then
          prFileChanged(Self);
      end;
    until not FindNextChangeNotification(ObjList[1]);
    FindCloseChangeNotification(ObjList[1]);
  except
    MsgErr(sMsgNotifExceptionWait);
  end;
end;


{ TATFileNotification }

constructor TATFileNotification.Create(AOwner: TComponent);
begin
  inherited;
  FStarted := False;
  FSubtree := False;
  FDirectory := '';
  FFileName := '';
  FOptions := [foNotifyFilename, foNotifyDirname, foNotifyLastWrite];
  InitializeCriticalSection(FLock);
end;

destructor TATFileNotification.Destroy;
begin
  if not (csDesigning in ComponentState) then
  begin
    Stop;
  end;
  DeleteCriticalSection(FLock);
  inherited;
end;

procedure TATFileNotification.FileChanged(Sender: TObject);
begin
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

procedure TATFileNotification.Start;
begin
  try
    EnterCriticalSection(FLock);
    try
      if (not FStarted) then
      begin
        FDirThread := TDirThread.Create(FDirectory, FFileName, FSubtree,
          FNotifyOptionsToFlags(FOptions), FileChanged);
        FStarted := True;
      end;
    finally
      LeaveCriticalSection(FLock);
    end;
  except
    MsgErr(sMsgNotifExceptionCreate);
  end;
end;

procedure TATFileNotification.Stop;
begin
  try
    EnterCriticalSection(FLock);
    try
      if FStarted then
      begin
        if Assigned(FDirThread) then
        begin
          FDirThread.Free;
          FDirThread := nil;
        end;
        FStarted := False;
      end;
    finally
      LeaveCriticalSection(FLock);
    end;
  except
    MsgErr(sMsgNotifExceptionTerminate);
  end;
end;

procedure TATFileNotification.SetDirectory(const ADirectory: WideString);
begin
  if ADirectory <> FDirectory then
  begin
    FDirectory := ADirectory;
    FFileName := '';
  end;
end;

procedure TATFileNotification.SetFileName(const AFileName: WideString);
begin
  if AFileName <> FFileName then
  begin
    FDirectory := '';
    FFileName := AFileName;
  end;
end;

procedure TATFileNotification.SetEnabled(AValue: Boolean);
begin
  if AValue <> FStarted then
  begin
    if AValue then
      Start
    else
      Stop;
  end;
end;

{ Registration }

procedure Register;
begin
  RegisterComponents('Samples', [TATFileNotification]);
end;

end.

Open in new window

0
 
LVL 5

Expert Comment

by:briangochnauer
ID: 34252325
I just loaded it in Delphi XE compiled the demo and it worked fine both dir and file.
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Suggested Courses
Course of the Month11 days, 5 hours left to enroll

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question