abspage.pas

Absolute Database 是来替代BDE[Borland数据库引擎]的用于Delphi 和 C++ Builder 开发用的数据库引擎. 它小巧, 高速, 健壮, 易于使用. 它能直接编译进

unit ABSPage;

{$I ABSVer.inc}

interface

uses Classes, Windows, Math,

// AbsoluteDatabase units
     {$IFDEF DEBUG_LOG}
     ABSDebug,
     {$ENDIF}
     ABSExcept,
     ABSMemory,
     ABSConst,
     ABSTypes;

type

  TABSPageManager = class;
  TABSSortedPageList = class;

////////////////////////////////////////////////////////////////////////////////
//
// TABSPage
//
////////////////////////////////////////////////////////////////////////////////
  TABSPageTableStateInfo = packed record
     TableState: Integer;
     IsTableStateValueAssigned: Boolean;
  end;

  TABSPage = class(TObject)
   private
     LPageManager:          TABSPageManager;
     FPageNo:               TABSPageNo;
     FPageBuffer:           TABSPageBuffer;
     FOwnBuffer:            Boolean;
     FIsDirty:              Boolean;
     FUseCount:             Integer;
     FParentList:           TABSSortedPageList;
     FSessionID:            TABSSessionID;
     FReloaded:             Boolean;
     FEncryptionEnabled:    Boolean;
     FTableStates:          array of TABSPageTableStateInfo;

     function GetPageHeader: PABSDiskPageHeader;
     function GetPageHeaderSize: Integer;
     function GetPageData: TABSPageBuffer;
     function GetPageDataSize: Integer;
     function GetPageSize: Integer;

     procedure InitHeader;

   public
     constructor Create(PageManager: TABSPageManager);
     destructor Destroy; override;
     procedure ClearPageBuffer;
     procedure AllocPageBuffer;
     procedure FreeAndNilPageBuffer;
     procedure EnlargePageBuffer(NewSize: Integer);
     procedure Synchronize;
     function GetTableState(SessionID: TABSSessionID; var TableState: Integer): Boolean;
     procedure SetTableState(SessionID: TABSSessionID; TableState: Integer);

     property PageNo: TABSPageNo read FPageNo write FPageNo;
     property PageSize: Integer read GetPageSize;
     property PageBuffer: TABSPageBuffer read FPageBuffer write FPageBuffer;
     property OwnBuffer: Boolean read FOwnBuffer write FOwnBuffer;
     property IsDirty: Boolean read FIsDirty write FIsDirty;
     property UseCount: Integer read FUseCount write FUseCount;
     property PageManager: TABSPageManager read LPageManager write LPageManager;
     property PageHeader: PABSDiskPageHeader read GetPageHeader;
     property PageHeaderSize: Integer read GetPageHeaderSize;
     property PageData: TABSPageBuffer read GetPageData;
     property PageDataSize: Integer read GetPageDataSize;
     property ParentList: TABSSortedPageList read FParentList write FParentList;
     property SessionID: TABSSessionID read FSessionID write FSessionID;
     property Reloaded: Boolean read FReloaded write FReloaded;
     property EncryptionEnabled: Boolean read FEncryptionEnabled write FEncryptionEnabled;
end;// TABSPage


