← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/lazutils/lazfilecache.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/lazutils/lazfilecache.pas
 
1
unit LazFileCache;
 
2
 
 
3
{$mode objfpc}{$H+}
 
4
 
 
5
interface
 
6
 
 
7
uses
 
8
  Classes, SysUtils, LazDbgLog, AVL_Tree, LazFileUtils;
 
9
 
 
10
type
 
11
  TFileStateCacheItemFlag = (
 
12
    fsciExists,    // file or directory exists
 
13
    fsciDirectory, // file exists and is directory
 
14
    fsciReadable,  // file is readable
 
15
    fsciWritable,  // file is writable
 
16
    fsciDirectoryReadable, // file is directory and can be searched
 
17
    fsciDirectoryWritable, // file is directory and new files can be created
 
18
    fsciText,      // file is text file (not binary)
 
19
    fsciExecutable,// file is executable
 
20
    fsciAge        // file age is valid
 
21
    );
 
22
  TFileStateCacheItemFlags = set of TFileStateCacheItemFlag;
 
23
 
 
24
  { TFileStateCacheItem }
 
25
 
 
26
  TFileStateCacheItem = class
 
27
  private
 
28
    FAge: longint;
 
29
    FFilename: string;
 
30
    FFlags: TFileStateCacheItemFlags;
 
31
    FTestedFlags: TFileStateCacheItemFlags;
 
32
    FTimeStamp: int64;
 
33
  public
 
34
    constructor Create(const TheFilename: string; NewTimeStamp: int64);
 
35
    function CalcMemSize: PtrUint;
 
36
  public
 
37
    property Filename: string read FFilename;
 
38
    property Flags: TFileStateCacheItemFlags read FFlags;
 
39
    property TestedFlags: TFileStateCacheItemFlags read FTestedFlags;
 
40
    property TimeStamp: int64 read FTimeStamp;
 
41
    property Age: longint read FAge;
 
42
  end;
 
43
 
 
44
  TOnChangeFileStateTimeStamp = procedure(Sender: TObject;
 
45
                                          const AFilename: string) of object;
 
46
 
 
47
  { TFileStateCache }
 
48
 
 
49
  TFileStateCache = class
 
50
  private
 
51
    FFiles: TAVLTree; // tree of TFileStateCacheItem
 
52
    FTimeStamp: int64;
 
53
    FLockCount: integer;
 
54
    FChangeTimeStampHandler: array of TOnChangeFileStateTimeStamp;
 
55
    procedure SetFlag(AFile: TFileStateCacheItem;
 
56
                      AFlag: TFileStateCacheItemFlag; NewValue: boolean);
 
57
  public
 
58
    constructor Create;
 
59
    destructor Destroy; override;
 
60
    procedure Lock;
 
61
    procedure Unlock;
 
62
    function Locked: boolean;
 
63
    procedure IncreaseTimeStamp(const AFilename: string);
 
64
    function FileExistsCached(const AFilename: string): boolean;
 
65
    function DirPathExistsCached(const AFilename: string): boolean;
 
66
    function DirectoryIsWritableCached(const DirectoryName: string): boolean;
 
67
    function FileIsExecutableCached(const AFilename: string): boolean;
 
68
    function FileIsReadableCached(const AFilename: string): boolean;
 
69
    function FileIsWritableCached(const AFilename: string): boolean;
 
70
    function FileIsTextCached(const AFilename: string): boolean;
 
71
    function FileAgeCached(const AFileName: string): Longint;
 
72
    function FindFile(const Filename: string;
 
73
                      CreateIfNotExists: boolean): TFileStateCacheItem;
 
74
    function Check(const Filename: string; AFlag: TFileStateCacheItemFlag;
 
75
                   out AFile: TFileStateCacheItem; var FlagIsSet: boolean): boolean;
 
76
    procedure AddChangeTimeStampHandler(const Handler: TOnChangeFileStateTimeStamp);
 
77
    procedure RemoveChangeTimeStampHandler(const Handler: TOnChangeFileStateTimeStamp);
 
78
    function CalcMemSize: PtrUint;
 
79
  public
 
80
    property TimeStamp: int64 read FTimeStamp;
 
81
  end;
 
82
 
 
83
var
 
84
  FileStateCache: TFileStateCache = nil;
 
85
 
 
86
function FileExistsCached(const AFilename: string): boolean;
 
87
function DirPathExistsCached(const AFilename: string): boolean;
 
88
function DirectoryIsWritableCached(const ADirectoryName: string): boolean;
 
89
function FileIsExecutableCached(const AFilename: string): boolean;
 
