disqlite3cache.pas

来自「DELPHI 访问SQLITE3 数据库的VCL控件」· PAS 代码 · 共 525 行

{-------------------------------------------------------------------------------
 
 Copyright (c) 1999-2007 Ralf Junker, The Delphi Inspiration
 Internet: http://www.yunqa.de/delphi/
 E-Mail:   [e-mail]

-------------------------------------------------------------------------------}

unit DISQLite3Cache;

{$I DI.inc}

interface

type

  PDICacheItem = ^TDICacheItem;
  TDICacheItem = record
    ID: Int64;
    Previous: PDICacheItem;
    Next: PDICacheItem;
    NextHash: PDICacheItem;
    Data: record end;
  end;

  TDICacheItemArry = array[0..MaxInt div SizeOf(PDICacheItem) - 1] of PDICacheItem;
  PDICacheItemArray = ^TDICacheItemArry;

  TDIAbstractSQLite3Cache = class

  private

    FCount: Integer;

    FHash: PDICacheItemArray;

    FHashSize: Integer;

    FItemSize: Cardinal;

    FFirstItem: PDICacheItem;

    FUnusedItem: PDICacheItem;

    FLastItem: PDICacheItem;

    FMaxCount: Integer;

    procedure InternalConnectFirst(const AItem: PDICacheItem);

    procedure InternalConnectHash(const AItem: PDICacheItem);

    procedure InternalConnectLast(const AItem: PDICacheItem);

    procedure InternalDisconnect(const AItem: PDICacheItem);

    function InternalDisconnectHashID(const AID: Int64): PDICacheItem;

    procedure InternalDisconnectHashItem(const AItem: PDICacheItem);

    procedure InvalidateHashArray;

    procedure SetItemSize(const Value: Cardinal);

    procedure SetMaxCount(const AValue: Integer);

    procedure SetHashSize(const AValue: Integer);

  protected

    function DoAllowAutoDeleteItem(const AItem: Pointer): Boolean; virtual;

    procedure DoInitializeItem(const AItem: Pointer); virtual; abstract;

    procedure DoFinalizeItem(const AItem: Pointer); virtual; abstract;

  public

    constructor Create(const AItemSize: Integer; const AHashSize: Cardinal = 521);

    destructor Destroy; override;

    function AddItem(const AID: Int64): Pointer;

    procedure Clear;

    function DeleteItem(const AID: Int64): Boolean;

    function GetItem(const AID: Int64): Pointer;

    procedure Invalidate;

    function InvalidateItem(const AID: Int64): Boolean;

    property Count: Integer read FCount;

    property HashSize: Integer read FHashSize write SetHashSize;

    property ItemSize: Cardinal read FItemSize write SetItemSize;

    property MaxCount: Integer read FMaxCount write SetMaxCount;

  end;

  TDISQLite3Cache = class(TDIAbstractSQLite3Cache)
  protected

    procedure DoInitializeItem(const AItem: Pointer); override;

    procedure DoFinalizeItem(const AItem: Pointer); override;

  end;

const
  MIN_HASH_SIZE = 59;

implementation

constructor TDIAbstractSQLite3Cache.Create(const AItemSize: Integer; const AHashSize: Cardinal = 521);
begin
  inherited Create;
  FMaxCount := MaxInt;
  FItemSize := AItemSize;
  SetHashSize(AHashSize);
end;

destructor TDIAbstractSQLite3Cache.Destroy;
begin
  Clear;
  FreeMem(FHash);
  inherited;
end;

function TDIAbstractSQLite3Cache.DoAllowAutoDeleteItem(const AItem: Pointer): Boolean;
begin
  Result := True;
end;

procedure TDIAbstractSQLite3Cache.Clear;
var
  Run, Mark: PDICacheItem;
begin
  InvalidateHashArray;

  Run := FFirstItem;
  while Assigned(Run) do
    begin
      Mark := Run;
      Run := Mark^.Next;
      DoFinalizeItem(@Mark^.Data);
      FreeMem(Mark);
    end;

  FFirstItem := nil;
  FLastItem := nil;
  FCount := 0;
end;

function TDIAbstractSQLite3Cache.AddItem(const AID: Int64): Pointer;
label
  Add_New_Item, Initialize_Item;
var
  NewItem: PDICacheItem;
