aksdb/CentrED
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity

- Initial import from internal repository

Browse Source
This commit is contained in:
Andreas Schneider
2007-12-21 21:31:58 +01:00
commit c0a125042b
194 changed files with 86503 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

230
UCacheManager.pas Normal file
View File

@@ -0,0 +1,230 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2007 Andreas Schneider
*)
unit UCacheManager;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes;
type
TRemoveObjectEvent = procedure(AObject: TObject) of object;
PCacheEntry = ^TCacheEntry;
TCacheEntry = record
ID: Integer;
Obj: TObject;
Next: PCacheEntry;
end;
{ TCacheManager }
TCacheManager = class(TObject)
constructor Create(ASize: Integer);
destructor Destroy; override;
protected
FSize: Integer;
FFirst: PCacheEntry;
FLast: PCacheEntry;
FOnRemoveObject: TRemoveObjectEvent;
public
function QueryID(const AID: Integer; out AObj: TObject): Boolean;
procedure StoreID(AID: Integer; AObj: TObject);
procedure DiscardID(AID: Integer);
procedure DiscardObj(AObj: TObject);
procedure RemoveID(AID: Integer);
procedure Clear;
property OnRemoveObject: TRemoveObjectEvent read FOnRemoveObject write FOnRemoveObject;
end;
implementation
{ TCacheManager }
constructor TCacheManager.Create(ASize: Integer);
var
i: Integer;
current: PCacheEntry;
begin
FOnRemoveObject := nil;
FSize := ASize;
if FSize > 0 then
begin
New(FFirst);
current := FFirst;
current^.ID := LongInt($FFFFFFFF);
current^.Obj := nil;
for i := 2 to FSize do
begin
New(current^.Next);
FLast := current;
current := current^.Next;
current^.ID := LongInt($FFFFFFFF);
current^.Obj := nil;
end;
current^.Next := nil;
end;
end;
destructor TCacheManager.Destroy;
var
i: Integer;
current, last: PCacheEntry;
begin
current := FFirst;
for i := 1 to FSize do
begin
if current^.Obj <> nil then
begin
if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj);
FreeAndNil(current^.Obj);
end;
last := current;
current := current^.Next;
Dispose(last);
end;
inherited;
end;
procedure TCacheManager.DiscardID(AID: Integer);
var
current: PCacheEntry;
begin
current := FFirst;
while (current <> nil) do
begin
if (current^.ID = AID) then
begin
current^.ID := LongInt($FFFFFFFF);
current^.Obj := nil;
current := nil;
end else
current := current^.Next;
end;
end;
procedure TCacheManager.DiscardObj(AObj: TObject);
var
current: PCacheEntry;
begin
current := FFirst;
while (current <> nil) do
begin
if (current^.Obj = AObj) then
begin
current^.ID := LongInt($FFFFFFFF);
current^.Obj := nil;
current := nil;
end else
current := current^.Next;
end;
end;
procedure TCacheManager.RemoveID(AID: Integer);
var
current: PCacheEntry;
begin
current := FFirst;
FLast := current;
while (current <> nil) do
begin
if (current^.ID = AID) then
begin
current^.ID := LongInt($FFFFFFFF);
if current^.Obj <> nil then
FreeAndNil(current^.Obj);
end;
if (current^.Next <> nil) then
FLast := current;
current := current^.Next;
end;
end;
procedure TCacheManager.Clear;
var
current: PCacheEntry;
begin
current := FFirst;
while current <> nil do
begin
if current^.Obj <> nil then
begin
current^.ID := LongInt($FFFFFFFF);
if Assigned(FOnRemoveObject) then FOnRemoveObject(current^.Obj);
FreeAndNil(current^.Obj);
end;
current := current^.Next;
end;
end;
function TCacheManager.QueryID(const AID: Integer;
out AObj: TObject): Boolean;
var
current: PCacheEntry;
begin
current := FFirst;
FLast := current;
Result := False;
while (current <> nil) and (not Result) do
begin
if (current^.ID = AID) then
begin
Result := True;
AObj := current^.Obj;
if current <> FFirst then
begin
FLast^.Next := current^.Next;
current^.Next := FFirst;
FFirst := current;
end;
end;
if (current^.Next <> nil) then
FLast := current;
current := current^.Next;
end;
end;
procedure TCacheManager.StoreID(AID: Integer; AObj: TObject);
var
current: PCacheEntry;
begin
current := FLast^.Next; //well, FLast is not really the last, but the one before the last ;)
FLast^.Next := nil;
current^.Next := FFirst;
FFirst := current;
FFirst^.ID := AID;
if FFirst^.Obj <> nil then //if the last cache entry did contain an object, remove it now
begin
if Assigned(FOnRemoveObject) then FOnRemoveObject(FFirst^.Obj);
FreeAndNil(FFirst^.Obj);
end;
FFirst^.Obj := AObj;
end;
end.