90
function FileIsReadableCached(const AFilename: string): boolean;
 
91
function FileIsWritableCached(const AFilename: string): boolean;
 
92
function FileIsTextCached(const AFilename: string): boolean;
 
93
function FileAgeCached(const AFileName: string): Longint;
 
94
 
 
95
procedure InvalidateFileStateCache(const Filename: string = ''); inline;
 
96
function CompareFileStateItems(Data1, Data2: Pointer): integer;
 
97
function CompareFilenameWithFileStateCacheItem(Key, Data: Pointer): integer;
 
98
 
 
99
const
 
100
  LUInvalidChangeStamp = Low(integer);
 
101
  LUInvalidChangeStamp64 = Low(int64); // using a value outside integer to spot wrong types early
 
102
procedure LUIncreaseChangeStamp(var ChangeStamp: integer); inline;
 
103
procedure LUIncreaseChangeStamp64(var ChangeStamp: int64); inline;
 
104
 
 
105
type
 
106
  TOnFileExistsCached = function(Filename: string): boolean of object;
 
107
  TOnFileAgeCached = function(Filename: string): longint of object;
 
108
var
 
109
  OnFileExistsCached: TOnFileExistsCached = nil;
 
110
  OnFileAgeCached: TOnFileAgeCached = nil;
 
111
 
 
112
implementation
 
113
 
 
114
 
 
115
function FileExistsCached(const AFilename: string): boolean;
 
116
begin
 
117
  if OnFileExistsCached<>nil then
 
118
    Result:=OnFileExistsCached(AFilename)
 
119
  else if FileStateCache<>nil then
 
120
    Result:=FileStateCache.FileExistsCached(AFilename)
 
121
  else
 
122
    Result:=FileExistsUTF8(AFilename);
 
123
end;
 
124
 
 
125
function DirPathExistsCached(const AFilename: string): boolean;
 
126
begin
 
127
  if FileStateCache<>nil then
 
128
    Result:=FileStateCache.DirPathExistsCached(AFilename)
 
129
  else
 
130
    Result:=DirPathExists(AFilename);
 
131
end;
 
132
 
 
133
function DirectoryIsWritableCached(const ADirectoryName: string): boolean;
 
134
begin
 
135
  if FileStateCache<>nil then
 
136
    Result:=FileStateCache.DirectoryIsWritableCached(ADirectoryName)
 
137
  else
 
138
    Result:=DirectoryIsWritable(ADirectoryName);
 
139
end;
 
140
 
 
141
function FileIsExecutableCached(const AFilename: string): boolean;
 
142
begin
 
143
  if FileStateCache<>nil then
 
144
    Result:=FileStateCache.FileIsExecutableCached(AFilename)
 
145
  else
 
146
    Result:=FileIsExecutable(AFilename);
 
147
end;
 
148
 
 
149
function FileIsReadableCached(const AFilename: string): boolean;
 
150
begin
 
151
  if FileStateCache<>nil then
 
152
    Result:=FileStateCache.FileIsReadableCached(AFilename)
 
153
  else
 
154
    Result:=FileIsReadable(AFilename);
 
155
end;
 
156
 
 
157
function FileIsWritableCached(const AFilename: string): boolean;
 
158
begin
 
159
  if FileStateCache<>nil then
 
160
    Result:=FileStateCache.FileIsWritableCached(AFilename)
 
161
  else
 
162
    Result:=FileIsWritable(AFilename);
 
163
end;
 
164
 
 
165
function FileIsTextCached(const AFilename: string): boolean;
 
166
begin
 
167
  if FileStateCache<>nil then
 
168
    Result:=FileStateCache.FileIsTextCached(AFilename)
 
169
  else
 
170
    Result:=FileIsText(AFilename);
 
171
end;
 
172
 
 
173
function FileAgeCached(const AFileName: string): Longint;
 
174
begin
 
175
  if OnFileAgeCached<>nil then
 
176
    Result:=OnFileAgeCached(AFilename)
 
177
  else if FileStateCache<>nil then
 
178
    Result:=FileStateCache.FileAgeCached(AFilename)
 
179
  else
 
180
    Result:=FileAgeUTF8(AFileName);
 
181
end;
 
182
 
 
183
procedure InvalidateFileStateCache(const Filename: string);
 
184
begin
 
185
  FileStateCache.IncreaseTimeStamp(Filename);
 
186
end;
 
187
 
 
188
function CompareFileStateItems(Data1, Data2: Pointer): integer;
 
189
begin
 
