FileGuard/MultiDirsChange.pas

   1 unit MultiDirsChange;
   2
   3 interface
   4
   5 uses Windows, KOL;
   6
   7 const
   8   MaxDirsChange = MAXIMUM_WAIT_OBJECTS;
   9
  10 type
  11   TOnDirectoryChange = procedure( Sender: PObj; const Path: String ) of object;
  12
  13   PMultiDirsChange = ^TMultiDirsChange;
  14   TMultiDirsChange = object( TObj )
  15   protected
  16     FOnChange: TOnDirectoryChange;
  17     FThread: PThread;
  18     function GetPaths( Index: Integer ): String;
  19     procedure SetPaths( Index: Integer; const Value: String);
  20   protected
  21     FPaths: array[ 0..MaxDirsChange-1 ] of String;
  22     FHandles: array[ 0..MaxDirsChange-1 ] of THandle;
  23     FDelHandles: PList;
  24     FFilter: DWORD;
  25     FDeactivate: Boolean;
  26     procedure Init; virtual;
  27     function ExecuteThread( Sender: PThread ): Integer;
  28     procedure CloseQuied;
  29     procedure FolderChanged( Sender: PThread; P: Pointer );
  30   public
  31     property Paths[ Idx: Integer ]: String read GetPaths write SetPaths;
  32     destructor Destroy; virtual;
  33     function Active: Boolean;
  34     function PathsMonitored: Integer;
  35     procedure Clear;
  36   end;
  37
  38 function NewMultiDirChange( OnChange: TOnDirectoryChange; Filter: DWORD ): PMultiDirsChange;
  39
  40 type
  41   PAnyDirsChange = ^TAnyDirsChange;
  42   TAnyDirsChange = object( TObj )
  43   protected
  44     FDirs: PStrListEx;
  45     FNotifiers: PList;
  46     FOnChange: TOnDirectoryChange;
  47     FFilter: DWORD;
  48     function GetCount: Integer;
  49     function GetPaths(Idx: Integer): String;
  50     procedure FolderChanged( Sender: PObj; const Path: String );
  51     procedure Init; virtual;
  52   public
  53     destructor Destroy; virtual;
  54     property Paths[ Idx: Integer ]: String read GetPaths;
  55     property Count: Integer read GetCount;
  56     procedure Add( const Path: String );
  57     procedure Remove( const Path: String ); overload;
  58     procedure Remove( Idx: Integer ); overload;
  59     procedure Clear;
  60   end;
  61
  62 function NewAnyDirsChange( OnChange: TOnDirectoryChange; Filter: DWORD ): PAnyDirsChange;
  63
  64 implementation
  65
  66 function NewMultiDirChange( OnChange: TOnDirectoryChange; Filter: DWORD ): PMultiDirsChange;
  67 begin
  68   new( Result, Create );
  69   Result.FOnChange := OnChange;
  70   if Filter = 0 then
  71     Filter := FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME or
  72               FILE_NOTIFY_CHANGE_ATTRIBUTES or FILE_NOTIFY_CHANGE_SIZE or
  73               FILE_NOTIFY_CHANGE_LAST_WRITE;
  74   Result.FFilter := Filter;
  75 end;
  76
  77 function NewAnyDirsChange( OnChange: TOnDirectoryChange; Filter: DWORD ): PAnyDirsChange;
  78 begin
  79   new( Result, Create );
  80   Result.FOnChange := OnChange;
  81   if Filter = 0 then
  82     Filter := FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME or
  83               FILE_NOTIFY_CHANGE_ATTRIBUTES or FILE_NOTIFY_CHANGE_SIZE or
  84               FILE_NOTIFY_CHANGE_LAST_WRITE;
  85   Result.FFilter := Filter;
  86 end;
  87
  88 { TMultiDirsChange }
  89
  90 function TMultiDirsChange.Active: Boolean;
  91 begin
  92   Result := FThread <> nil;
  93 end;
  94
  95 procedure TMultiDirsChange.Clear;
  96 begin
  97
  98 end;
  99
 100 procedure TMultiDirsChange.CloseQuied;
 101 begin
 102   while FDelHandles.Count > 0 do
 103   begin
 104     FindCloseChangeNotification( THandle( FDelHandles.Items[ 0 ] ) );
 105     FDelHandles.Delete( 0 );
 106   end;
 107 end;
 108
 109 destructor TMultiDirsChange.Destroy;
 110 begin
 111   FThread.Free;
 112   Clear;
 113   CloseQuied;
 114   FDelHandles.Free;
 115   inherited;
 116 end;
 117
 118 function TMultiDirsChange.ExecuteThread( Sender: PThread ): Integer;
 119 var WaitHandles: array[ 0..MaxDirsChange-1 ] of THandle;
 120     N, I: Integer;
 121     R: Integer;
 122 begin
 123   Result := 0;
 124   while (PathsMonitored > 0) and (Applet <> nil) and not AppletTerminated do
 125   begin
 126     N := 0;
 127     for I := 0 to High( FPaths ) do
 128     begin
 129       if FHandles[ I ] <> 0 then
 130       begin
 131         WaitHandles[ N ] := FHandles[ I ];
 132         Inc( N );
 133       end;
 134     end;
 135     if N > 0 then
 136     begin
 137       R := WaitForMultipleObjects( N, @ WaitHandles[ 0 ], FALSE, 100 );
 138       if (R >= WAIT_OBJECT_0) and (R < WAIT_OBJECT_0 + N) then
 139       begin
 140         for I := 0 to High( FHandles ) do
 141           if FHandles[ I ] = WaitHandles[ R - WAIT_OBJECT_0 ] then
 142           begin
 143             if (Applet <> nil) and not AppletTerminated then
 144             begin
 145               if Assigned( FOnChange ) then
 146                 Sender.SynchronizeEx( FolderChanged, @ I );
 147               FindNextChangeNotification( FHandles[ I ] );
 148             end
 149               else Exit;
 150             break;
 151           end;
 152       end;
 153     end
 154       else Sleep( 100 );
 155     CloseQuied;
 156   end;
 157 end;
 158
 159 procedure TMultiDirsChange.FolderChanged(Sender: PThread; P: Pointer);
 160 var I: Integer;
 161 begin
 162   I := PInteger( P )^;
 163   if (I >= 0) and (I < MaxDirsChange) and Assigned( FOnChange ) then
 164     FOnChange( @ Self, FPaths[ I ] );
 165 end;
 166
 167 function TMultiDirsChange.GetPaths( Index: Integer ): String;
 168 begin
 169   Result := FPaths[ Index ];
 170 end;
 171
 172 procedure TMultiDirsChange.Init;
 173 begin
 174   FDelHandles := NewList;
 175 end;
 176
 177 function TMultiDirsChange.PathsMonitored: Integer;
 178 var I: Integer;
 179 begin
 180   Result := 0;
 181   for I := 0 to High( FPaths ) do
 182     if FPaths[ I ] <> '' then Inc(Result);
 183 end;
 184
 185 procedure TMultiDirsChange.SetPaths( Index: Integer; const Value: String);
 186 begin
 187   FPaths[ Index ] := Value;
 188   if FHandles[ Index ] <> 0 then
 189     FDelHandles.Add( Pointer( FHandles[ Index ] ) );
 190   FHandles[ Index ] := 0;
 191   if Value <> '' then
 192   begin
 193     FHandles[ Index ] := FindFirstChangeNotification( PChar( FPaths[ Index ] ),
 194       FALSE, FFilter );
 195   end;
 196   if (FThread <> nil) and FThread.Terminated then
 197     Free_And_Nil( FThread );
 198   if (FThread = nil) and (PathsMonitored > 0) then
 199   begin
 200     FThread := NewThread;
 201     FThread.OnExecute := ExecuteThread;
 202     FThread.Resume;
 203   end;
 204 end;
 205
 206 { TAnyDirsChange }
 207
 208 procedure TAnyDirsChange.Add(const Path: String);
 209 var I, J, E: Integer;
 210     D, D0: PMultiDirsChange;
 211 begin
 212   D0 := nil;
 213   E := -1;
 214   for I := 0 to FNotifiers.Count-1 do
 215   begin
 216     D := FNotifiers.Items[ I ];
 217     for J := 0 to MaxDirsChange-1 do
 218       if AnsiEq( D.Paths[ J ], Path ) then
 219         Exit // íå íàäî äîáàâëÿòü - óæå åñòü òàêàÿ
 220       else
 221       if (D0 = nil) and (D.Paths[ J ] = '') then
 222       begin
 223         D0 := D; E := J;
 224       end;
 225   end;
 226   if D0 = nil then
 227   begin
 228     E := 0;
 229     D0 := NewMultiDirChange( FolderChanged, FFilter );
 230     FNotifiers.Add( D0 );
 231   end;
 232   FDirs.AddObject( Path, DWORD( D0 ) );
 233   D0.Paths[ E ] := Path;
 234 end;
 235
 236 function TAnyDirsChange.GetCount: Integer;
 237 begin
 238   Result := FDirs.Count;
 239 end;
 240
 241 function TAnyDirsChange.GetPaths(Idx: Integer): String;
 242 begin
 243   Result := FDirs.Items[ Idx ];
 244 end;
 245
 246 procedure TAnyDirsChange.Remove(const Path: String);
 247 var I: Integer;
 248 begin
 249   I := FDirs.IndexOf( Path );
 250   if I >= 0 then
 251     Remove( I );
 252 end;
 253
 254 procedure TAnyDirsChange.Init;
 255 begin
 256   FDirs := NewStrListEx;
 257   FNotifiers := NewList;
 258 end;
 259
 260 procedure TAnyDirsChange.Remove(Idx: Integer);
 261 var D: PMultiDirsChange;
 262     I: Integer;
 263 begin
 264   D := Pointer( FDirs.Objects[ Idx ] );
 265   for I := 0 to MaxDirsChange-1 do
 266     if AnsiEq( D.Paths[ I ], FDirs.Items[ Idx ] ) then
 267     begin
 268       D.Paths[ I ] := '';
 269       break;
 270     end;
 271 end;
 272
 273 destructor TAnyDirsChange.Destroy;
 274 begin
 275   FDirs.Free;
 276   FNotifiers.ReleaseObjects;
 277   inherited;
 278 end;
 279
 280 procedure TAnyDirsChange.FolderChanged(Sender: PObj; const Path: String);
 281 var I: Integer;
 282     found: Boolean;
 283 begin
 284   found := FALSE;
 285   for I := 0 to FDirs.Count-1 do
 286     if AnsiEq( FDirs.Items[ I ], Path ) then
 287     begin
 288       found := TRUE; break;
 289     end;
 290   if not found then Exit;
 291   if Assigned( FOnChange ) then
 292     FOnChange( @ Self, Path );
 293 end;
 294
 295 procedure TAnyDirsChange.Clear;
 296 var I: Integer;
 297     D: PMultiDirsChange;
 298 begin
 299   for I := 0 to FNotifiers.Count-1 do
 300   begin
 301     D := FNotifiers.Items[ I ];
 302     D.Clear;
 303   end;
 304 end;
 305
 306 end.