Solved

ATFileNotification problem

Posted on 2010-11-30
7
714 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
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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:
ewangoya earned 500 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
proper way to parse text with delphi 7 101
Delphi cmd execution 6 56
Working with hours 3 46
Reconfigure Delphi Install? 2 46
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Video by: Mark
This lesson goes over how to construct ordered and unordered lists and how to create hyperlinks.
Both in life and business – not all partnerships are created equal. As the demand for cloud services increases, so do the number of self-proclaimed cloud partners. Asking the right questions up front in the partnership, will enable both parties …

896 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

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now