190
  Result:=CompareFilenames(TFileStateCacheItem(Data1).FFilename,
 
191
                           TFileStateCacheItem(Data2).FFilename);
 
192
end;
 
193
 
 
194
function CompareFilenameWithFileStateCacheItem(Key, Data: Pointer): integer;
 
195
begin
 
196
  Result:=CompareFilenames(AnsiString(Key),TFileStateCacheItem(Data).FFilename);
 
197
  //debugln('CompareFilenameWithFileStateCacheItem Key=',AnsiString(Key),' Data=',TFileStateCacheItem(Data).FFilename,' Result=',dbgs(Result));
 
198
end;
 
199
 
 
200
procedure LUIncreaseChangeStamp(var ChangeStamp: integer);
 
201
begin
 
202
  if ChangeStamp<High(ChangeStamp) then
 
203
    inc(ChangeStamp)
 
204
  else
 
205
    ChangeStamp:=LUInvalidChangeStamp+1;
 
206
end;
 
207
 
 
208
procedure LUIncreaseChangeStamp64(var ChangeStamp: int64);
 
209
begin
 
210
  if ChangeStamp<High(ChangeStamp) then
 
211
    inc(ChangeStamp)
 
212
  else
 
213
    ChangeStamp:=LUInvalidChangeStamp64+1;
 
214
end;
 
215
 
 
216
{ TFileStateCacheItem }
 
217
 
 
218
constructor TFileStateCacheItem.Create(const TheFilename: string;
 
219
  NewTimeStamp: int64);
 
220
begin
 
221
  FFilename:=TheFilename;
 
222
  FTimeStamp:=NewTimeStamp;
 
223
end;
 
224
 
 
225
function TFileStateCacheItem.CalcMemSize: PtrUint;
 
226
begin
 
227
  Result:=PtrUInt(InstanceSize)
 
228
    +MemSizeString(FFilename);
 
229
end;
 
230
 
 
231
{ TFileStateCache }
 
232
 
 
233
procedure TFileStateCache.SetFlag(AFile: TFileStateCacheItem;
 
234
  AFlag: TFileStateCacheItemFlag; NewValue: boolean);
 
235
begin
 
236
  if AFile.FTimeStamp<>FTimeStamp then begin
 
237
    AFile.FTestedFlags:=[];
 
238
    AFile.FTimeStamp:=FTimeStamp;
 
239
  end;
 
240
  Include(AFile.FTestedFlags,AFlag);
 
241
  if NewValue then
 
242
    Include(AFile.FFlags,AFlag)
 
243
  else
 
244
    Exclude(AFile.FFlags,AFlag);
 
245
  //WriteStr(s, AFlag);
 
246
  //debugln('TFileStateCache.SetFlag AFile.Filename=',AFile.Filename,' ',s,'=',dbgs(AFlag in AFile.FFlags),' Valid=',dbgs(AFlag in AFile.FTestedFlags));
 
247
end;
 
248
 
 
249
constructor TFileStateCache.Create;
 
250
begin
 
251
  FFiles:=TAVLTree.Create(@CompareFileStateItems);
 
252
  LUIncreaseChangeStamp64(FTimeStamp); // one higher than default for new files
 
253
end;
 
254
 
 
255
destructor TFileStateCache.Destroy;
 
256
begin
 
257
  FFiles.FreeAndClear;
 
258
  FFiles.Free;
 
259
  SetLength(FChangeTimeStampHandler,0);
 
260
  inherited Destroy;
 
261
end;
 
262
 
 
263
procedure TFileStateCache.Lock;
 
264
begin
 
265
  inc(FLockCount);
 
266
end;
 
267
 
 
268
procedure TFileStateCache.Unlock;
 
269
 
 
270
  procedure RaiseTooManyUnlocks;
 
271
  begin
 
272
    raise Exception.Create('TFileStateCache.Unlock');
 
273
  end;
 
274
 
 
275
begin
 
276
  if FLockCount<=0 then RaiseTooManyUnlocks;
 
277
  dec(FLockCount);
 
278
end;
 
279
 
 
280
function TFileStateCache.Locked: boolean;
 
281
begin
 
282
  Result:=FLockCount>0;
 
283
end;
 
284
 
 
285
procedure TFileStateCache.IncreaseTimeStamp(const AFilename: string);
 
286
var
 
287
  i: Integer;
 
288
  AFile: TFileStateCacheItem;
 
289
begin
 
290
  if Self=nil then exit;
 
291
  if AFilename='' then begin
 
292
    // invalidate all
 
293
    LUIncreaseChangeStamp64(FTimeStamp);
 
294
  end else begin
 
