home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d123456 / DFS.ZIP / FileChange.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-09  |  2.8 KB  |  104 lines
  1. { To get rid of one of these, just call MyObj.Terminate and forget it.  It will free itself. }
  2.  
  3. unit FileChange;
  4.  
  5. interface
  6.  
  7. uses Windows, Classes;
  8.  
  9. type
  10.   TFSFilter = (fsfFilename,fsfDirname,fsfAttributes,fsfSize,fsfLastWrite,fsfSecurity);
  11.   TFSFilterSet = set of TFSFilter;
  12.  
  13.   TFileChangeThread = class(TThread)
  14.   private
  15.     FAborted: boolean;
  16.     FPath: string;
  17.     FRecursive: boolean;
  18.     FFilter: TFSFilterSet;
  19.     FFCHandle: THandle;
  20.  
  21.     function FilterToAPIVal: DWORD;
  22.   protected
  23.     procedure Execute; override;
  24.     procedure DoTerminate; override;
  25.   public
  26.     constructor Create(const APath: string; AFilter: TFSFilterSet; Recurse: boolean);
  27.     property Path: string read FPath write FPath;
  28.     property Recursive: boolean read FRecursive write FRecursive;
  29.     property Filter: TFSFilterSet read FFilter write FFilter;
  30.     property FCHandle: THandle read FFCHandle;
  31.     property Aborted: boolean read FAborted;
  32.   end;
  33.  
  34. implementation
  35.  
  36. const
  37.   TIMEOUT = 10;
  38.  
  39. constructor TFileChangeThread.Create(const APath: string; AFilter: TFSFilterSet;
  40.                                            Recurse: boolean);
  41. begin
  42.   inherited Create(False);
  43.   FAborted := FALSE;
  44.   FPath := APath;
  45.   FFilter := AFilter;
  46.   FRecursive := Recurse;
  47.   FreeOnTerminate := TRUE;
  48. end;
  49.  
  50. function TFileChangeThread.FilterToAPIVal: DWORD;
  51. begin
  52.   Result := 0;
  53.   if fsfFilename in FFilter then
  54.     Result := Result or FILE_NOTIFY_CHANGE_FILE_NAME;
  55.   if fsfDirname in FFilter then
  56.     Result := Result or FILE_NOTIFY_CHANGE_DIR_NAME;
  57.   if fsfAttributes in FFilter then
  58.     Result := Result or FILE_NOTIFY_CHANGE_ATTRIBUTES;
  59.   if fsfSize in FFilter then
  60.     Result := Result or FILE_NOTIFY_CHANGE_SIZE;
  61.   if fsfLastWrite in FFilter then
  62.     Result := Result or FILE_NOTIFY_CHANGE_LAST_WRITE;
  63.   if fsfSecurity in FFilter then
  64.     Result := Result or FILE_NOTIFY_CHANGE_SECURITY;
  65. end;
  66.  
  67. procedure TFileChangeThread.Execute;
  68. const
  69.   BoolVals: array[boolean] of LongBool = (LongBool(0), LongBool(1));
  70. var
  71.   Res: DWORD;
  72. begin
  73.   // There's a situation in some versions of the compiler that can cause a
  74.   // problem here.  The boolean parameter must be either 0 or 1, but sometimes
  75.   // the Delphi boolean TRUE is not ordinal value 1.
  76.   FFCHandle := FindFirstChangeNotification(PChar(FPath), BoolVals[FRecursive],
  77.     FilterToAPIVal);
  78.  
  79.   if FFCHandle = INVALID_HANDLE_VALUE then //houston, we have a problem
  80.   begin
  81.     FAborted := True;
  82.     ExitThread(GetLastError);
  83.     Exit;
  84.   end;
  85.  
  86.   repeat
  87.     Res := WaitForSingleObject(FFCHandle, TIMEOUT);
  88.     if Terminated then begin
  89.       FAborted := TRUE;
  90.       exit;
  91.     end;
  92.   until Res <> WAIT_TIMEOUT;
  93. end;
  94.  
  95. procedure TFileChangeThread.DoTerminate;
  96. begin
  97.   FindCloseChangeNotification(FFCHandle);
  98.   FFCHandle := 0;
  99.   if not FAborted then
  100.     inherited DoTerminate;
  101. end;
  102.  
  103. end.
  104.