abslocalengine.pas

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

unit ABSLocalEngine;

{$I ABSVer.inc}

interface

uses SysUtils, Classes, Windows,

// AbsoluteDatabase units

     ABSRelationalAlgebra,
     {$IFDEF DEBUG_LOG}
     ABSDebug,
     {$ENDIF}
     ABSExcept,
     ABSBase,
     ABSBaseEngine,
     {$IFDEF MEMORY_ENGINE}
     ABSMemEngine,
     {$ENDIF}
     {$IFDEF TEMPORARY_ENGINE}
     ABSTempEngine,
     {$ENDIF}
     {$IFDEF DISK_ENGINE}
     ABSDiskEngine,
     {$ENDIF}
     ABSConverts,
     ABSVariant,
     ABSCompression,
     ABSSecurity,
     ABSTypes,
     ABSSQLProcessor,
     ABSExpressions,
     ABSConst,
     ABSMemory;


type


////////////////////////////////////////////////////////////////////////////////
//
// TABSLocalBLOBStream
//
////////////////////////////////////////////////////////////////////////////////

  // local BLOB stream
  TABSLocalBLOBStream = class (TABSStream)
   private
    FOpenMode:         TABSBLOBOpenMode;
    FTemporaryStream:  TABSStream;
    FUserBLOBStream:   TABSStream;
    FFieldNo:          Integer;
    FCursor:           TABSCursor;
    FPosition:         Int64;
   protected
    // sets new size of the stream
    procedure InternalSetSize(const NewSize: Int64);
    // sets new size of the stream
    procedure SetSize(NewSize: Longint);
    {$IFDEF D6H}
      overload;
    {$ENDIF}
      override;
    {$IFDEF D6H}
    procedure SetSize(const NewSize: Int64); overload; override;
    {$ENDIF}
   public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint;
    {$IFDEF D6H}
            overload;
    {$ENDIF}
      override;
    {$IFDEF D6H}
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
    {$ENDIF}
    constructor Create(
                        TemporaryStream: TABSStream;
                        Cursor: TABSCursor;
                        OpenMode: TABSBLOBOpenMode;
                        FieldNo: Integer
                      );
    destructor Destroy; override;
   public
    // blob stream interface
   public
    property Cursor: TABSCursor read FCursor;
    property FieldNo: Integer read FFieldNo;
    property OpenMode: TABSBLOBOpenMode read FOpenMode write FOpenMode;
    property TemporaryStream: TABSStream read FTemporaryStream write FTemporaryStream;
    property UserBLOBStream: TABSStream read FUserBLOBStream write FUserBLOBStream;
  end; // TABSLocalBLOBtream


////////////////////////////////////////////////////////////////////////////////
//
// TABSLocalSQLProcessor
//
////////////////////////////////////////////////////////////////////////////////


  TABSLocalSQLProcessor = class (TABSSQLProcessor)
  end; // TABSLocalSQLProcessor


////////////////////////////////////////////////////////////////////////////////
//
// TABSLocalCursor
//
////////////////////////////////////////////////////////////////////////////////


  TABSLocalCursor = class (TABSCursor)
   private
    FTableData:                     TABSTableData;
    FDatabaseData:                  TABSDatabaseData;

   public
    constructor Create;
    destructor Destroy; override;
    // create table
    procedure CreateTable(
                          FieldDefs: TABSFieldDefs;
                          IndexDefs: TABSIndexDefs;
                          ConstraintDefs: TABSConstraintDefs
                         ); override;
    procedure DeleteTable; override;
    procedure EmptyTable; override;
    procedure RenameTable(NewTableName: String); override;
    procedure InternalInitFieldDefs; override;
    procedure OpenTableByFieldDefs(
                          FieldDefs: TABSFieldDefs;
                          IndexDefs: TABSIndexDefs;
                          ConstraintDefs: TABSConstraintDefs
                       ); override;
    procedure OpenTable(aTableData: TABSTableData);
    procedure CloseTable; override;
    procedure LockTableData; override;
    procedure UnlockTableData; override;
    function LockTable(LockType: TABSLockType;
                       TryCount, Delay: Integer;
                       AllowXIRWAfterSIRW: Boolean = True): Boolean; override;
    function UnlockTable(LockType: TABSLockType; IgnoreIfNoLock: Boolean=False): Boolean; override;

    // initialize record buffer
    procedure InternalInitRecord(RecordBuffer: TABSRecordBuffer;
                InsertMode: Boolean); override;

    // Rename Field by Field Index in FieldDefs
    procedure RenameField(FieldName, NewFieldName: String); override;

    procedure CopyFieldValue(SrcFieldNo: Integer;
                             DirectAccess: Boolean;
                             DestFieldNo: Integer;
                             DestCursor: TABSCursor); override;

    // index operations
    function GetIndexDefs: TABSIndexDefs; override;
    procedure AddIndex(IndexDef: TABSIndexDef); override;
    procedure DeleteIndex(Name: String); override;
    procedure DeleteAllIndexes; override;
    // return index name
    function FindOrCreateIndex(FieldNamesList, AscDescList,
              CaseSensitivityList: TStringList; var IsCreated: Boolean): String; override;
    function IndexExists(FieldNamesList, AscDescList, CaseSensitivityList: TStringList): Boolean; override;

    //---------------------------------------------------------------------------
    // navigation & bookmark methods
    //---------------------------------------------------------------------------
    procedure FreeRecordBuffer(var Buffer: TABSRecordBuffer); override;
    function GetRecordBuffer(
              GetRecordMode:  TABSGetRecordMode
              ): TABSGetRecordResult; override;
    function GetRecordCount: TABSRecordNo; override;
    // go to record
    procedure SetRecNo(Value: TABSRecordNo); override;
    function GetRecNo: TABSRecordNo; override;

    // go to first record
    procedure InternalFirst; override;
    // go to last record
    procedure InternalLast; override;

    //---------------------------------------------------------------------------
    // insert, edit, post, delete methods
    //---------------------------------------------------------------------------
    // insert record
    procedure InternalInsert; override;
    // edit record
    procedure InternalEdit; override;
    // cancels updates
    procedure InternalCancel(ToInsert: Boolean); override;
    // insert or update record
    procedure InternalPost(ToInsert: Boolean); override;
    // delete record
    procedure InternalDelete; override;

    //---------------------------------------------------------------------------
    // search & filter methods
    //---------------------------------------------------------------------------

    // set distinct
    procedure ApplyDistinct(FieldNamesList, AscDescList, CaseSensitivityList: TStringList); override;
    procedure ActivateFilters(
                              FilterText:      String;
                              CaseInsensitive: Boolean;
                              PartialKey:      Boolean
                            ); override;
    procedure DeactivateFilters; override;
    function Locate(
                    const KeyFields: String;
                    const KeyValues: Variant;
                    CaseInsensitive: Boolean;
                    PartialKey:      Boolean
                   ): Boolean; override;
    function FindKey(SearchCondition: TABSSearchCondition): Boolean; override;
    // used by SQL: "where field > all (select ...)"
    function IsAnyRecordMatchCondition(const FieldName: string;
          const Operator: TABSDataOperator; const Value: TABSVariant): Boolean; override;

    //---------------------------------------------------------------------------
    // BLOB methods
    //---------------------------------------------------------------------------

    function InternalCreateBlobStream(
              ToInsert: Boolean;
              ToEdit: Boolean;
              FieldNo:  Integer;
              OpenMode: TABSBLOBOpenMode;
              CanDoGetRecordBuffer: Boolean
              ):TABSStream; override;

    procedure InternalCloseBLOB(FieldNo: Integer); override;

    // clear blob streams
    procedure ClearBLOBStreams(WriteOnly: Boolean = False); override;

    function LastAutoincValue(FieldNo: Integer): Int64; override;

    // batch update methods
    procedure BeginBatchUpdate; override;
    procedure EndBatchUpdate; override;
    procedure CancelBatchUpdate; override;

    function CheckConstraints(ToInsert: Boolean): Boolean; override;

   public
    property TableData: TABSTableData read FTableData;
    property DatabaseData: TABSDatabaseData read FDatabaseData;
  end; // TABSLocalCursor


