absmain.~pas

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

    procedure PSSetCommandText(const CommandText: string); override;
    procedure PSSetParams(AParams: TParams); override;
{$ENDIF}
    procedure GetStatementHandle(SQLText: PChar);
    procedure FreeStatement;
    function CreateCursor(GenHandle: Boolean): TABSCursor;
    function GetQueryCursor(GenHandle: Boolean): TABSCursor;
    function GetRowsAffected: Integer;
    procedure QueryChanged(Sender: TObject);
    function GetDataSource: TDataSource; override;
    procedure SetDataSource(Value: TDataSource);
    procedure SetQuery(Value: TStrings);
    procedure InternalRefresh; override;

    function GetParamsCount: Word;
    procedure RefreshParams;
    procedure SetParamsList(Value: TParams);
    procedure SetParamsFromCursor;
  public
    function ParamByName(const Value: string): TParam;

    procedure Prepare;
    procedure UnPrepare;
  protected
    procedure PrepareSQL(Value: PChar);
    procedure SetPrepared(Value: Boolean);
    procedure SetPrepare(Value: Boolean);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadBinaryData(Stream: TStream);
    procedure WriteBinaryData(Stream: TStream);
    procedure ReadParamData(Reader: TReader);
    procedure WriteParamData(Writer: TWriter);
  protected
    function CreateHandle: TABSCursor; override;
    procedure Disconnect; override;
    procedure SetDBFlag(Flag: Integer; Value: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ExecSQL;
    procedure GetDetailLinkFields(MasterFields, DetailFields: TList); override;
  public
    property Prepared: Boolean read FPrepared write SetPrepare;
    property ParamCount: Word read GetParamsCount;
    property StmtHandle: TABSSQLProcessor read FStmtHandle;
    property Text: string read FText;
    property RowsAffected: Integer read GetRowsAffected;
    property SQLBinary: PChar read FSQLBinary write FSQLBinary;
  published
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
    property RequestLive: Boolean read FRequestLive write FRequestLive default False;
    property SQL: TStrings read FSQL write SetQuery;
    property Params: TParams read FParams write SetParamsList stored False;
 end; // TABSQuery


////////////////////////////////////////////////////////////////////////////////
//
// TABSDatabase
//
////////////////////////////////////////////////////////////////////////////////
 TABSOnNeedRepairEvent = procedure(Sender: TObject; var DoRepair: Boolean) of Object;

 TABSDatabase = class (TComponent)
  private
    FCurrentVersion:                    String;
    FDataSets:                          TList;
    FKeepConnection:                    Boolean;
    FTemporary:                         Boolean;
    FStreamedConnected:                 Boolean;
    FAcquiredHandle:                    Boolean;
    FHandleShared:                      Boolean;
    FReadOnly:                          Boolean;
    FExclusive:                         Boolean;
    FRefCount:                          Integer;
    FHandle:                            TABSBaseSession;
    FSession:                           TABSSession;
    FSessionName:                       string;
    FDatabaseName:                      string; // name of database
    FDatabaseFileName:                  string; // database file name
    FPassword:                          string;  // password
    FCryptoAlgorithm:                   TABSCryptoAlgorithm;
    FPageSize:                          Integer;
    FPageCountInExtent:                 Integer;
    FNoRequestAutoRepair:               Boolean;
    FSilentMode:                        Boolean;
    FMultiUser:                         Boolean;
    FMaxConnections:                    Integer;
    FDisableTempFiles:                  Boolean;

    FOnPassword:                        TABSPasswordEvent;

    FBeforeRepair:                      TNotifyEvent;
    FOnRepairProgress:                  TABSProgressEvent;
    FAfterRepair:                       TNotifyEvent;

    FBeforeCompact:                     TNotifyEvent;
    FOnCompactProgress:                 TABSProgressEvent;
    FAfterCompact:                      TNotifyEvent;

    FBeforeChangePassword:              TNotifyEvent;
    FOnChangePasswordProgress:          TABSProgressEvent;
    FAfterChangePassword:               TNotifyEvent;

    FAfterChangeDatabaseSettings:       TNotifyEvent;
    FOnChangeDatabaseSettingsProgress:  TABSProgressEvent;
    FBeforeChangeDatabaseSettings:      TNotifyEvent;

    FOnNeedRepair:                      TABSOnNeedRepairEvent;
    {$IFNDEF NO_DIALOGS}
    frmWait:                            TfrmWait;
    {$ENDIF}

    procedure CheckActive;
    // raises exception if not active
    procedure CheckInactive;
    // raises exception if database name is not valid
    procedure CheckDatabaseName;
    // checks session name
    procedure CheckSessionName(Required: Boolean);
    procedure CheckConnected;
    // db connected?
    function GetConnected: Boolean;
    // connected dataset
    function GetDataSet(Index: Integer): TABSDataSet;
    // count of connected datasets
    function GetDataSetCount: Integer;
    // opens from existing DB
    function OpenFromExistingDB: Boolean;

    // sets specified file name
    procedure SetDatabaseFileName(Value: string);
    // sets specified database name
    procedure SetDatabaseName(Value: string);
    // sets handle
    procedure SetHandle(Value: TABSBaseSession);
    // keeps connection
    procedure SetKeepConnection(Value: Boolean);
    // sets read-only mode
    procedure SetReadOnly(Value: Boolean);
    // sets session name
    procedure SetSessionName(const Value: string);

    // connect / disconnect
    procedure SetConnected(value: boolean);
    // is database file exists
    function GetExists: boolean;
    // get database manager
    procedure CreateHandle;
    // release database manager
    procedure DestroyHandle;
    // get password
    function GetPassword: Boolean;

    // transactions
    function GetInTransaction: Boolean;
    function GetCurrentVersion: String;

    // last write to DB file was interrupted
    procedure DoOnNeedRepair(var DoRepair: Boolean);
    // DBB need convertation to the new format
    procedure DoOnNeedConvert(var DoRepair: Boolean);

    function InternalCopyDatabase(
                NewDatabaseFileName: String;
                var Log: String;
                IgnoreErrors: Boolean = False;
                  NewPassword: String = '';
                  NewCryptoAlgorithm: TABSCryptoAlgorithm = DefaultCryptoAgorithm;
                  NewPageSize: Integer = DefaultPageSize;
                  NewPageCountInExtent: Integer = DefaultExtentPageCount;
                  NewMaxConnections: Integer = DefaultMaxSessionCount;
                BeforeEvent: TNotifyEvent = nil;
                ProgressEvent: TABSProgressEvent = nil;
                AfterEvent: TNotifyEvent = nil
              ): Boolean;

    procedure EmptyEvent(Sender: TObject);

    procedure InternalBeforeRepair(Sender: TObject);
    procedure InternalOnRepairProgress(Sender: TObject; PercentDone: Integer; var Continue: Boolean);
    procedure InternalAfterRepair(Sender: TObject);

    procedure InternalBeforeCompact(Sender: TObject);
    procedure InternalOnCompactProgress(Sender: TObject; PercentDone: Integer; var Continue: Boolean);
    procedure InternalAfterCompact(Sender: TObject);

    procedure InternalBeforeChangePassword(Sender: TObject);
    procedure InternalOnChangePasswordProgress(Sender: TObject; PercentDone: Integer; var Continue: Boolean);
    procedure InternalAfterChangePassword(Sender: TObject);

    procedure InternalBeforeChangeDatabaseSettings(Sender: TObject);
    procedure InternalOnChangeDatabaseSettingsProgress(Sender: TObject; PercentDone: Integer; var Continue: Boolean);
    procedure InternalAfterChangeDatabaseSettings(Sender: TObject);

  protected
    // loaded
    procedure Loaded; override;
    // sends notification
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  public
    // creates databases with specified directory
    constructor Create(AOwner: TComponent); override;
    // destructor
    destructor Destroy; override;
    // connected := true
    procedure Open;
    // connected := false
    procedure Close;
    // create database
    procedure CreateDatabase;
    // delete database
    procedure DeleteDatabase;
    // rename database
    procedure RenameDatabase(NewDatabaseFileName: String);

    // compact database
    function CompactDatabase(NewDatabaseFileName: String): Boolean; overload;
    // compact database
    function CompactDatabase: Boolean; overload;
    // truncate free pages from database
    procedure TruncateDatabase;

    // repair database
    function RepairDatabase: String; overload;
    // repair database
    function RepairDatabase(NewDatabaseFileName: String; var Log: String): Boolean; overload;
    // Change Database Settings
    function ChangeDatabaseSettings(
                  var Log: String;
                  IgnoreErrors: Boolean;
                  NewPassword: String;
                  NewCryptoAlgorithm: TABSCryptoAlgorithm = DefaultCryptoAgorithm;
                  NewPageSize: Integer = DefaultPageSize;
                  NewPageCountInExtent: Integer = DefaultExtentPageCount;
                  NewMaxConnections: Integer = DefaultMaxSessionCount
                            ): Boolean;
    // change password
    function ChangePassword(NewPassword: String): String; overload;
    // change password and CryptoAggorithm
    function ChangePassword(NewPassword: String; NewCryptoAlgorithm: TABSCryptoAlgorithm): String; overload;
    // makes Exe database from abs file
    procedure MakeExecutableDatabase(const ExeStubFileName, ExeDbFileName: string);
    // return Count of connections to Database File or -1 if it's openned in Exclusive
    function GetDBFileConnectionsCount: Integer;
    // flush all changes that have been written to the database
    procedure FlushBuffers;

    // close all datasets
    procedure CloseDataSets;
    // validates name
    procedure ValidateName(const Name: string);
    // get list of tables in database file
    procedure GetTablesList(List: TStrings);
    // determine if table exists
    function TableExists(TableName: String): Boolean;

    // transactions
    procedure StartTransaction;
    procedure Commit(DoFlushBuffers: Boolean=True);
    procedure Rollback;

    property DataSets[Index: Integer]: TABSDataSet read GetDataSet;
    property DataSetCount: Integer read GetDataSetCount;
    property Exists: Boolean read GetExists;
    property Handle: TABSBaseSession read FHandle write SetHandle;
    property Session: TABSSession read FSession;
    property Temporary: Boolean read FTemporary write FTemporary;
    property InTransaction: Boolean read GetInTransaction;
    property PageSize: Integer read FPageSize write FPageSize;
    property PageCountInExtent: Integer read FPageCountInExtent write FPageCountInExtent;
    property CryptoAlgorithm: TABSCryptoAlgorithm read FCryptoAlgorithm write FCryptoAlgorithm;

  published
    property Connected: boolean read GetConnected write SetConnected default false;
    property CurrentVersion: String read GetCurrentVersion write FCurrentVersion;
    property DatabaseFileName: string read FDatabaseFileName write SetDatabaseFileName;
    property DatabaseName: string read FDatabaseName write SetDatabaseName;
    property Exclusive: Boolean read FExclusive write FExclusive;
    property Password: string read FPassword write FPassword;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
    property HandleShared: Boolean read FHandleShared write FHandleShared default False;
    property KeepConnection: Boolean read FKeepConnection write SetKeepConnection default True;
    property MaxConnections: Integer read FMaxConnections write FMaxConnections;
    property MultiUser: Boolean read FMultiUser write FMultiUser;
    property SessionName: string read FSessionName write SetSessionName;
    property SilentMode: boolean read FSilentMode write FSilentMode default False;
    property DisableTempFiles: boolean read FDisableTempFiles write FDisableTempFiles default False;

    property OnPassword: TABSPasswordEvent read FOnPassword write FOnPassword;
    property BeforeRepair: TNotifyEvent read FBeforeRepair write FBeforeRepair;
    property OnRepairProgress: TABSProgressEvent read FOnRepairProgress write FOnRepairProgress;
    property AfterRepair: TNotifyEvent read FAfterRepair write FAfterRepair;
    property BeforeCompact: TNotifyEvent read FBeforeCompact write FBeforeCompact;
    property OnCompactProgress: TABSProgressEvent read FOnCompactProgress write FOnCompactProgress;
    property AfterCompact: TNotifyEvent read FAfterCompact write FAfterCompact;
    property BeforeChangePassword: TNotifyEvent read FBeforeChangePassword write FBeforeChangePassword;
    property OnChangePasswordProgress: TABSProgressEvent read FOnChangePasswordProgress write FOnChangePasswordProgress;
    property AfterChangePassword: TNotifyEvent read FAfterChangePassword write FAfterChangePassword;
    property OnNeedRepair: TABSOnNeedRepairEvent read FOnNeedRepair write FOnNeedRepair;

    property BeforeChangeDatabaseSettings: TNotifyEvent read FBeforeChangeDatabaseSettings write FBeforeChangeDatabaseSettings;
    property OnChangeDatabaseSettingsProgress: TABSProgressEvent read FOnChangeDatabaseSettingsProgress write FOnChangeDatabaseSettingsProgress;
    property AfterChangeDatabaseSettings: TNotifyEvent read FAfterChangeDatabaseSettings write FAfterChangeDatabaseSettings;

//    property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
 end; // TABSDatabase



////////////////////////////////////////////////////////////////////////////////
//
//  TABSAdvFieldDef
//
////////////////////////////////////////////////////////////////////////////////
   TABSAdvFieldDef = class (TObject)
    private
     FName:                 String;
     FObjectID:             TABSObjectID;
     FDataType:             TABSAdvancedFieldType;
     FRequired:             Boolean;
     FSize:                 Integer;

     FDefaultValue:         TABSVariant;
     FMinValue:             TABSVariant;