absmain.pas

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

//==============================================================================
// Product name: Absolute Database
// Copyright 2003 ComponentAce
//==============================================================================
//==============================================================================
// Product name: Absolute Database
// Copyright 2003 ComponentAce
//==============================================================================
unit ABSMain;

interface

{$I ABSVer.inc}

uses SysUtils, Math, Classes,Db,Windows {$IFNDEF NO_DIALOGS},Forms, Controls, Dialogs{$ENDIF},
{$IFDEF D6H}
     DBCommon,
     Variants,
     SqlTimSt,
{$ENDIF}


// AbsoluteDatabase units

     {$IFDEF LOCAL_VERSION}
     ABSLocalEngine,
     {$ENDIF}

{$IFNDEF D6H}
     ABSD4Routines,
{$ENDIF}

     {$IFDEF DEBUG_MEMCHECK}
     MemCheck,
     {$ENDIF}

     {$IFDEF DEBUG_LOG}
     ABSDebug,
     {$ENDIF}

     {$IFDEF CLIENT_VERSION}
     ABSClient,
     {$ENDIF}
     ABSBase,
     {$IFNDEF NO_DIALOGS}
     ABSDlgWait,
     {$ENDIF}
     ABSCompression,
     ABSSecurity,
     ABSVariant,
     ABSConverts,
     ABSExcept,
     ABSSQLProcessor,
     ABSLexer,
     ABSTypes,
     ABSConst,
     ABSMemory;       // UNIT ABSMemory MUST BE LAST !!!


const
  // TABSDataset flags
  dbfOpened     = 0;
  dbfPrepared   = 1;
  dbfExecSQL    = 2;
  dbfTable      = 3;
  dbfFieldList  = 4;
  dbfIndexList  = 5;
  dbfStoredProc = 6;
  dbfExecProc   = 7;
  dbfProcDesc   = 8;
  dbfDatabase   = 9;
  dbfProvider   = 10;
  dbfRepair     = 11;

type

  TABSEngineType = (etLocal, etClient, etServer);
  TCompressionAlgorithm = (caNone,caZLIB,caBZIP,caPPM);
{
  TABSCryptoAlgorithm =   (
                            craNone,
                            craRijndael_128,craRijndael_256,
                            craBlowfish,
                            craTwofish_128,craTwofish_256,
                            craSquare,
                            craDES_Single_8,
                            craDES_Double_8,craDES_Double_16,
                            craDES_Triple_8,craDES_Triple_16,craDES_Triple_24
                          );
}
  // forward declarations
  TABSSession = class;
  TABSDatabase = class;
  TABSDataSet = class;
  TABSTable = class;
  TABSAdvFieldDefs = class;
  TABSAdvIndexDefs = class;

////////////////////////////////////////////////////////////////////////////////
//
// EABSEngineError
//
////////////////////////////////////////////////////////////////////////////////

   EABSEngineError = class(EDatabaseError)
   private
      FErrorCode: Integer;
      FErrorMessage: string;
   public
      constructor Create(ErrorCode: Integer; ErrMessage: String = '');

      property ErrorCode: Integer read FErrorCode;
      property ErrorMessage: string read FErrorMessage;
   end;


////////////////////////////////////////////////////////////////////////////////
//
// TABSBLOBStream
//
////////////////////////////////////////////////////////////////////////////////


  TABSBLOBStream = class (TABSStream)
  private
    FField:      TBlobField;
    FDataSet:    TABSDataSet;
    FBLOBStream: TABSStream; // local or client blob stream
   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(Field: TBlobField; Mode: TBlobStreamMode);
    destructor Destroy; override;
    procedure Truncate;
  public
   // blob stream interface
  end; // TABSBLOBStream



////////////////////////////////////////////////////////////////////////////////
//
// TABSSessionList
//
////////////////////////////////////////////////////////////////////////////////

  // global list of sessions
  TABSSessionList = class(TObject)
   private
    FSessions: TThreadList;
    FSessionNumbers: TBits;

    // adds session to list
    procedure AddSession(ASession: TABSSession);
    // closes all sessions
    procedure CloseAll;
    // Gets sessions count
    function GetCount: Integer;
    // Gets session by No
    function GetSession(Index: Integer): TABSSession;
    // gets current session
    function GetCurrentSession: TABSSession;
    // Gets session by Name
    function GetSessionByName(const SessionName: string): TABSSession;
    // Sets current session
    procedure SetCurrentSession(Value: TABSSession);

   public
    constructor Create;
    destructor Destroy; override;
    // Finds session by name
    function FindSession(const SessionName: string): TABSSession;
    // Gets list of sessions names
    procedure GetSessionNames(List: TStrings);
    // Opens session by name
    function OpenSession(const SessionName: string): TABSSession;

    property Count: Integer read GetCount;
    property CurrentSession: TABSSession read GetCurrentSession write SetCurrentSession;
    property Sessions[Index: Integer]: TABSSession read GetSession; default;
    property List[const SessionName: string]: TABSSession read GetSessionByName;
  end;