////////////////////////////////////////////////////////////////////////////////
//
// TABSPageController
//
////////////////////////////////////////////////////////////////////////////////

  TABSPageController = class(TObject)
   private
    LPage:  TABSPage;
   protected
     procedure SetPageNo(Value: TABSPageNo);
     function GetPageNo: TABSPageNo;
     function GetPageSize: Integer;
     procedure SetPageBuffer(Value: TABSPageBuffer);
     function GetPageBuffer: TABSPageBuffer;
     procedure SetOwnBuffer(Value: Boolean);
     function GetOwnBuffer: Boolean;
     procedure SetIsDirty(Value: Boolean);
     function GetIsDirty: Boolean;
     procedure SetUseCount(Value: Integer);
     function GetUseCount: Integer;
     function GetPageManager: TABSPageManager;
     function GetPageData: TABSPageBuffer;
     function GetPageDataSize: Integer;
   public
     procedure EnlargePageBuffer(NewSize: Integer);

     property Page: TABSPage read LPage write LPage;
     property PageNo: TABSPageNo read GetPageNo write SetPageNo;
     property PageSize: Integer read GetPageSize;
     property PageBuffer: TABSPageBuffer read GetPageBuffer write SetPageBuffer;
     property OwnBuffer: Boolean read GetOwnBuffer write SetOwnBuffer;
     property IsDirty: Boolean read GetIsDirty write SetIsDirty;
     property UseCount: Integer read GetUseCount write SetUseCount;
     property PageManager: TABSPageManager read GetPageManager;
     property PageData: TABSPageBuffer read GetPageData;
     property PageDataSize: Integer read GetPageDataSize;
  end;// TABSPageController



////////////////////////////////////////////////////////////////////////////////
//
// TABSSortedPageList
//
////////////////////////////////////////////////////////////////////////////////

 TABSPageElement = record
   Page:     TABSPage;
   LRUCount: Int64;
 end;

 TABSSortedPageList = class(TObject)
  private
   KeyItems: array of integer;
   ItemCount: integer;
   AllocBy: integer;
   deAllocBy: integer;
   MaxAllocBy: integer;
   AllocItemCount: integer;
   LRUCount: Int64;
   LRULastFound: Integer;

   function FindPositionForInsert(key: Integer) : Integer;
   function FindPosition(key: Integer): Integer;
   procedure InsertByPosition(ItemNo, key: integer; var value: TABSPageElement);
   procedure DeleteByPosition(ItemNo: integer);

  public
   ValueItems: array of TABSPageElement;

   constructor Create(size: integer=0);
   procedure SetSize(newSize: integer);
   function Find(key: Integer): TABSPage;
   procedure Insert(Page: TABSPage);
   procedure Delete(PageNo: integer);
   procedure Clear;

   function FirstByLRU: TABSPage;
   function NextByLRU: TABSPage;
   procedure UpdateLRU(Page: TABSPage);

   property Count: Integer read ItemCount;
 end;//TABSSortedPageList


////////////////////////////////////////////////////////////////////////////////
//
// TABSPageManager
//
////////////////////////////////////////////////////////////////////////////////

  TABSSessionPageInfo = record
    SessionID:          TABSSessionID;
    DirtyPages:         TABSSortedPageList;
    AddedPageNumbers:   TABSPagesArray;
    RemovedPageNumbers: TABSPagesArray;
  end;

  TABSPageManager = class (TObject)
   protected
     FCSect:               TRTLCriticalSection;
     FCacheCapacity:       Integer;
     FSharedPages:         TABSSortedPageList;  // pages shared between all sessions
     FSessions:            array of TABSSessionPageInfo;

     FPageSize:            Word;
     FPageHeaderSize:      Word;
     FPageDataSize:        Word;
     FPageCount:           TABSPageNo;
     FMultiUser:           Boolean;

     procedure Lock;
     procedure Unlock;
     function AddNewSession(SessionID: TABSSessionID): Integer;
     function FindSession(SessionID: TABSSessionID; var SessionNo: Integer): Boolean;
     function FindPage(Pages: TABSSortedPageList; PageNo: TABSPageNo; var Page: TABSPage): Boolean;
     procedure RemovePageIfExists(Pages: TABSSortedPageList; PageNo: TABSPageNo);

     function GetPageCount: TABSPageNo; virtual;

     function IsSafeNotToSyncPage(SessionID: TABSSessionID; Page: TABSPage): Boolean; virtual;
     procedure UpdatePageTableState(SessionID: TABSSessionID; Page: TABSPage); virtual;

   public
     procedure LoadFromStream(Stream: TStream); virtual;
     procedure SaveToStream(Stream: TStream); virtual;
     procedure InternalAddPage(aPage: TABSPage); virtual; abstract;
     procedure InternalRemovePage(PageNo: TABSPageNo); virtual; abstract;
     function InternalReadPage(aPage: TABSPage): Boolean; virtual; abstract;
     procedure InternalWritePage(aPage: TABSPage); virtual; abstract;
     constructor Create;
     destructor Destroy; override;
     function AddPage(SessionID: TABSSessionID; PageType: TABSPageTypeID): TABSPage;
     procedure RemovePage(SessionID: TABSSessionID; PageNo: TABSPageNo); virtual;
     function GetPage(SessionID: TABSSessionID; PageNo: TABSPageNo;
             PageType: TABSPageTypeID; SynchronizeAllowed: Boolean = True): TABSPage; virtual;
     procedure PutPage(aPage: TABSPage);
     procedure ApplyChanges(SessionID: TABSSessionID); virtual;
     procedure CancelChanges(SessionID: TABSSessionID);

     property PageSize: Word read FPageSize;
     property PageHeaderSize: Word read FPageHeaderSize;
     property PageDataSize: Word read FPageDataSize;
     property PageCount: TABSPageNo read GetPageCount;
     property MultiUser: Boolean read FMultiUser write FMultiUser;
  end; // TABSPageManager