295
    // invalidate single file
 
296
    AFile:=FindFile(AFilename,false);
 
297
    if AFile<>nil then
 
298
      AFile.FTestedFlags:=[];
 
299
  end;
 
300
  for i:=0 to length(FChangeTimeStampHandler)-1 do
 
301
    FChangeTimeStampHandler[i](Self,AFilename);
 
302
  //debugln('TFileStateCache.IncreaseTimeStamp FTimeStamp=',dbgs(FTimeStamp));
 
303
end;
 
304
 
 
305
function TFileStateCache.FileExistsCached(const AFilename: string): boolean;
 
306
var
 
307
  AFile: TFileStateCacheItem;
 
308
begin
 
309
  Result := False;
 
310
  if Check(AFilename,fsciExists,AFile,Result) then exit;
 
311
  Result:=FileExistsUTF8(AFile.Filename);
 
312
  SetFlag(AFile,fsciExists,Result);
 
313
  {if not Check(Filename,fsciExists,AFile,Result) then begin
 
314
    WriteDebugReport;
 
315
    raise Exception.Create('');
 
316
  end;}
 
317
end;
 
318
 
 
319
function TFileStateCache.DirPathExistsCached(const AFilename: string): boolean;
 
320
var
 
321
  AFile: TFileStateCacheItem;
 
322
begin
 
323
  Result := False;
 
324
  if Check(AFilename,fsciDirectory,AFile,Result) then exit;
 
325
  Result:=DirPathExists(AFile.Filename);
 
326
  SetFlag(AFile,fsciDirectory,Result);
 
327
end;
 
328
 
 
329
function TFileStateCache.DirectoryIsWritableCached(const DirectoryName: string
 
330
  ): boolean;
 
331
var
 
332
  AFile: TFileStateCacheItem;
 
333
begin
 
334
  Result := False;
 
335
  if Check(DirectoryName,fsciDirectoryWritable,AFile,Result) then exit;
 
336
  Result:=DirectoryIsWritable(AFile.Filename);
 
337
  SetFlag(AFile,fsciDirectoryWritable,Result);
 
338
end;
 
339
 
 
340
function TFileStateCache.FileIsExecutableCached(
 
341
  const AFilename: string): boolean;
 
342
var
 
343
  AFile: TFileStateCacheItem;
 
344
begin
 
345
  Result := False;
 
346
  if Check(AFilename,fsciExecutable,AFile,Result) then exit;
 
347
  Result:=FileIsExecutable(AFile.Filename);
 
348
  SetFlag(AFile,fsciExecutable,Result);
 
349
end;
 
350
 
 
351
function TFileStateCache.FileIsReadableCached(const AFilename: string): boolean;
 
352
var
 
353
  AFile: TFileStateCacheItem;
 
354
begin
 
355
  Result := False;
 
356
  if Check(AFilename,fsciReadable,AFile,Result) then exit;
 
357
  Result:=FileIsReadable(AFile.Filename);
 
358
  SetFlag(AFile,fsciReadable,Result);
 
359
end;
 
360
 
 
361
function TFileStateCache.FileIsWritableCached(const AFilename: string): boolean;
 
362
var
 
363
  AFile: TFileStateCacheItem;
 
364
begin
 
365
  Result := False;
 
366
  if Check(AFilename,fsciWritable,AFile,Result) then exit;
 
367
  Result:=FileIsWritable(AFile.Filename);
 
368
  SetFlag(AFile,fsciWritable,Result);
 
369
end;
 
370
 
 
371
function TFileStateCache.FileIsTextCached(const AFilename: string): boolean;
 
372
var
 
373
  AFile: TFileStateCacheItem;
 
374
begin
 
375
  Result := False;
 
376
  if Check(AFilename,fsciText,AFile,Result) then exit;
 
377
  Result:=FileIsText(AFile.Filename);
 
378
  SetFlag(AFile,fsciText,Result);
 
379
end;
 
380
 
 
381
function TFileStateCache.FileAgeCached(const AFileName: string): Longint;
 
382
var
 
383
  AFile: TFileStateCacheItem;
 
384
  Dummy: Boolean;
 
385
begin
 
386
  Dummy := False;
 
387
  if Check(AFilename,fsciAge,AFile,Dummy) then begin
 
388
    Result:=AFile.Age;
 
389
    exit;
 
390
  end;
 
391
  Result:=FileAge(AFile.Filename);
 
392
  AFile.FAge:=Result;
 
393
  Include(AFile.FTestedFlags,fsciAge);
 
394
end;
 
