1unit dirwatch; 2{$IFDEF LINUX} 3{$DEFINE USEINOTIFY} 4{$ELSE} 5{$DEFINE USEGENERIC} 6{$ENDIF} 7 8{$mode objfpc}{$H+} 9 10interface 11 12uses 13 Classes, SysUtils, 14{$IFDEF UNIX} 15 baseunix, 16{$IFDEF USEINOTIFY} 17 ctypes, 18 linux, 19{$ENDIF} 20{$ENDIF} 21 contnrs; 22 23 24 25Type 26 TFileEvent = (feModify,feAttrib,feCreate,feDelete); 27 TFileEvents = set of TFileEvent; 28 29 { TDirectoryEntry } 30 TDirectoryEntry = Class(TCollectionItem) 31 private 32 FEvents: TFileEvents; 33 FName: String; 34 FAttributes: Integer; 35{$IFDEF UNIX} 36 FGroup: gid_t; 37 FMode: mode_t; 38 FOwner: uid_t; 39{$ENDIF} 40 FSize: Int64; 41 FTimeStamp: TDateTime; 42 Protected 43{$IFDEF USEGENERIC} 44 procedure InitWatch(ABaseDir: String; AList: TFPStringHashTable); 45{$ENDIF} 46 Public 47 Property TimeStamp : TDateTime Read FTimeStamp Write FTimeStamp; 48 Property Size : Int64 Read FSize Write FSize; 49 Property Attributes : Integer Read FAttributes Write FAttributes; 50{$IFDEF UNIX} 51 Property Mode : mode_t Read FMode Write FMode; 52 Property Owner : uid_t Read FOwner Write FOwner; 53 Property Group : gid_t Read FGroup Write FGroup; 54{$ENDIF} 55 Published 56 Property Name : String Read FName Write FName; 57 Property Events : TFileEvents Read FEvents Write FEvents; 58 end; 59 60 { TDirectoryEntries } 61 62 TDirectoryEntries = Class(TCollection) 63 private 64 function GetE(AIndex : Integer): TDirectoryEntry; 65 procedure SetE(AIndex : Integer; AValue: TDirectoryEntry); 66 Public 67 Function IndexOfEntry(Const AName : String) : Integer; 68 Function EntryByName(Const AName : String) : TDirectoryEntry; 69 Function AddEntry(Const AName : String) : TDirectoryEntry; 70 Property Entries[AIndex : Integer] : TDirectoryEntry Read GetE Write SetE; default; 71 end; 72 73 TFileEventHandler = procedure (Sender : TObject; aEntry : TDirectoryEntry; AEvents : TFileEvents) of Object; 74 75 { TDirwatch } 76 77 TDirwatch = Class(TComponent) 78 private 79 FIdleInterval: Cardinal; 80 FOnIdle: TNotifyEvent; 81 FOnIdleNotify: TNotifyEvent; 82 FTerminated: Boolean; 83 FThreaded: Boolean; 84 FWatches: TDirectoryEntries; 85 FBaseDir: String; 86 FOnChange: TFileEventHandler; 87{$IFDEF USEGENERIC} 88 FReference : TFPStringHashTable; 89 FOldReference : TFPStringHashTable; 90 procedure DoCheckItem(Item: String; const Key: string; var Continue: Boolean); 91 procedure DoDeletedItem(Item: String; const Key: string; var Continue: Boolean); 92{$ENDIF} 93{$IFDEF USEINOTIFY} 94 FINotifyFD : Cint; 95{$ENDIF} 96 function DirectoryEntryForFileName(S: String): TDirectoryEntry; 97 procedure DoChangeEvent(Entry: TDirectoryEntry; Events: TFileEvents); 98 procedure SetBaseDir(AValue: String); 99 Protected 100 procedure DoIdle; virtual; 101 procedure Check; virtual; 102 procedure DoneWatch; virtual; 103 procedure DoStartWatch; virtual; 104 procedure InitWatch;virtual; 105 Public 106 Constructor Create(AOWner : TComponent); override; 107 Destructor Destroy; override; 108 Procedure StartWatch; 109 Procedure AddWatch(const aFileName : string; aEvents : TFileEvents); 110 Procedure Terminate; 111 Property Terminated : Boolean Read FTerminated; 112 Published 113 Property BaseDir : String read FBaseDir Write SetBaseDir; 114 Property OnChange : TFileEventHandler Read FOnChange Write FOnChange; 115 Property Threaded : Boolean Read FThreaded Write FThreaded; 116 Property Watches : TDirectoryEntries Read FWatches Write FWatches; 117 Property OnIdle : TNotifyEvent Read FOnIdle Write FOnIdleNotify; 118 Property IdleInterval : Cardinal Read FIdleInterval Write FIdleInterval; 119 end; 120 121Const 122 EventNames : Array[TFileEvent] of string = ('Modify','Attrib','Create','Delete'); 123 AllEvents = [feModify,feAttrib,feCreate,feDelete]; 124 125Function FileEventsToStr(Events : TFileEvents) : String; 126 127implementation 128 129 130Function FileEventsToStr(Events : TFileEvents) : String; 131 132Var 133 E : TFileEvent; 134 135begin 136 Result:=''; 137 for E in Events do 138 begin 139 if Result<>'' then 140 Result:=Result+','; 141 Result:=Result+EventNames[E]; 142 end; 143 144end; 145 146{ TDirwatch } 147Type 148 149 { TDirwatchThread } 150 151 TDirwatchThread = class(TThread) 152 Private 153 FDir:TDirWatch; 154 Public 155 Constructor Create(ADirwatch : TDirWatch); 156 Procedure Execute; override; 157 end; 158 159{ TDirectoryEntry } 160 161Function SearchRecToString(Info : TSearchRec; AEvents : TFileEvents) : String; 162 163begin 164 if feAttrib in AEvents then 165 Result:=IntToStr(Info.Attr) 166 else 167 Result:=''; 168 Result:=Result+';'+IntToStr(Info.Size)+';'+IntToStr(Info.Time); 169end; 170 171{$IFDEF USEGENERIC} 172procedure TDirectoryEntry.InitWatch(ABaseDir: String; AList: TFPStringHashTable); 173 174Var 175 Info : TSearchRec; 176 FN : String; 177 178begin 179 if (ABaseDir<>'') then 180 FN:=IncludeTrailingPathDelimiter(ABaseDir)+Name 181 else 182 FN:=Name; 183 if FindFirst(FN,faAnyFile,Info)=0 then 184 begin 185 if (faDirectory and Info.Attr) = 0 then 186 begin 187 AList.Add(FN,SearchRecToString(Info,Self.Events)) 188 end 189 else 190 begin 191 FindClose(Info); 192 FN:=IncludeTrailingPathDelimiter(FN); 193 if FindFirst(FN+AllFilesMask,0,Info)=0 then 194 Repeat 195 if (info.Name<>'.') and (Info.Name<>'..') then 196 AList.Add(FN+Info.Name,SearchRecToString(Info,Self.Events)); 197 until (FindNext(Info)<>0) 198 end; 199 FindClose(Info); 200 end 201end; 202 203{$ENDIF} 204{$IFDEF USEINOTIFY} 205 206{$ENDIF} 207{ TDirwatchThread } 208 209constructor TDirwatchThread.Create(ADirwatch: TDirWatch); 210 211begin 212 FDir:=ADirWatch; 213 FreeOnTerminate:=True; 214 inherited create(False); 215end; 216 217procedure TDirwatchThread.Execute; 218begin 219 FDir.DoStartWatch; 220end; 221 222 223procedure TDirwatch.SetBaseDir(AValue: String); 224begin 225 if FBaseDir=AValue then Exit; 226 FBaseDir:=AValue; 227 FWatches.Clear; 228end; 229 230constructor TDirwatch.Create(AOWner: TComponent); 231begin 232 inherited Create(AOWner); 233 FWatches:=TDirectoryEntries.Create(TDirectoryEntry); 234 FidleInterval:=100; 235end; 236 237destructor TDirwatch.Destroy; 238begin 239 FreeAndNil(FWatches); 240 inherited Destroy; 241end; 242 243Type 244 { TDirwatchChange } 245 TDirwatchChange = Class 246 FEntry : TDirectoryEntry; 247 FEvents : TFileEvents; 248 FDirWatch : TDirWatch; 249 Constructor Create(AEntry : TDirectoryEntry;aEvents : TFileEvents;ADirWatch : TDirWatch); 250 Procedure DoEvent; 251 end; 252 253{ TDirwatchChange } 254 255constructor TDirwatchChange.Create(AEntry: TDirectoryEntry; aEvents: TFileEvents; ADirWatch: TDirWatch); 256 257begin 258 FEntry:=AEntry; 259 FEvents:=AEvents; 260 FDirWatch:=ADirWatch; 261end; 262 263procedure TDirwatchChange.DoEvent; 264begin 265 FDirwatch.FonChange(FDirwatch,FEntry,FEvents); 266end; 267 268Procedure TDirwatch.DoChangeEvent(Entry : TDirectoryEntry; Events : TFileEvents); 269 270Var 271 W : TDirWatchChange; 272 273begin 274 try 275 if Assigned(FOnChange) then 276 if Not Threaded then 277 FonChange(Self,Entry,Events) 278 else 279 begin 280 W:=TDirWatchChange.Create(Entry,Events,Self); 281 try 282 TThread.Synchronize(TThread.CurrentThread,@W.DoEvent) 283 finally 284 W.Free; 285 end; 286 end 287 Finally 288 // Specially created 289 if Entry.Collection=Nil then 290 FreeAndNil(Entry); 291 end; 292end; 293 294 295procedure TDirwatch.DoIdle; 296 297begin 298 if Assigned(FOnIdle) then 299 FOnIdle(Self); 300end; 301 302Function TDirwatch.DirectoryEntryForFileName(S : String) : TDirectoryEntry; 303 304begin 305 Result:=FWatches.EntryByName(S); 306 if (Result=Nil) then 307 Result:=FWatches.EntryByName(ExtractFilePath(S)); 308 if (Result=Nil) then 309 begin 310 Result:=TDirectoryEntry.Create(Nil); 311 Result.Name:=S; 312 end; 313end; 314 315{$IFDEF USEGENERIC} 316procedure TDirwatch.DoneWatch; 317 318begin 319 FreeAndNil(FReference); 320end; 321 322procedure TDirwatch.InitWatch; 323 324Var 325 I : Integer; 326 327begin 328 FReference:=TFPStringHashTable.Create; 329 For I:=0 to FWatches.Count-1 do 330 FWatches[i].InitWatch(BaseDir,FReference); 331end; 332 333procedure TDirwatch.DoDeletedItem(Item: String; const Key: string; var Continue: Boolean); 334 335Var 336 DE : TDirectoryEntry; 337 338begin 339 DE:=FWatches.EntryByName(Key); 340 if (DE=Nil) then 341 DE:=FWatches.EntryByName(ExtractFilePath(Key)); 342 if (DE=Nil) then 343 begin 344 DE:=TDirectoryEntry.Create(Nil); 345 DE.Name:=Key; 346 end; 347 DoChangeEvent(DE,[feDelete]); 348 Continue:=False; 349end; 350 351procedure TDirwatch.DoCheckItem(Item: String; const Key: string; var Continue: Boolean); 352 353Var 354 S : String; 355 E : TFileEvents; 356 DE : TDirectoryEntry; 357 358begin 359// Writeln('check file: ',key,' attrs : ',Item); 360 E:=[]; 361 S:=FOldReference[Key]; 362 if (S='') then 363 E:=[feCreate] 364 else 365 begin 366 FOldReference.Delete(Key); 367 if (S<>Item) then 368 E:=[feAttrib]; 369 end; 370 if E<>[] then 371 begin 372 DE:=DirectoryEntryForFileName(Key); 373 DoChangeEvent(DE,E); 374 Continue:=False; 375 end; 376end; 377 378procedure TDirwatch.Check; 379 380begin 381 FOldReference:=FReference; 382 try 383 FReference:=TFPStringHashTable.Create; 384 InitWatch; 385 FReference.Iterate(@doCheckItem); 386 if FoldReference.Count>0 then 387 FReference.Iterate(@doDeletedItem); 388 // Deleted files 389 Sleep(IdleInterval); 390 finally 391 FreeAndNil(FoldReference); 392 end; 393end; 394{$ENDIF} 395 396{$IFDEF USEINOTIFY} 397Procedure WatchDirectory(d : string); 398 399Const 400 Events = IN_MODIFY or IN_ATTRIB or IN_CREATE or IN_DELETE; 401 402Var 403 fd, wd,fnl,len : cint; 404 fds : tfdset; 405 e : ^inotify_event; 406 buf : Array[0..1023*4] of Byte; // 4K Buffer 407 fn : string; 408 p : pchar; 409 410begin 411 fd:=inotify_init; 412 try 413 wd:=inotify_add_watch(fd,pchar(d),Events); 414 fpFD_Zero(fds); 415 fpFD_SET(fd,fds); 416 While (fpSelect(fd+1,@fds,nil,nil,nil)>=0) do 417 begin 418 len:=fpRead(fd,buf,sizeof(buf)); 419 e:=@buf; 420 While ((pchar(e)-@buf)<len) do 421 begin 422 fnl:=e^.len; 423 if (fnl>0) then 424 begin 425 p:=@e^.name+fnl-1; 426 While (p^=#0) do 427 begin 428 dec(p); 429 dec(fnl); 430 end; 431 end; 432 setlength(fn,fnl); 433 if (fnl>0) then 434 move(e^.name,fn[1],fnl); 435 {$ifdef VerboseDirWatch} 436 Writeln('Change ',e^.mask,' (', 437// InotifyEventsToString(e^.mask), 438 ') detected for file "',fn,'"'); 439 {$endif} 440 ptrint(e):=ptrint(e)+sizeof(inotify_event)+e^.len-1; 441 end; 442 end; 443 finally 444 fpClose(fd); 445 end; 446end; 447 448procedure TDirwatch.DoneWatch; 449 450begin 451 fpClose(FInotifyFD); 452end; 453 454procedure TDirwatch.InitWatch; 455 456Const 457 NativeEvents : Array[TFileEvent] of cint = (IN_Modify,IN_Attrib,IN_Create,IN_Delete); 458 459Var 460 WD,I,NEvents : Integer; 461 E : TFileEvent; 462 BD,FN : String; 463 464begin 465 BD:=BaseDir; 466 if BD<>'' then 467 BD:=IncludeTrailingPathDelimiter(BD); 468 FINotifyFD:=inotify_init; 469 For I:=0 to FWatches.Count-1 do 470 begin 471 NEvents:=0; 472 for E in FWatches[i].Events do 473 NEvents:=NEvents OR NativeEvents[E]; 474 FN:=BD+FWatches[i].Name; 475 wd:=inotify_add_watch(FINotifyFD,PChar(FN),NEvents); 476 end; 477end; 478 479Function NativeEventsToEvents(Native : cint) : TFileEvents; 480 481 Procedure MA(C : cint; AEvent : TFileEvent); 482 483 begin 484 if (Native and C)<>0 then 485 Include(Result,AEvent); 486 end; 487 488begin 489 Result:=[]; 490 MA(IN_ACCESS,feAttrib); 491 MA(IN_MODIFY,feModify); 492 MA(IN_ATTRIB,feAttrib); 493 MA(IN_CLOSE_WRITE,feAttrib); 494 MA(IN_CLOSE_NOWRITE,feAttrib); 495 MA(IN_OPEN,feAttrib); 496 MA(IN_MOVED_FROM,feCreate); 497 MA(IN_MOVED_TO,feDelete); 498 MA(IN_CREATE,feCreate); 499 Ma(IN_DELETE,feDelete); 500 Ma(IN_DELETE_SELF,feDelete); 501 Ma(IN_MOVE_SELF,feDelete); 502 Ma(IN_UNMOUNT,feDelete); 503 // IN_Q_OVERFLOW 504 // IN_IGNORED 505 506end; 507 508procedure TDirwatch.Check; 509 510Var 511 fnl,len : cint; 512 e : ^inotify_event; 513 buf : Array[0..1023*4] of Byte; // 4K Buffer 514 fn : string; 515 p : pchar; 516 fds : tfdset; 517 Timeout : ttimeval; 518 519begin 520 fpFD_Zero(fds); 521 fpFD_SET(FINotifyFD,fds); 522 timeout.tv_sec:=FIdleInterval div 1000; 523 timeout.tv_usec:=(FIdleInterval mod 1000)*1000; 524 if (fpSelect(FINotifyFD+1,@fds,nil,nil,@Timeout)<=0) then 525 exit; 526 len:=fpRead(FINotifyFD,buf,sizeof(buf)); 527 e:=@buf; 528 While ((pchar(e)-@buf)<len) do 529 begin 530 fnl:=e^.len; 531 if (fnl>0) then 532 begin 533 p:=@e^.name+fnl-1; 534 While (p^=#0) do 535 begin 536 dec(p); 537 dec(fnl); 538 end; 539 end; 540 setlength(fn,fnl); 541 if (fnl>0) then 542 move(e^.name,fn[1],fnl); 543 DoChangeEvent(DirectoryEntryForFileName(FN),NativeEventsToEvents(E^ .mask)); 544 ptrint(e):=ptrint(e)+sizeof(inotify_event)+e^.len-1; 545 end; 546end; 547{$ENDIF} 548 549procedure TDirwatch.DoStartWatch; 550 551begin 552 InitWatch; 553 try 554 While not Terminated do 555 begin 556 Check; 557 if Threaded then 558 TThread.Synchronize(TThread.CurrentThread,@DoIdle) 559 else 560 DoIdle; 561 end; 562 Finally 563 DoneWatch; 564 end; 565end; 566 567procedure TDirwatch.StartWatch; 568 569begin 570 If Threaded then 571 TDirwatchThread.Create(Self).WaitFor 572 else 573 DoStartWatch; 574end; 575 576procedure TDirwatch.AddWatch(const aFileName: string; aEvents: TFileEvents); 577begin 578 FWatches.AddEntry(AFileName).Events:=AEvents; 579end; 580 581procedure TDirwatch.Terminate; 582begin 583 FTerminated:=True; 584end; 585 586{ TDirectoryEntries } 587 588function TDirectoryEntries.GetE(AIndex : Integer): TDirectoryEntry; 589begin 590 Result:=TDirectoryEntry(Items[AIndex]); 591end; 592 593procedure TDirectoryEntries.SetE(AIndex : Integer; AValue: TDirectoryEntry); 594begin 595 Items[AIndex]:=AValue; 596end; 597 598function TDirectoryEntries.IndexOfEntry(const AName: String): Integer; 599 600begin 601 Result:=Count-1; 602 While (Result>=0) and (GetE(Result).Name<>AName) do 603 Dec(Result); 604end; 605 606function TDirectoryEntries.EntryByName(const AName: String): TDirectoryEntry; 607 608Var 609 I : Integer; 610 611begin 612 I:=IndexOfEntry(AName); 613 If (I=-1) then 614 Result:=Nil 615 else 616 Result:=GetE(I); 617end; 618 619function TDirectoryEntries.AddEntry(Const AName: String): TDirectoryEntry; 620begin 621 Result:=Add as TDirectoryEntry; 622 Result.Name:=AName; 623end; 624 625end. 626 627