begin
  if FCount >= FMaxCount then
    begin

      NewItem := FLastItem;
      repeat
        if DoAllowAutoDeleteItem(@NewItem^.Data) then
          begin

            InternalDisconnectHashItem(NewItem);
            NewItem^.ID := AID;
            InternalConnectHash(NewItem);
            InternalDisconnect(NewItem);
            InternalConnectFirst(NewItem);
            Result := @NewItem^.Data;
            DoFinalizeItem(Result);
            goto Initialize_Item;
          end;
        NewItem := NewItem.Previous;
      until not Assigned(NewItem);

      goto Add_New_Item;
    end
  else
    begin
      if Assigned(FUnusedItem) then
        begin

          NewItem := FUnusedItem;
          FUnusedItem := FUnusedItem^.Next;
          InternalDisconnect(NewItem);
        end
      else
        begin
          Add_New_Item:

          GetMem(NewItem, SizeOf(NewItem^) + FItemSize);
        end;
      NewItem^.ID := AID;
      InternalConnectHash(NewItem);
      InternalConnectFirst(NewItem);
      Inc(FCount);
      Result := @NewItem^.Data;
    end;
  Initialize_Item:
  DoInitializeItem(Result);
end;

function TDIAbstractSQLite3Cache.DeleteItem(const AID: Int64): Boolean;
var
  Item: PDICacheItem;
begin
  Item := InternalDisconnectHashID(AID);
  Result := Assigned(Item);
  if Result then
    begin
      InternalDisconnect(Item);
      DoFinalizeItem(@Item^.Data);
      FreeMem(Item);
      Dec(FCount);
    end;
end;

function TDIAbstractSQLite3Cache.GetItem(const AID: Int64): Pointer;
label
  1;
var
  HashBin: ^PDICacheItem;
  Item, PreviousItem: PDICacheItem;
begin

  HashBin := @FHash^[AID mod FHashSize];
  Item := HashBin^;
  if Assigned(Item) then
    begin
      if Item^.ID = AID then
        begin
          1:

          if Item <> FFirstItem then
            begin
              Item^.Previous^.Next := Item^.Next;
              if Assigned(Item^.Next) then
                Item^.Next^.Previous := Item^.Previous
              else
                FLastItem := Item^.Previous;

              FFirstItem^.Previous := Item;
              Item^.Next := FFirstItem;
              FFirstItem := Item;
              Item^.Previous := nil;
            end;

          Result := @Item.Data;
          Exit;
        end;

      PreviousItem := Item;
      Item := Item^.NextHash;
      if Assigned(Item) then
        repeat
          if Item^.ID = AID then
            begin
              PreviousItem^.NextHash := Item^.NextHash;
              Item^.NextHash := HashBin^;
              HashBin^ := Item;
              goto 1;
            end;
          PreviousItem := Item;
          Item := Item^.NextHash;
        until not Assigned(Item);
    end;
  Result := nil;
end;

procedure TDIAbstractSQLite3Cache.InternalConnectFirst(const AItem: PDICacheItem);
begin
  if Assigned(FFirstItem) then
    FFirstItem^.Previous := AItem
  else
    FLastItem := AItem;
  AItem^.Next := FFirstItem;
  FFirstItem := AItem;
  AItem^.Previous := nil;
end;

procedure TDIAbstractSQLite3Cache.InternalConnectHash(const AItem: PDICacheItem);
var
  HashBin: ^PDICacheItem;
  HashItem: PDICacheItem;
begin
  HashBin := @FHash^[AItem^.ID mod FHashSize];
  HashItem := HashBin^;
  if Assigned(HashItem) then
    AItem^.NextHash := HashItem
  else
    AItem^.NextHash := nil;
  HashBin^ := AItem;
end;

procedure TDIAbstractSQLite3Cache.InternalConnectLast(const AItem: PDICacheItem);
begin
  if Assigned(FLastItem) then
    FLastItem^.Next := AItem
  else
    FFirstItem := AItem;
  AItem^.Previous := FLastItem;
  FLastItem := AItem;
  AItem^.Next := nil;
end;

procedure TDIAbstractSQLite3Cache.InternalDisconnect(const AItem: PDICacheItem);
begin
  if Assigned(AItem.Previous) then
    AItem^.Previous^.Next := AItem^.Next
  else
    FFirstItem := AItem^.Next;
  if Assigned(AItem^.Next) then
    AItem^.Next^.Previous := AItem^.Previous
  else
    FLastItem := AItem^.Previous;
end;

function TDIAbstractSQLite3Cache.InternalDisconnectHashID(const AID: Int64): PDICacheItem;
label
  1;
var
  HashBin: ^PDICacheItem;
  PreviousHashItem: PDICacheItem;
begin
  HashBin := @FHash^[AID mod FHashSize];
  Result := HashBin^;
  if not Assigned(Result) then
    Exit;

  PreviousHashItem := nil;
  repeat
    if Result^.ID = AID then
      goto 1;
    PreviousHashItem := Result;
    Result := Result^.NextHash;
  until not Assigned(Result);
  Exit;

  1:
  if Assigned(PreviousHashItem) then
    PreviousHashItem^.NextHash := Result^.NextHash
  else
    HashBin^ := Result^.NextHash;