395
 
 
396
function TFileStateCache.FindFile(const Filename: string;
 
397
  CreateIfNotExists: boolean): TFileStateCacheItem;
 
398
var
 
399
  TrimmedFilename: String;
 
400
  ANode: TAVLTreeNode;
 
401
begin
 
402
  // make filename unique
 
403
  TrimmedFilename:=ChompPathDelim(TrimFilename(Filename));
 
404
  ANode:=FFiles.FindKey(Pointer(TrimmedFilename),
 
405
                        @CompareFilenameWithFileStateCacheItem);
 
406
  if ANode<>nil then
 
407
    Result:=TFileStateCacheItem(ANode.Data)
 
408
  else if CreateIfNotExists then begin
 
409
    Result:=TFileStateCacheItem.Create(TrimmedFilename,FTimeStamp);
 
410
    FFiles.Add(Result);
 
411
    if FFiles.FindKey(Pointer(TrimmedFilename),
 
412
                      @CompareFilenameWithFileStateCacheItem)=nil
 
413
    then begin
 
414
      //DebugLn(format('FileStateCache.FindFile: "%s"',[FileName]));
 
415
      raise Exception.Create('');
 
416
    end;
 
417
  end else
 
418
    Result:=nil;
 
419
end;
 
420
 
 
421
function TFileStateCache.Check(const Filename: string;
 
422
  AFlag: TFileStateCacheItemFlag; out AFile: TFileStateCacheItem;
 
423
  var FlagIsSet: boolean): boolean;
 
424
begin
 
425
  AFile:=FindFile(Filename,true);
 
426
  if FTimeStamp=AFile.FTimeStamp then begin
 
427
    Result:=AFlag in AFile.FTestedFlags;
 
428
    FlagIsSet:=AFlag in AFile.FFlags;
 
429
  end else begin
 
430
    AFile.FTestedFlags:=[];
 
431
    AFile.FTimeStamp:=FTimeStamp;
 
432
    Result:=false;
 
433
    FlagIsSet:=false;
 
434
  end;
 
435
  //WriteStr(s, AFlag);
 
436
  //debugln('TFileStateCache.Check Filename=',Filename,' AFile.Filename=',AFile.Filename,' ',s,'=',dbgs(FlagIsSet),' Valid=',dbgs(Result));
 
437
end;
 
438
 
 
439
procedure TFileStateCache.AddChangeTimeStampHandler(
 
440
  const Handler: TOnChangeFileStateTimeStamp);
 
441
begin
 
442
  SetLength(FChangeTimeStampHandler,length(FChangeTimeStampHandler)+1);
 
443
  FChangeTimeStampHandler[length(FChangeTimeStampHandler)-1]:=Handler;
 
444
end;
 
445
 
 
446
procedure TFileStateCache.RemoveChangeTimeStampHandler(
 
447
  const Handler: TOnChangeFileStateTimeStamp);
 
448
var
 
449
  i: Integer;
 
450
begin
 
451
  for i:=length(FChangeTimeStampHandler)-1 downto 0 do begin
 
452
    if Handler=FChangeTimeStampHandler[i] then begin
 
453
      if i<length(FChangeTimeStampHandler)-1 then
 
454
        System.Move(FChangeTimeStampHandler[i+1],FChangeTimeStampHandler[i],
 
455
                    SizeOf(TNotifyEvent)*(length(FChangeTimeStampHandler)-i-1));
 
456
      SetLength(FChangeTimeStampHandler,length(FChangeTimeStampHandler)-1);
 
457
    end;
 
458
  end;
 
459
end;
 
460
 
 
461
function TFileStateCache.CalcMemSize: PtrUint;
 
462
var
 
463
  Node: TAVLTreeNode;
 
464
begin
 
465
  Result:=PtrUInt(InstanceSize)
 
466
    +PtrUInt(length(FChangeTimeStampHandler))*SizeOf(TNotifyEvent);
 
467
  if FFiles<>nil then begin
 
468
    inc(Result,PtrUInt(FFiles.InstanceSize)
 
469
      +PtrUInt(FFiles.Count)*PtrUInt(TAVLTreeNode.InstanceSize));
 
470
    Node:=FFiles.FindLowest;
 
471
    while Node<>nil do begin
 
472
      inc(Result,TFileStateCacheItem(Node.Data).CalcMemSize);
 
473
      Node:=FFiles.FindSuccessor(Node);
 
474
    end;
 
475
  end;
 
476
end;
 
477
 
 
478
initialization
 
479
  OnInvalidateFileStateCache:=@InvalidateFileStateCache;
 
480
 
 
481
end.
 
482