dirnotify.pas

一个Delphi库

unit dirnotify;

interface

uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs;

type
  EDirNotificationError = class(Exception);

  TDirNotify = class;
  TNotifyFilter = (nfFileName, nfDirName, nfAttributes, nfSize, nfLastWrite,
    nfSecurity);
  TNotifyFilters = set of TNotifyFilter;

  TNotificationThread = class(TThread)
    Owner: TDirNotify;
    procedure Execute; override;
    procedure DoChange;
  end;

  TDirNotify = class(TComponent)
  private
    FEnabled: Boolean;
    FOnChange: TNotifyEvent;
    FNotificationThread: TNotificationThread;
    FPath: String;
    FWatchSubTree: Boolean;
    FFilter: TNotifyFilters;

    procedure SetEnabled( Value: Boolean );
    procedure SetOnChange( Value: TNotifyEvent );
    procedure SetPath( Value: String );
    procedure SetWatchSubTree( Value: Boolean );
    procedure SetFilter( Value: TNotifyFilters );

    procedure RecreateThread;

  protected
    procedure Change;
    procedure Loaded; override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property OnChange: TNotifyEvent read FOnChange write SetOnChange;
    property Path: String read FPath write SetPath;
    property WatchSubTree: Boolean read FWatchSubTree write SetWatchSubTree;
    property Filter: TNotifyFilters read FFilter write SetFilter default [nfFileName, nfDirName, nfAttributes, nfLastWrite, nfSecurity];
  end;


procedure Register;

implementation

const
  LASTERRORTEXTLENGTH = 500;

var
  LastErrorText: array [0..LASTERRORTEXTLENGTH] of char;


function GetLastErrorText: PChar;
begin
  FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM,
    nil, GetLastError, 0, LastErrorText, LASTERRORTEXTLENGTH, nil );
  Result := LastErrorText;
end;


procedure TNotificationThread.Execute;
var
  h: THandle;
  nf: Longint;
  wst: LongBool;
begin
  nf := 0;
  if (nfFileName in Owner.Filter) then nf := FILE_NOTIFY_CHANGE_FILE_NAME;
  if (nfDirName in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_DIR_NAME;
  if (nfAttributes in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_ATTRIBUTES;
  if (nfSize in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_SIZE;
  if (nfLastWrite in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_LAST_WRITE;
  if (nfSecurity in Owner.Filter) then nf := nf or FILE_NOTIFY_CHANGE_SECURITY;

  // yeahh, this one is stupid but Win98 malfunctions in any other value than 0 or 1
  if Owner.FWatchSubTree then wst := Longbool(1)
  else wst := Longbool(0);

  h := FindFirstChangeNotification( Pointer(Owner.Path), wst, nf );
  if (h = INVALID_HANDLE_VALUE) then
    raise EDirNotificationError.Create( GetLastErrorText );

  repeat
    if (WaitForSingleObject( h, 1000 ) = WAIT_OBJECT_0) then
    begin
      Synchronize(DoChange);

      if not FindNextChangeNotification( h ) then
        raise EDirNotificationError.Create( GetLastErrorText );
    end;
  until Terminated;
end;


procedure TNotificationThread.DoChange;
begin
   Owner.Change;
end;


constructor TDirNotify.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FEnabled := True;
  FFilter := [nfFileName];
end;


destructor TDirNotify.Destroy;
begin
  FNotificationThread.Free;
  inherited Destroy;
end;

procedure TDirNotify.Loaded;
begin
  inherited;

  RecreateThread;
end;


procedure TDirNotify.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;

    RecreateThread;
  end;
end;


procedure TDirNotify.SetPath( Value: String );
begin
  if Value <> FPath then
  begin
    FPath := Value;
    RecreateThread;
  end;
end;


procedure TDirNotify.SetWatchSubTree( Value: Boolean );
begin
  if Value <> FWatchSubTree then
  begin
    FWatchSubTree := Value;
    RecreateThread;
  end;
end;


procedure TDirNotify.SetFilter( Value: TNotifyFilters );
begin
  if Value <> FFilter then
  begin
    FFilter := Value;
    RecreateThread;
  end;
end;


procedure TDirNotify.SetOnChange(Value: TNotifyEvent);
begin
   FOnChange := Value;
end;


procedure TDirNotify.Change;
begin
   if Assigned(FOnChange) then
      FOnChange(Self);
end;


procedure TDirNotify.RecreateThread;
begin
  // destroy thread
  FNotificationThread.Free;
  FNotificationThread := nil;

  if FEnabled and not(csDesigning in ComponentState)
    and not(csLoading in ComponentState) and (FPath <> '') then
  begin
    // create thread
    FNotificationThread := TNotificationThread.Create(True);
    FNotificationThread.Owner := self;
    FNotificationThread.Resume;
  end;
end;


procedure Register;
begin
   RegisterComponents('System', [TDirNotify]);
end;

end.