absmain.~pas

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

   FBlobSettings:         Boolean;
   FData:                 Boolean;
   FFieldNamesInInserts:  Boolean;
  public
   constructor Create;
   procedure Assign(Source: TPersistent); override;
  published
   property Structure: Boolean read FStructure write FStructure default True;
   property AddDropTable: Boolean read FAddDropTable write FAddDropTable default True;
   property BlobSettings: Boolean read FBlobSettings write FBlobSettings default False;
   property Data: Boolean read FData write FData default False;
   property FieldNamesInInserts: Boolean read FFieldNamesInInserts write FFieldNamesInInserts default False;
 end;


////////////////////////////////////////////////////////////////////////////////
//
// TABSTable
//
////////////////////////////////////////////////////////////////////////////////


 TABSTable = class (TABSDataset)
  private
   FTableName:    String;
   FExclusive:    Boolean;
   FTemporary:    Boolean;
   FIndexName:    String;
   FFieldsIndex:  Boolean;
   FMasterLink:   TMasterDataLink;
   FDisableTempFiles: Boolean;
   {$IFNDEF NO_DIALOGS}
   frmWait:       TfrmWait;
   {$ENDIF}
   FIsRepairing:  Boolean;

   FBeforeCopy:           TABSDatasetNotifyEvent;
   FOnCopyProgress:         TABSProgressEvent;
   FAfterCopy:            TABSDatasetNotifyEvent;

   FBeforeImport:           TABSDatasetNotifyEvent;
   FOnImportProgress:         TABSProgressEvent;
   FAfterImport:            TABSDatasetNotifyEvent;

   FBeforeExport:           TABSDatasetNotifyEvent;
   FOnExportProgress:         TABSProgressEvent;
   FAfterExport:            TABSDatasetNotifyEvent;

   FBeforeRestructure:    TABSDatasetNotifyEvent;
   FOnRestructureProgress:  TABSProgressEvent;
   FAfterRestructure:     TABSDatasetNotifyEvent;

   FBeforeBatchMove:        TABSDatasetNotifyEvent;
   FOnBatchMoveProgress:    TABSProgressEvent;
   FAfterBatchMove:         TABSDatasetNotifyEvent;

   FExportToSqlOptions:     TABSExportToSqlOptions;

   procedure CheckBlankTableName;
   procedure AutoCorrectAdvFieldDefs;
   procedure AutoCorrectFieldDefs;
   procedure CheckAdvFieldDefs;
   procedure AutoCorrectAdvIndexDefs;
   procedure SetTemporary(const Value: Boolean);
   function GetIndexFieldNames: string;
   function GetIndexName: string;
   procedure GetIndexParams(IndexName: string; FieldsIndex: Boolean;
         var IndexedName: string);
   function IndexDefsStored: Boolean;
   procedure SetIndex(const Value: string; FieldsIndex: Boolean);
   procedure SetIndexFieldNames(const Value: string);
   procedure SetIndexName(const Value: string);
   procedure SetTableName(const Value: string);
    // return index name
  public
   function FindOrCreateIndex(FieldNamesList, AscDescList, CaseSensitivityList: TStringList; var IsCreated: Boolean): String;
   function IndexExists(FieldNamesList, AscDescList, CaseSensitivityList: TStringList): Boolean;
   // set distinct
   procedure ApplyDistinct(FieldNamesList, AscDescList, CaseSensitivityList: TStringList); overload;
   procedure ApplyDistinct(ds: TABSDataset); overload;
  private

   function GetTableExists: Boolean;
   //---------------------------- master-detail --------------------------------
   procedure CheckMasterRange;
   procedure UpdateRange;
   procedure MasterChanged(Sender: TObject);
   procedure MasterDisabled(Sender: TObject);
   procedure SetDataSource(Value: TDataSource);
   function GetMasterFields: string;
   procedure SetMasterFields(const Value: string);

  protected
{$IFDEF D6H}
    // IProviderSupport
    function PSGetDefaultOrder: TIndexDef; override;
    function PSGetKeyFields: string; override;
    function PSGetTableName: string; override;
    function PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs; override;
    procedure PSSetCommandText(const CommandText: string); override;
    procedure PSSetParams(AParams: TParams); override;
{$ENDIF}
   procedure PrepareCursor; override;
   function CreateHandle: TABSCursor; override;
   procedure DataEvent(Event: TDataEvent; Info: Longint); override;
   procedure DefChanged(Sender: TObject); override;
   procedure InitFieldDefs; override;
   procedure DestroyHandle; override;
   function GetHandle: TABSCursor;
   procedure UpdateIndexDefs; override;
   function GetIndexField(Index: Integer): TField;
   procedure SetIndexField(Index: Integer; Value: TField);

   //---------------------------- master-detail --------------------------------
   procedure SetLinkRanges(MasterFields: TList);
   function GetDataSource: TDataSource; override;
   procedure DoOnNewRecord; override;
   function GetIndexFieldCount: Integer;
   procedure SetDefaultBlobFieldsValues;

  protected
   property MasterLink: TMasterDataLink read FMasterLink;
  public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   procedure CreateTable;
   procedure DeleteTable;
   procedure EmptyTable;
   procedure RenameTable(NewTableName: String);
   function ImportTable(
                          SourceTable: TDataset;
                          var Log:     String;
                          aIndexDefs:   TIndexDefs = nil
                        ): Boolean; overload;
   function ImportTable(SourceTable: TDataset): Boolean; overload;
   function ExportTable(
                          DestinationTable:   TDataset;
                          CreateTablePointer: TProcedure;
                          var Log:            String
                       ): Boolean; overload;
   function ExportTable(
                          DestinationTable:   TDataset;
                          CreateTablePointer: TProcedure
                       ): Boolean; overload;

   function CopyTable(NewTableName: string;
                      var Log: String;
                      var Continue: Boolean;
                      DestDatabaseFileName: string ='';
                      DestDatabasePassword: string ='';
                      IgnoreErrors: Boolean = False;
                      OverwriteExistingTable: Boolean = False;
                      CopyIndexes: Boolean = True;
                      MinProgress: Integer = 0;
                      MaxProgress: Integer = 100
                       ): Boolean; overload;

   procedure CopyTable(NewTableName: string; DestDatabaseFileName: string='';
                       DestDatabasePassword: string=''); overload;

   procedure BatchMove(SourceTableOrQuery: TABSDataSet;
                       MoveType: TABSBatchMoveType;
                       DstTableIndexNameToIdentifyEqualRecords: String = '');

   function RestructureTable(var Log: String): Boolean; overload;
   function RestructureTable: Boolean; overload;

   function ExportToSQL: String; overload;
   procedure ExportToSQL(Stream: TStream); overload;
   procedure ExportToSQL(FileName: String); overload;

   // Rename Field by Name
   procedure RenameField(FieldName, NewFieldName: String); overload;

   procedure AddIndex(
              const Name,
              Fields: String;
              Options: TIndexOptions;
              const DescFields: String = '';
              const CaseInsFields: String = ''
                     );
   procedure DeleteIndex(const Name: string);
   procedure DeleteAllIndexes;

 protected
   // repair method
   procedure ValidateAndRepairMostUpdatedAndRecordPageIndex;

   //---------------------------------------------------------------------------
   // key and range methods
   //---------------------------------------------------------------------------
  protected
    procedure CheckSetKeyMode;
    function GetKeyBuffer(KeyIndex: TABSKeyIndex): TABSRecordBuffer;
    function GetKeyExclusive: Boolean;
    function GetKeyFieldCount: Integer;
    procedure SetKeyExclusive(Value: Boolean);
    procedure SetKeyFieldCount(Value: Integer);
    procedure SetKeyBuffer(KeyIndex: TABSKeyIndex; Clear: Boolean);
    procedure SetKeyFields(KeyIndex: TABSKeyIndex; const Values: array of const);
    procedure PostKeyBuffer(Commit: Boolean);
  public
   function FindKey(const KeyValues: array of const): Boolean;
   procedure FindNearest(const KeyValues: array of const);
   function GotoKey: Boolean;
   procedure GotoNearest;
   procedure EditKey;
   procedure SetKey;

   function SetCursorRange: Boolean;
   procedure ApplyRange;
   procedure CancelRange;
   procedure EditRangeStart;
   procedure EditRangeEnd;
   procedure SetRange(const StartValues, EndValues: array of const);
   procedure SetRangeStart;
   procedure SetRangeEnd;

   procedure Post; override;
   procedure Cancel; override;

   // return LastAutoincValue for Field (FieldIndex started by 0)
   function LastAutoincValue(FieldIndex: Integer): Int64; overload;
   // return LastAutoincValue for Field
   function LastAutoincValue(FieldName: String): Int64; overload;


   procedure InternalBeforeCopy(Sender: TObject);
   procedure InternalOnCopyProgress(Sender: TObject; PercentDone: Integer; var Continue: Boolean);
   procedure InternalAfterCopy(Sender: TObject);

   procedure InternalBeforeImport(Sender: TObject);
   procedure InternalOnImportProgress(Sender: TObject; PercentDone: Integer; var Continue: Boolean);
   procedure InternalAfterImport(Sender: TObject);

   procedure InternalBeforeExport(Sender: TObject);
   procedure InternalOnExportProgress(Sender: TObject; PercentDone: Integer; var Continue: Boolean);
   procedure InternalAfterExport(Sender: TObject);

   procedure InternalBeforeRestructure(Sender: TObject);
   procedure InternalOnRestructureProgress(Sender: TObject; PercentDone: Integer; var Continue: Boolean);
   procedure InternalAfterRestructure(Sender: TObject);

   procedure InternalBeforeBatchMove(Sender: TObject);
   procedure InternalOnBatchMoveProgress(Sender: TObject; PercentDone: Integer; var Continue: Boolean);
   procedure InternalAfterBatchMove(Sender: TObject);

  public
   property IndexFieldCount: Integer read GetIndexFieldCount;
   property IndexFields[Index: Integer]: TField read GetIndexField write SetIndexField;
   property KeyExclusive: Boolean read GetKeyExclusive write SetKeyExclusive;
   property KeyFieldCount: Integer read GetKeyFieldCount write SetKeyFieldCount;
   property Temporary: Boolean Read FTemporary Write SetTemporary;
   // index definitions, used by RestructureTable;
   property RestructureIndexDefs: TABSAdvIndexDefs read FRestructureIndexDefs;
   // field definitions, used by RestructureTable;
   property RestructureFieldDefs: TABSAdvFieldDefs read FRestructureFieldDefs;
   property DisableTempFiles: Boolean Read FDisableTempFiles Write FDisableTempFiles;

  published
   // fielddefs support
   property StoreDefs;
   // index definitions
   property IndexDefs: TIndexDefs read FIndexDefs write SetIndexDefs
              stored IndexDefsStored;
   property IndexFieldNames: String read GetIndexFieldNames write SetIndexFieldNames;
   property IndexName: String read GetIndexName write SetIndexName;
   // field definitions
   property FieldDefs stored FieldDefsStored;
   property TableName: string Read FTableName Write SetTableName;
   property Exclusive: Boolean read FExclusive write FExclusive;
   property Exists: Boolean read GetTableExists;
   property MasterFields: string read GetMasterFields write SetMasterFields;
   property MasterSource: TDataSource read GetDataSource write SetDataSource;

   property ExportToSqlOptions: TABSExportToSqlOptions read FExportToSqlOptions write FExportToSqlOptions;

   property BeforeCopy: TABSDatasetNotifyEvent read FBeforeCopy write FBeforeCopy;
   property OnCopyProgress: TABSProgressEvent read FOnCopyProgress write FOnCopyProgress;
   property AfterCopy: TABSDatasetNotifyEvent read FAfterCopy write FAfterCopy;

   property BeforeImport: TABSDatasetNotifyEvent read FBeforeImport write FBeforeImport;
   property OnImportProgress: TABSProgressEvent read FOnImportProgress write FOnImportProgress;
   property AfterImport: TABSDatasetNotifyEvent read FAfterImport write FAfterImport;

   property BeforeExport: TABSDatasetNotifyEvent read FBeforeExport write FBeforeExport;
   property OnExportProgress: TABSProgressEvent read FOnExportProgress write FOnExportProgress;
   property AfterExport: TABSDatasetNotifyEvent read FAfterExport write FAfterExport;

   property BeforeRestructure: TABSDatasetNotifyEvent read FBeforeRestructure write FBeforeRestructure;
   property OnRestructureProgress: TABSProgressEvent read FOnRestructureProgress write FOnRestructureProgress;
   property AfterRestructure: TABSDatasetNotifyEvent read FAfterRestructure write FAfterRestructure;

   property BeforeBatchMove: TABSDatasetNotifyEvent read FBeforeBatchMove write FBeforeBatchMove;
   property OnBatchMoveProgress: TABSProgressEvent read FOnBatchMoveProgress write FOnBatchMoveProgress;
   property AfterBatchMove: TABSDatasetNotifyEvent read FAfterBatchMove write FAfterBatchMove;

 end; // TABSTable


////////////////////////////////////////////////////////////////////////////////
//
// TABSQuery
//
////////////////////////////////////////////////////////////////////////////////


 TABSQuery = class (TABSDataset)
  private
    FStmtHandle:        TABSSQLProcessor;
    FSQL:               TStrings;
    FPrepared:          Boolean;
    FParams:            TParams;
    FText:              String;
    FDataLink:          TDataLink;
    FRowsAffected:      Integer;
    FRequestLive:       Boolean;
    FSQLBinary:         PChar;
    FParamCheck:        Boolean;
    FExecSQL:           Boolean;
    FCheckRowsAffected: Boolean;
   protected
{$IFDEF D6H}
    // IProviderSupport
    procedure PSExecute; override;
    function PSGetDefaultOrder: TIndexDef; override;
    function PSGetParams: TParams; override;
    function PSGetTableName: string; override;