absmain.~pas

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

     FMaxValue:             TABSVariant;

     // Autoinc settings
     FAutoincIncrement:     Int64;
     FAutoincInitialValue:  Int64;
     FAutoincMinValue:      Int64;
     FAutoincMaxValue:      Int64;
     FAutoincCycled:        Boolean;

     FBLOBCompressionAlgorithm: TCompressionAlgorithm;
     FBLOBCompressionMode:      Byte;
     FBLOBBlockSize:            Integer;
    public
     procedure Assign(Source: TABSAdvFieldDef);
     constructor Create;
     destructor Destroy; override;
    public
     property Name: String read FName write FName;
     property ObjectID: TABSObjectID read FObjectID write FObjectID;
     property DataType: TABSAdvancedFieldType read FDataType write FDataType;
     property Required: Boolean read FRequired write FRequired;
     property Size: Integer read FSize write FSize;
     property DefaultValue: TABSVariant read FDefaultValue;
     property MinValue: TABSVariant read FMinValue;
     property MaxValue: TABSVariant read FMaxValue;
     property AutoincIncrement: Int64 read FAutoincIncrement write FAutoincIncrement;
     property AutoincInitialValue: Int64 read FAutoincInitialValue write FAutoincInitialValue;
     property AutoincMinValue:   Int64 read FAutoincMinValue write FAutoincMinValue;
     property AutoincMaxValue:  Int64 read FAutoincMaxValue write FAutoincMaxValue;
     property AutoincCycled:    Boolean read FAutoincCycled write FAutoincCycled;
     property BLOBCompressionAlgorithm: TCompressionAlgorithm read FBLOBCompressionAlgorithm write FBLOBCompressionAlgorithm;
     property BLOBCompressionMode: Byte read FBLOBCompressionMode write FBLOBCompressionMode;
     property BLOBBlockSize: Integer read FBLOBBlockSize write FBLOBBlockSize;
   end;


////////////////////////////////////////////////////////////////////////////////
//
//  TABSAdvFieldDefs
//
////////////////////////////////////////////////////////////////////////////////

   TABSAdvFieldDefs = class (TObject)
    private
     FDefsList: TList;
    private
     function GetCount: Integer;
     function GetDef(Index: Integer): TABSAdvFieldDef;
     procedure SetDef(Index: Integer; value: TABSAdvFieldDef);
    public
     procedure Assign(Source: TABSAdvFieldDefs);
     constructor Create;
     destructor Destroy; override;
     function AddFieldDef: TABSAdvFieldDef;
     procedure Add(const Name: String; DataType: TABSAdvancedFieldType;
                   Size: Integer = 0; Required: Boolean = False;
                   BLOBCompressionAlgorithm: TCompressionAlgorithm = caNone;
                   BLOBCompressionMode: Byte = 0);
     procedure DeleteFieldDef(const FieldName: string);
     function Find(const Name: string): TABSAdvFieldDef;
     procedure Clear;
    public
     property Items[Index: Integer]: TABSAdvFieldDef read GetDef write SetDef; default;
     property Count: Integer read GetCount;
   end;


////////////////////////////////////////////////////////////////////////////////
//
//  TABSAdvIndexDef
//
////////////////////////////////////////////////////////////////////////////////
   TABSAdvIndexDef = class (TObject)
    private
      FName:                 String;
      FFields: string;
      FDescFields: string;
      FCaseInsFields: string;
      FOptions: TIndexOptions;
      FMaxIndexedSizes: string;
      FTemporary: Boolean;
    public
      constructor Create;
      procedure Assign(ASource: TABSAdvIndexDef);

    published
      property Name: String read FName write FName;
      property CaseInsFields: string read FCaseInsFields write FCaseInsFields;
      property DescFields: string read FDescFields write FDescFields;
      property Fields: string read FFields write FFields;
      property Options: TIndexOptions read FOptions write FOptions default [];
      property Temporary: Boolean read FTemporary write FTemporary;
      property MaxIndexedSizes: string read FMaxIndexedSizes write FMaxIndexedSizes;
  end;// TABSAdvIndexDef