implementation

uses ABSBTree, ABSBaseEngine, ABSDiskEngine;

////////////////////////////////////////////////////////////////////////////////
//
// TABSPage
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// GetPageHEader
//------------------------------------------------------------------------------
function TABSPage.GetPageHeader: PABSDiskPageHeader;
begin
  Result := PABSDiskPageHeader(FPageBuffer);
end; // GetPageHeader


//------------------------------------------------------------------------------
// GetPageData
//------------------------------------------------------------------------------
function TABSPage.GetPageHeaderSize: Integer;
begin
  Result := LPageManager.PageHeaderSize;
end;//GetPageHeaderSize


//------------------------------------------------------------------------------
// GetPageData
//------------------------------------------------------------------------------
function TABSPage.GetPageData: TABSPageBuffer;
begin
  Result := TABSPageBuffer(FPageBuffer + PageHeaderSize);
end;//GetPageData


//------------------------------------------------------------------------------
// GetPageDataSize
//------------------------------------------------------------------------------
function TABSPage.GetPageDataSize: Integer;
begin
  Result := PageSize - PageHeaderSize;
end;//GetPageDataSize


//------------------------------------------------------------------------------
// GetPageSize
//------------------------------------------------------------------------------
function TABSPage.GetPageSize: Integer;
begin
  Result := LPageManager.PageSize;
end;// GetPageSize


//------------------------------------------------------------------------------
// InitHeader
//------------------------------------------------------------------------------
procedure TABSPage.InitHeader;
begin
  PageHeader.Signature := ABSDiskPageSignature;
  PageHeader.State := 0;
  PageHeader.PageType := ptUnknown;
  PageHeader.NextPageNo := INVALID_PAGE_NO;
  PageHeader.CRC32 := 0;
  PageHeader.CRCType := 0;
  PageHeader.HashType := 0;
  PageHeader.Cipherype := 0;
  PageHeader.MACType := 0;
  PageHeader.ObjectID := INVALID_OBJECT_ID;
  PageHeader.RecordID.PageNo := INVALID_PAGE_NO;
  PageHeader.RecordID.PageItemNo := 0;
end;//InitHeader


//------------------------------------------------------------------------------
// constructor
//------------------------------------------------------------------------------
constructor TABSPage.Create(PageManager: TABSPageManager);
begin
  LPageManager := PageManager;
  FPageBuffer := nil;
  FPageNo := INVALID_PAGE_NO;
  FOwnBuffer := True;
  FIsDirty := False;
  FUseCount := 0;
  FReloaded := False;
  FEncryptionEnabled := True;
end;// Create