end;

procedure TDIAbstractSQLite3Cache.InternalDisconnectHashItem(const AItem: PDICacheItem);
label
  1;
var
  HashBin: ^PDICacheItem;
  HashItem: PDICacheItem;
  PreviousHashItem: PDICacheItem;
begin
  HashBin := @FHash^[AItem^.ID mod FHashSize];
  HashItem := HashBin^;
  if not Assigned(HashItem) then
    Exit;

  PreviousHashItem := nil;
  repeat
    if HashItem = AItem then
      goto 1;
    PreviousHashItem := HashItem;
    HashItem := HashItem^.NextHash;
  until not Assigned(HashItem);
  Exit;

  1:
  if Assigned(PreviousHashItem) then
    PreviousHashItem^.NextHash := HashItem^.NextHash
  else
    HashBin^ := HashItem^.NextHash;
end;

procedure TDIAbstractSQLite3Cache.Invalidate;
var
  i: Integer;
  pRun: ^PDICacheItem;
  Run: PDICacheItem;
begin

  i := FHashSize;
  pRun := Pointer(FHash);
  repeat
    pRun^ := nil;
    Inc(pRun);
    Dec(i);
  until i = 0;

  Run := FFirstItem;
  while Assigned(Run) and (Run <> FUnusedItem) do
    begin
      DoFinalizeItem(@Run^.Data);
      Run := Run^.Next;
    end;

  FUnusedItem := FFirstItem;
  FCount := 0;
end;

procedure TDIAbstractSQLite3Cache.InvalidateHashArray;
var
  i: Integer;
  NilPointer: Pointer;
  Run: ^PDICacheItem;
begin
  i := FHashSize;
  NilPointer := nil;
  Run := @FHash^[0];
  repeat
    Run^ := NilPointer;
    Inc(Run);
    Dec(i);
  until i = 0;
end;

function TDIAbstractSQLite3Cache.InvalidateItem(const AID: Int64): Boolean;
var
  Item: PDICacheItem;
begin
  Item := InternalDisconnectHashID(AID);
  Result := Assigned(Item);
  if Result then
    begin
      InternalDisconnect(Item);
      InternalConnectLast(Item);
      DoFinalizeItem(@Item^.Data);
      if not Assigned(FUnusedItem) then
        FUnusedItem := Item;
      Dec(FCount);
    end;
end;

procedure TDIAbstractSQLite3Cache.SetItemSize(const Value: Cardinal);
begin
  Assert(FCount = 0, 'ItemSize can only be set when cache is empty.');
  FItemSize := Value;
end;

procedure TDIAbstractSQLite3Cache.SetMaxCount(const AValue: Integer);
var
  Run, Mark: PDICacheItem;
begin
  Assert(AValue > 0, 'MaxCount must be greater than zero.');

  if FCount > AValue then
    begin
      Run := FLastItem;

      if Assigned(FUnusedItem) then
        begin
          repeat
            Mark := Run;
            Run := Mark^.Previous;
            InternalDisconnect(Mark);
            FreeMem(Mark);
          until (Mark = FUnusedItem) or not Assigned(Run);
          FUnusedItem := nil;
        end;

      while (FCount > AValue) and Assigned(Run) do
        begin
          Mark := Run;
          Run := Mark^.Previous;
          if DoAllowAutoDeleteItem(@Mark^.Data) then
            DeleteItem(Mark^.ID);
        end;
    end;

  FMaxCount := AValue;
end;

procedure TDIAbstractSQLite3Cache.SetHashSize(const AValue: Integer);
var
  NewHashSize: Integer;
  Run: PDICacheItem;
begin
  if AValue > MIN_HASH_SIZE then
    NewHashSize := AValue or 1
  else
    NewHashSize := MIN_HASH_SIZE;

  if FHashSize <> NewHashSize then
    begin
      FHashSize := NewHashSize;
      ReallocMem(FHash, NewHashSize * SizeOf(FHash^[0]));
      InvalidateHashArray;

      if Assigned(FUnusedItem) then
        begin
          Run := FUnusedItem^.Previous;
          if not Assigned(Run) then
            Run := FLastItem;
        end
      else
        Run := FLastItem;

      while Assigned(Run) and (Run <> FUnusedItem) do
        begin
          InternalConnectHash(Run);
          Run := Run^.Previous;
        end;
    end;
end;

procedure TDISQLite3Cache.DoInitializeItem(const AItem: Pointer);
begin
end;

procedure TDISQLite3Cache.DoFinalizeItem(const AItem: Pointer);
begin
end;

end.