////////////////////////////////////////////////////////////////////////////////
//
//  TABSAdvIndexDefs
//
////////////////////////////////////////////////////////////////////////////////

   TABSAdvIndexDefs = class (TObject)
    private
     FDefsList: TList;
     FDataset: TDataset;
    private
     function GetCount: Integer;
     function GetDef(Index: Integer): TABSAdvIndexDef;
     procedure SetDef(Index: Integer; value: TABSAdvIndexDef);
    public
     procedure Assign(Source: TABSAdvIndexDefs; SkipTemporaryIndexes: Boolean = False);
     constructor Create(ADataSet: TDataSet);
     destructor Destroy; override;
     function AddIndexDef: TABSAdvIndexDef;
     procedure Add(const Name, Fields: string; Options: TIndexOptions; Temporary: Boolean = false;
                   DescFields: string = '';
                   CaseInsFields: string = '';
                   MaxIndexedSizes: string = '');
     procedure DeleteIndexDef(const IndexName: string);
     function Find(const Name: string): TABSAdvIndexDef;
     procedure Clear;
     procedure Update;
    public
     property Items[Index: Integer]: TABSAdvIndexDef read GetDef write SetDef; default;
     property Count: Integer read GetCount;
   end;// TABSAdvIndexDefs


 // convert TFieldDefs to ABSFieldDefs
 procedure ConvertFieldDefsToABSFieldDefs(
                FieldDefs:      TFieldDefs;
                ABSFieldDefs:   TABSFieldDefs
                                         );

 // convert AdvFieldDefs to ABSFieldDefs
procedure ConvertAdvFieldDefsToABSFieldDefs(
                AdvFieldDefs:      TABSAdvFieldDefs;
                ABSFieldDefs:      TABSFieldDefs;
                IndexDefs:         TABSIndexDefs;
                ABSConstraintDefs: TABSConstraintDefs;
                Temporary:         Boolean
                                            );

 // Add Unic or Primary Key constraint
 function AddConstraintForIndex(
                                  IndexDef:           TABSIndexDef;
                                  ABSConstraintDefs:  TABSConstraintDefs
                                 ): TABSConstraintDef;

 // convert ABSFieldDefs to AdvFieldDefs
 procedure ConvertABSFieldDefsToAdvFieldDefs(
                VisibleFieldDefs:   TABSFieldDefs;
                ABSFieldDefs:   TABSFieldDefs;
                ABSConstraintDefs: TABSConstraintDefs;
                AdvFieldDefs:   TABSAdvFieldDefs
                                        );


 // convert ABSFieldDefs to TFieldDefs
 procedure ConvertABSFieldDefsToFieldDefs(
                ABSFieldDefs:   TABSFieldDefs;
                ABSConstraintDefs: TABSConstraintDefs;
                FieldDefs:      TFieldDefs
                                         );


 // convert AdvFieldDefs to FieldDefs
 procedure ConvertAdvFieldDefsToFieldDefs(AdvFieldDefs: TABSAdvFieldDefs; FieldDefs: TFieldDefs);

 // convert FieldDefs to AdvFieldDefs
 procedure ConvertFieldDefsToAdvFieldDefs(FieldDefs: TFieldDefs; AdvFieldDefs: TABSAdvFieldDefs);


 // get string list from string with names
 procedure GetNamesList(List: TStrings; const Names: string);

 // fill ABSIndexDef
 procedure FillABSIndexDef(
              ABSIndexDef:         TABSIndexDef;
              const Name,
              Fields: String;
              Options: TIndexOptions;
              Temporary: Boolean;
              const DescFields: String;
              const CaseInsFields: String;
              const MaxIndexedSizes: String;
              FieldDefs:           TFieldDefs
                           );

 // convert TIndexDef to TABSIndexDef
 procedure ConvertAdvIndexDefToABSIndexDef(
                AdvIndexDef:      TABSAdvIndexDef;
                ABSIndexDef:   TABSIndexDef;
                FieldDefs:     TFieldDefs
                                         );

 // convert AdvIndexDefs to TIndexDefs
 procedure ConvertAdvIndexDefsToIndexDefs(
                AdvIndexDefs:   TABSAdvIndexDefs;
                IndexDefs:      TIndexDefs
                                         );
 // convert TIndexDefs to TABSAdvIndexDefs
 procedure ConvertIndexDefsToAdvIndexDefs(
                IndexDefs:      TIndexDefs;
                AdvIndexDefs:   TABSAdvIndexDefs
                                         );
 // convert TAdvIndexDefs to TABSIndexDefs
 procedure ConvertAdvIndexDefsToABSIndexDefs(
                AdvIndexDefs:   TABSAdvIndexDefs;
                ABSIndexDefs:   TABSIndexDefs;
                FieldDefs:      TFieldDefs
                                         );

 // convert ABSIndexDef to AdvIndexDef
 procedure ConvertABSIndexDefToAdvIndexDef(
                ABSIndexDef:   TABSIndexDef; AdvIndexDef:   TABSAdvIndexDef);
 // convert ABSIndexDefs to TIndexDefs
 procedure ConvertABSIndexDefsToAdvIndexDefs(
                ABSIndexDefs:   TABSIndexDefs; AdvIndexDefs:   TABSAdvIndexDefs);

 // return true if field exists
 function FindFieldInFieldDefs(FieldDefs: TFieldDefs; FieldName : string): Boolean;

 // compression algorithm