////////////////////////////////////////////////////////////////////////////////
//
// TABSLocalSession
//
////////////////////////////////////////////////////////////////////////////////


  TABSLocalSession = class (TABSBaseSession)
   private
    FDatabaseData:  TABSDatabaseData;
    FPassword:      TABSPassword;
    FPageSize:            Integer;
    FPageCountInExtent:   Integer;

    function GetPassword: PABSPassword;
    function IsAppropriateDatabaseData(DBData: TABSDatabaseData): Boolean;
    function FindDatabaseData: TABSDatabaseData;
    function CreateDatabaseData: TABSDatabaseData;
    function FindOrCreateDatabaseData: TABSDatabaseData;

   protected
    // db connected?
    function GetConnected: Boolean; override;
    // connect / disconnect
    procedure SetConnected(Value: boolean); override;
    function GetSuppressDBHeaderErrors: Boolean; override;
    procedure SetSuppressDBHeaderErrors(Value: boolean); override;

   public
    // create database
    procedure CreateDatabase; override;
    // Truncate for empty pages
    procedure TruncateDatabase;
    // return Count of connections to Database File or -1 if it's openned in Exclusive
    function GetDBFileConnectionsCount: Integer;
    // delete database
    procedure DeleteDatabase; override;
    // rename database
    procedure RenameDatabase(NewDatabaseFileName: String); override;
    // check if database exists
    procedure GetTablesList(List: TStrings); override;
    function TableExists(TableName: String): Boolean; override;

    procedure StartTransaction; override;
    procedure Commit(DoFlushBuffers: Boolean=True); override;
    procedure Rollback; override;
    procedure FlushBuffers; override;

    property DatabaseData: TABSDatabaseData read FDatabaseData;
    property Password: PABSPassword read GetPassword;
    property PageSize: Integer read FPageSize write FPageSize;
    property PageCountInExtent: Integer read FPageCountInExtent write FPageCountInExtent;
  end; // TABSLocalSession

var
  DBDataList: TThreadList;

implementation


////////////////////////////////////////////////////////////////////////////////
//
// TABSLocalBLOBStream
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TABSLocalBLOBStream.InternalSetSize(const NewSize: Int64);
begin
 if (OpenMode = bomRead) then
  raise EABSException.Create(10116,ErrorLCannotWriteToReadOnlyStream);
 FTemporaryStream.Size := NewSize;
end; // InternalSetSize


//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TABSLocalBLOBStream.SetSize(NewSize: Longint);
begin
 InternalSetSize(NewSize);
end; // SetSize


{$IFDEF D6H}
//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TABSLocalBLOBStream.SetSize(const NewSize: Int64);
begin
 InternalSetSize(NewSize);
end; // SetSize
{$ENDIF}


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
function TABSLocalBLOBStream.Read(var Buffer; Count: Longint): Longint;
begin
 Result := FTemporaryStream.Read(Buffer,Count);
end; // Read


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
function TABSLocalBLOBStream.Write(const Buffer; Count: Longint): Longint;
begin
 if (OpenMode = bomRead) then
  raise EABSException.Create(10115,ErrorLCannotWriteToReadOnlyStream);
 Result := FTemporaryStream.Write(Buffer,Count);
end; // Write


//------------------------------------------------------------------------------