////////////////////////////////////////////////////////////////////////////////
//
// TABSSession
//
////////////////////////////////////////////////////////////////////////////////

  TABSDatabaseEvent = (dbOpen, dbClose, dbAdd, dbRemove);
  TABSDatabaseNotifyEvent = procedure(DBEvent: TABSDatabaseEvent; const Param) of object;
  TABSPasswordEvent = procedure(Sender: TObject; var Continue: Boolean) of object;

  TABSProgressEvent = procedure(Sender: TObject; PercentDone: Integer; var Continue: Boolean) of object;
  TABSDataSetNotifyEvent = procedure(DataSet: TObject) of object;

  // TSession replacement for thread-safe use
  TABSSession = class(TComponent)
  private
    FHandle: TABSSessionComponentManager;
    FDatabases: TList;
    FStreamedActive: Boolean;
    FKeepConnections: Boolean;
    FDefault: Boolean;
    FAutoSessionName: Boolean;
    FUpdatingAutoSessionName: Boolean;
    FSessionName: string;
    FSessionNumber: Integer;
    FOnDBNotify: TABSDatabaseNotifyEvent;
    FOnStartup: TNotifyEvent;

    // adds database
    procedure AddDatabase(Value: TABSDatabase);
    // raises exception if active
    procedure CheckInactive;
    // sends notification
    procedure DBNotification(DBEvent: TABSDatabaseEvent; const Param);
    // finds database with specified owner
    function DoFindDatabase(const DatabaseName: string; AOwner: TComponent): TABSDatabase;
    // opens database (thread-safe)
    function DoOpenDatabase(const DatabaseName: string;
                            AOwner: TComponent): TABSDatabase;
    // find DB manager by db name
    function FindDatabaseHandle(const DatabaseName: string): TABSBaseSession;
    // session is active?
    function GetActive: Boolean;
    // gets database by No
    function GetDatabase(Index: Integer): TABSDatabase;
    // gets count of connected databases
    function GetDatabaseCount: Integer;
    // gets handle
    function GetHandle: TABSSessionComponentManager;
    // not auto-session?
    function SessionNameStored: Boolean;
    // makes session current
    procedure MakeCurrent;
    // removes database from list
    procedure RemoveDatabase(Value: TABSDatabase);
    // opens session
    procedure SetActive(Value: Boolean);
    // sets auto-session name
    procedure SetAutoSessionName(Value: Boolean);
    // sets the name of session
    procedure SetSessionName(const Value: string);
    // sets session name to datasets and databases
    procedure SetSessionNames;
    // starts session
    procedure StartSession(Value: Boolean);
    // updates auto-session name
    procedure UpdateAutoSessionName;
    // auto-session name is valid?
    procedure ValidateAutoSession(AOwner: TComponent; AllSessions: Boolean);

  protected
    // loaded
    procedure Loaded; override;
    // send notification to datasets and databases
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    property OnDBNotify: TABSDatabaseNotifyEvent read FOnDBNotify write FOnDBNotify;
    // set name of component
    procedure SetName(const NewName: TComponentName); override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    // locks session
    procedure LockSession;
    // unlocks session
    procedure UnlockSession;
    // closes session
    procedure Close;
    // closes database
    procedure CloseDatabase(Database: TABSDatabase);
    // drops all connections
    procedure DropConnections;
    // finds database by name
    function FindDatabase(const DatabaseName: string): TABSDatabase;
    // get list of database names
    procedure GetDatabaseNames(List: TStrings);
    // get list of database tables
    procedure GetTableNames(const DatabaseName: string; List: TStrings);
    // opens session
    procedure Open;
    // opens database
    function OpenDatabase(const DatabaseName: string): TABSDatabase;

    property DatabaseCount: Integer read GetDatabaseCount;
    property Databases[Index: Integer]: TABSDatabase read GetDatabase;
    property Handle: TABSSessionComponentManager read GetHandle;

  published
    property Active: Boolean read GetActive write SetActive default False;
    property AutoSessionName: Boolean read FAutoSessionName write SetAutoSessionName default False;
    property KeepConnections: Boolean read FKeepConnections write FKeepConnections default True;
    property SessionName: string read FSessionName write SetSessionName stored SessionNameStored;
    property OnStartup: TNotifyEvent read FOnStartup write FOnStartup;
  end;


////////////////////////////////////////////////////////////////////////////////
//
// TABSDataset
//
////////////////////////////////////////////////////////////////////////////////


 TABSDBFlags = set of 0..15;