//------------------------------------------------------------------------------
// destructor
//------------------------------------------------------------------------------
destructor TABSPage.Destroy;
begin
  if (FOwnBuffer) then
    FreeAndNilPageBuffer;
end;// Destroy


//------------------------------------------------------------------------------
// ClearPageBuffer
//------------------------------------------------------------------------------
procedure TABSPage.ClearPageBuffer;
begin
  FillChar(FPageBuffer^,PageSize,00);
end;// ClearPageBuffer


//------------------------------------------------------------------------------
// AllocPageBuffer
//------------------------------------------------------------------------------
procedure TABSPage.AllocPageBuffer;
begin
  //FPageBuffer := MemoryManager.GetMem(PageSize);
  FPageBuffer := MemoryManager.AllocMem(PageSize);
  InitHeader;
end;// AllocPageBuffer


//------------------------------------------------------------------------------
// FreeAndNilPageBuffer
//------------------------------------------------------------------------------
procedure TABSPage.FreeAndNilPageBuffer;
begin
  if (FPageBuffer <> nil) then
   MemoryManager.FreeAndNillMem(FPageBuffer);
end;// FreeAndNilPageBuffer


//------------------------------------------------------------------------------
// EnlargePageBuffer
//------------------------------------------------------------------------------
procedure TABSPage.EnlargePageBuffer(NewSize: Integer);
var
  NewBuffer: PChar;
begin
  if (FPageBuffer = nil) then
   raise EABSException.Create(20038, ErrorAInvalidPageBuffer);
  if (NewSize < PageSize) then
   raise EABSException.Create(20039, ErrorAInvalidPageModification);

  if (FOwnBuffer) then
    MemoryManager.ReallocMem(FPageBuffer, NewSize)
  else
   begin
     NewBuffer := MemoryManager.AllocMem(NewSize);
     Move(FPageBuffer^, NewBuffer^, PageSize);
     FPageBuffer := NewBuffer;
     FOwnBuffer := True;
   end;
end;// EnlargePageBuffer


//------------------------------------------------------------------------------
// Synchronize
//------------------------------------------------------------------------------
procedure TABSPage.Synchronize;
{$IFDEF FILE_SERVER_VERSION}
var
  NewState: Integer;
{$ENDIF}
begin
{$IFDEF FILE_SERVER_VERSION}
  if (LPageManager is TABSDiskPageManager) then
    if (LPageManager.MultiUser) then
      begin
        NewState := TABSDiskPageManager(LPageManager).InternalReadPageState(PageNo);
        if ((NewState <> DELETED_PAGE_STATE) and (PageHeader^.State <> NewState)) then
          LPageManager.InternalReadPage(Self)
        else
          PageHeader^.State := NewState;
      end;
{$ENDIF}
end;// Synchronize


//------------------------------------------------------------------------------
// GetTableState
//------------------------------------------------------------------------------
function TABSPage.GetTableState(SessionID: TABSSessionID; var TableState: Integer): Boolean;
var
  Index: Integer;
begin
  Index := SessionID - MIN_SESSION_ID;
  if (Index < Length(FTableStates)) then
    begin
      Result := FTableStates[Index].IsTableStateValueAssigned;
      TableState := FTableStates[Index].TableState;
    end
  else
    Result := False;
end;// GetTableState


//------------------------------------------------------------------------------
// SetTableState
//------------------------------------------------------------------------------
procedure TABSPage.SetTableState(SessionID: TABSSessionID; TableState: Integer);
var
  Index: Integer;
  OldLength: Integer;
  i: Integer;
begin
  Index := SessionID - MIN_SESSION_ID;
  if (Index >= Length(FTableStates)) then
    begin
      OldLength := Length(FTableStates);
      SetLength(FTableStates, Index+1);
      for i:= OldLength to Index-1 do
        FTableStates[Index].IsTableStateValueAssigned := False;
    end;
  FTableStates[Index].IsTableStateValueAssigned := True;