function ConvertCompressionAlgorithmToABSCompressionAlgorithm(
            CompressionAlgorithm: TCompressionAlgorithm
          ): TABSCompressionAlgorithm;
 // compression algorithm
function ConvertABSCompressionAlgorithmToCompressionAlgorithm(
            CompressionAlgorithm: TABSCompressionAlgorithm
          ): TCompressionAlgorithm;

// copy records and return error log
//function CopyDatasets(SourceDataset: TDataset; DestinationDataset: TDataset): String;

procedure DbiError(ErrorCode: Integer; ErrorMessage: String = '');
procedure Check(Status: Integer; ErrorMessage: String = '');

var
  Sessions:              TABSSessionList;
  Session:               TABSSession;




implementation

uses
     {$IFDEF MEMORY_ENGINE}
     ABSMemEngine,
     {$ENDIF}
     {$IFDEF TEMPORARY_ENGINE}
     ABSTempEngine,
     {$ENDIF}
     {$IFDEF DISK_ENGINE}
     ABSDiskEngine,
     {$IFNDEF NO_DIALOGS}
     ABSPasswordDialog,
     {$ENDIF}
     ABSExpressions,
     {$ENDIF}
{$IFDEF D6H}
     DateUtils,
{$ENDIF}
     ABSDecUtil,
     ABSBaseEngine;
var
  FCSect:                TRTLCriticalSection;
  CurrentSessionManager: TABSSessionComponentManager;
  Initialized:           Boolean;
  WideStringsStack:      TList;

type

////////////////////////////////////////////////////////////////////////////////
//
//  TABSQueryDataLink
//
////////////////////////////////////////////////////////////////////////////////

  TABSQueryDataLink = class(TDetailDataLink)
  private
    FQuery: TABSQuery;
  protected
    procedure ActiveChanged; override;
    procedure RecordChanged(Field: TField); override;
    function GetDetailDataSet: TDataSet; override;
    procedure CheckBrowseMode; override;
  public
    constructor Create(AQuery: TABSQuery);
  end;


////////////////////////////////////////////////////////////////////////////////
//
//  TABSQueryDataLink
//
////////////////////////////////////////////////////////////////////////////////

//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TABSQueryDataLink.Create(AQuery: TABSQuery);
begin
  inherited Create;
  FQuery := AQuery;
end;// Create


//------------------------------------------------------------------------------
// ActiveChanged
//------------------------------------------------------------------------------
procedure TABSQueryDataLink.ActiveChanged;
begin
  if FQuery.Active then
    FQuery.RefreshParams;
end;// ActiveChanged


//------------------------------------------------------------------------------
// GetDetailDataSet
//------------------------------------------------------------------------------
function TABSQueryDataLink.GetDetailDataSet: TDataSet;
begin
  Result := FQuery;
end;// GetDetailDat