myldblocalengine.pas

一个本地database引擎,支持中文T_Sql查询,兼容DELPHI标准数据库控件

unit MYLDBLocalEngine;

{$I MYLDBVer.inc}

interface

uses SysUtils, Classes, Windows,

// MYLDBoluteDatabase units

     MYLDBRelationalAlgebra,
     {$IFDEF DEBUG_LOG}
     MYLDBDebug,
     {$ENDIF}
     MYLDBExcept,
     MYLDBBase,
     MYLDBBaseEngine,
     {$IFDEF MEMORY_ENGINE}
     MYLDBMemEngine,
     {$ENDIF}
     {$IFDEF TEMPORARY_ENGINE}
     MYLDBTempEngine,
     {$ENDIF}
     {$IFDEF DISK_ENGINE}
     MYLDBDiskEngine,
     {$ENDIF}
     MYLDBConverts,
     MYLDBVariant,
     MYLDBCompression,
     MYLDBSecurity,
     MYLDBTypes,
     MYLDBSQLProcessor,
     MYLDBExpressions,
     MYLDBConst,
     MYLDBMemory;


type


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBLocalBLOBStream
//
////////////////////////////////////////////////////////////////////////////////

  // local BLOB stream
  TMYLDBLocalBLOBStream = class (TMYLDBStream)
   private
    FOpenMode:         TMYLDBBLOBOpenMode;
    FTemporaryStream:  TMYLDBStream;
    FUserBLOBStream:   TMYLDBStream;
    FFieldNo:          Integer;
    FCursor:           TMYLDBCursor;
    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: TMYLDBStream;
                        Cursor: TMYLDBCursor;
                        OpenMode: TMYLDBBLOBOpenMode;
                        FieldNo: Integer
                      );
    destructor Destroy; override;
   public
    // blob stream interface
   public
    property Cursor: TMYLDBCursor read FCursor;
    property FieldNo: Integer read FFieldNo;
    property OpenMode: TMYLDBBLOBOpenMode read FOpenMode write FOpenMode;
    property TemporaryStream: TMYLDBStream read FTemporaryStream write FTemporaryStream;
    property UserBLOBStream: TMYLDBStream read FUserBLOBStream write FUserBLOBStream;
  end; // TMYLDBLocalBLOBtream


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBLocalSQLProcessor
//
////////////////////////////////////////////////////////////////////////////////


  TMYLDBLocalSQLProcessor = class (TMYLDBSQLProcessor)
  end; // TMYLDBLocalSQLProcessor


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBLocalCursor
//
////////////////////////////////////////////////////////////////////////////////


  TMYLDBLocalCursor = class (TMYLDBCursor)
   private
    FTableData:                     TMYLDBTableData;
    FDatabaseData:                  TMYLDBDatabaseData;

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

    // initialize record buffer
    procedure InternalInitRecord(RecordBuffer: TMYLDBRecordBuffer;
                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: TMYLDBCursor); override;

    // index operations
    function GetIndexDefs: TMYLDBIndexDefs; override;
    procedure AddIndex(IndexDef: TMYLDBIndexDef); 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: TMYLDBRecordBuffer); override;
    function GetRecordBuffer(
              GetRecordMode:  TMYLDBGetRecordMode
              ): TMYLDBGetRecordResult; override;
    function GetRecordCount: TMYLDBRecordNo; override;
    // go to record
    procedure SetRecNo(Value: TMYLDBRecordNo); override;
    function GetRecNo: TMYLDBRecordNo; 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: TMYLDBSearchCondition): Boolean; override;
    // used by SQL: "where field > all (select ...)"
    function IsAnyRecordMatchCondition(const FieldName: string;
          const Operator: TMYLDBDataOperator; const Value: TMYLDBVariant): Boolean; override;

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

    function InternalCreateBlobStream(
              ToInsert: Boolean;
              ToEdit: Boolean;
              FieldNo:  Integer;
              OpenMode: TMYLDBBLOBOpenMode;
              CanDoGetRecordBuffer: Boolean
              ):TMYLDBStream; 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: TMYLDBTableData read FTableData;
    property DatabaseData: TMYLDBDatabaseData read FDatabaseData;
  end; // TMYLDBLocalCursor


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBLocalSession
//
////////////////////////////////////////////////////////////////////////////////


  TMYLDBLocalSession = class (TMYLDBBaseSession)
   private
    FDatabaseData:  TMYLDBDatabaseData;
    FPassword:      TMYLDBPassword;
    FPageSize:            Integer;
    FPageCountInExtent:   Integer;

    function GetPassword: PMYLDBPassword;
    function IsAppropriateDatabaseData(DBData: TMYLDBDatabaseData): Boolean;
    function FindDatabaseData: TMYLDBDatabaseData;
    function CreateDatabaseData: TMYLDBDatabaseData;
    function FindOrCreateDatabaseData: TMYLDBDatabaseData;

   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: TMYLDBDatabaseData read FDatabaseData;
    property Password: PMYLDBPassword read GetPassword;
    property PageSize: Integer read FPageSize write FPageSize;
    property PageCountInExtent: Integer read FPageCountInExtent write FPageCountInExtent;
  end; // TMYLDBLocalSession

var
  DBDataList: TThreadList;

implementation


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBLocalBLOBStream
//
////////////////////////////////////////////////////////////////////////////////


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


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


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


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


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