absmain.pas

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

 TABSDataset = class (TDataset)
  private
   FCurrentVersion:                 String;
   FHandle:                         TABSCursor;
   FSessionName:                    String;
   FFilterBuffer:                   TABSRecordBuffer; // filter record buffer
   FIndexFieldCount:                Integer;
   FIndexFieldMap:                  array of Word;
   FKeySize:                        Integer;
   FDBFlags:                        TABSDBFlags;
   FDatabase:                       TABSDatabase;
   FDatabaseName:                   String;
   FInMemory:                       Boolean;
   FReadOnly:                       Boolean;
   FStoreDefs:                      Boolean;  // for FFieldDefs
   FEditRecordBuffer:               TABSRecordBuffer; // for storing record on edit
   FABSConstraintDefs:              TABSConstraintDefs;  // Constraint definitions
   FExternalHandle:                 TABSCursor;
{$IFDEF D6H}
   FOnUpdateRecord: TUpdateRecordEvent;
{$ENDIF}
  protected
   FIndexDefs:                      TIndexDefs; // index definitions
   FABSFieldDefs:                   TABSFieldDefs; // fields definitions
   FABSIndexDefs:                   TABSIndexDefs; // indexes definitions
   FAdvIndexDefs:                   TABSAdvIndexDefs; // index definitions
   FAdvFieldDefs:                   TABSAdvFieldDefs; // USER fields definitions
   FRestructureIndexDefs:           TABSAdvIndexDefs; // restructure index definitions
   FRestructureFieldDefs:           TABSAdvFieldDefs; // restructure field definitions
   FKeyBuffers:                     array[TABSKeyIndex] of TABSRecordBuffer;
   FKeyBuffer:                      TABSRecordBuffer;
   FIsRefreshing:                   Boolean;
   FIgnoreDesignMode:               Boolean; // 5.05
{$IFDEF D6H}
   // IProviderSupport
   function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
   function PSIsSQLSupported: Boolean; override;
   procedure PSReset; override;
   function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
   procedure PSStartTransaction; override;
   procedure PSEndTransaction(Commit: Boolean); override;
   function PSExecuteStatement(const ASQL: string; AParams: TParams; ResultSet: Pointer = nil): Integer; override;
   procedure PSGetAttributes(List: TList); override;
   function PSGetQuoteChar: string; override;
   function PSInTransaction: Boolean; override;
   function PSIsSQLBased: Boolean; override;
{$ENDIF}
   function InitKeyBuffer(Buffer: TABSRecordBuffer): TABSRecordBuffer;
   procedure AllocKeyBuffers;
   procedure FreeKeyBuffers;
   // field defs support
   function FieldDefsStored: Boolean;
   // index defs support
   function IndexDefsStored: Boolean;
   // set index definitions
   procedure SetIndexDefs(Value: TIndexDefs);
   // get active buffer
   function GetActiveRecordBuffer: PChar;
   procedure CheckDBSessionName;
   function GetDBHandle: TABSBaseSession;
   function GetDBSession: TABSSession;
   procedure CheckInMemoryDatabaseName;
   procedure SetDatabaseName(const Value: string);
   procedure SetSessionName(const Value: string);
   procedure SetInMemory(const Value: Boolean);
   function GetCurrentVersion: String;
   property IgnoreDesignMode: Boolean read FIgnoreDesignMode write FIgnoreDesignMode;
  protected
   procedure OpenCursor(InfoQuery: Boolean); override;
   procedure CloseCursor; override;
   procedure Disconnect; virtual;
   procedure SetDBFlag(Flag: Integer; Value: Boolean); virtual;
   function CreateHandle: TABSCursor; virtual;
   procedure DestroyHandle; virtual;
   function GetCanModify: Boolean; override;

   procedure DateTimeConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean);
   procedure DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean);
{$IFDEF D5H}
    override;
{$ENDIF}
   procedure SetActive(Value: Boolean); override;

   //---------------------------------------------------------------------------
   // indexes and ranges
   //---------------------------------------------------------------------------

   procedure SwitchToIndex(const IndexName: string);
   function GetIsIndexField(Field: TField): Boolean; override;
   procedure GetIndexInfo;
   function ResetCursorRange: Boolean;

   //---------------------------------------------------------------------------
   // navigation & bookmark methods
   //---------------------------------------------------------------------------

   // clear calculated fields
   procedure ClearCalcFields(Buffer: PChar); override;
   procedure InternalRefresh; override;
   function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  public
   function GetCurrentRecord(Buffer: PChar): Boolean; override;
  protected
   // return record count
   function GetRecordCount: Integer; override;
   // go to record
   procedure SetRecNo(Value: Integer); override;
   // return current record number
   function GetRecNo: Integer; override;
   // go to first record
   procedure InternalFirst; override;
   // go to last record
   procedure InternalLast; override;
   // go to record in buffer
   procedure InternalSetToRecord(Buffer: PChar); override;
   // get bookmark flag
   function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
   // get bookmark data
   procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
   // go to bookmark
   procedure InternalGotoBookmark(Bookmark: Pointer); override;
   // set flag
   procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
   // set data
   procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  public
   // compare bookmarks
   function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
   // checks if bookmark is valid
   function BookmarkValid(Bookmark: TBookmark): Boolean; override;
  protected

   //---------------------------------------------------------------------------
   // Filters and search
   //---------------------------------------------------------------------------

   // for OnFilterRecord Event
   function IsOnFilterRecordApplied: Boolean;
  public
   function InternalFilterRecord(Buffer: TABSRecordBuffer): Boolean;
   function FilterRecord(Buffer: TABSRecordBuffer; Dataset: Pointer): Boolean;
  protected
   procedure SetOnFilterRecord(const Value: TFilterRecordEvent); override;
   function IsIndexApplied: Boolean;
   procedure PrepareCursor; virtual;
  public
   // set SQL Filter
   procedure SetSQLFilter(FilterExpr: TObject; ParentQueryAO: TObject; ParentCursor: TABSCursor);
   // apply projection
   procedure ApplyProjection(FieldNamesList, AliasList: TStringList);
   // FindFirst, FindNext, Filters
   procedure ActivateFilters;
   procedure DeactivateFilters;
   procedure SetFilterData(const Text: string; Options: TFilterOptions);
   procedure SetFiltered(Value: Boolean); override;
   procedure SetFilterOptions(Value: TFilterOptions); override;
   procedure SetFilterText(const Value: string); override;
   function FindRecord(Restart, GoForward: Boolean): Boolean; override;
   function LocateRecord(
                         const KeyFields: String;
                         const KeyValues: Variant;
                         Options:         TLocateOptions
                        ): Boolean;
  public
   function Locate(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions): Boolean; override;
   function Lookup(const KeyFields: string; const KeyValues: Variant;
      const ResultFields: string): Variant; override;

   //---------------------------------------------------------------------------
   // insert, edit, post, delete methods
   //---------------------------------------------------------------------------
  protected
   procedure InitRecord(Buffer: PChar); override;
   // appending table (Append flag - ignored, record will be inserted at first empty position)
   procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
   // insert record
   procedure InternalInsert; override;
   // edit record
   procedure InternalEdit; override;
   // cancels updates
   procedure InternalCancel; override;
   // update record
   procedure InternalPost; override;
   // delete record
   procedure InternalDelete; override;

   //---------------------------------------------------------------------------
   // open, close methods
   //---------------------------------------------------------------------------

   procedure InternalHandleException; override;
   function IsCursorOpen: Boolean; override;
   procedure InternalOpen; override;
   procedure InternalClose; override;
   procedure InternalInitFieldDefs; override;


   //---------------------------------------------------------------------------
   // general methods
   //---------------------------------------------------------------------------

   // copy records and return error log
   function CopyRecords(DestinationDataset: TDataset): String;
   function InternalCopyRecords(SourceDataset: TDataset;
                                DestinationDataset: TDataset;
                                var Log: String;
                                var Continue: Boolean;
                                IgnoreErrors: Boolean = True;
                                RestructuringTable: Boolean = False;
                                ProgressEvent: TABSProgressEvent = nil;
                                MinProgress: Integer = 0;
                                MaxProgress: Integer = 100
                               ): Boolean;

   // allocate record buffer
   function AllocRecordBuffer: PChar; override;
   // free record buffer
   procedure FreeRecordBuffer(var Buffer: PChar); override;
   // initialize record buffer
   procedure InternalInitRecord(Buffer: PChar); override;
   // return record size in bytes
   function GetRecordSize: Word; override;
   // return true if range is applied
   function IsRangeApplied: Boolean;
  public 
   // return true if distinct is applied
   function IsDistinctApplied: Boolean;

  protected
   property DBFlags: TABSDBFlags read FDBFlags;
  public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   function OpenDatabase: TABSDatabase;
   procedure CloseDatabase(Database: TABSDatabase);
   // read field data to current record buffer
   function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  protected
   // write field data from buffer to current record buffer
   procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  public
   procedure GetFieldValue(Value: TABSVariant; FieldNo: Integer; DirectAccess: Boolean);
   procedure SetFieldValue(Value: TABSVariant; FieldNo: Integer; DirectAccess: Boolean);
   procedure CopyFieldValue(SrcFieldNo: Integer; UseDirectFieldAccess: Boolean;
                            DestFieldNo: Integer; DestDataset: TABSDataset);
   // create blob stream
  private
   function InternalCreateBlobStream(
    					Field: TField;
              Mode: TBlobStreamMode
              ): TABSStream;
  public
   // create TABSBlobStream
   function CreateBlobStream(
    					Field: TField;
              Mode: TBlobStreamMode
              ): TStream; override;
    // close blob stream, write blob field value to blob data file
    procedure CloseBlob(Field: TField); override;

    // Get list of names of all database components
    procedure GetDatabaseNameList(List: TStrings);
  public
   property Handle: TABSCursor read FHandle;
   property Database: TABSDatabase read FDatabase;
//   property DBHandle: TABSBaseSession read GetDBHandle;
   property DBSession: TABSSession read GetDBSession;
   // index definitions, used by CreateTable;
   property IndexDefs: TIndexDefs read FIndexDefs write SetIndexDefs stored IndexDefsStored;
   // field definitions, used by CreateTable;
   property FieldDefs stored FieldDefsStored;
   // index definitions, used by CreateTable;
   property AdvIndexDefs: TABSAdvIndexDefs read FAdvIndexDefs;
   // field definitions, used by CreateTable;
   property AdvFieldDefs: TABSAdvFieldDefs read FAdvFieldDefs;
   property KeySize: Integer read FKeySize;
   property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
  published
   property CurrentVersion: String read GetCurrentVersion write FCurrentVersion;
   // fielddefs support
   property DatabaseName: String read FDatabaseName write SetDatabaseName;
   property SessionName: String read FSessionName write SetSessionName;
   property InMemory: Boolean read FInMemory write SetInMemory;
   property ReadOnly: Boolean read FReadOnly write FReadOnly;

   property Active;
   property AutoCalcFields;
   property Filter;
   property Filtered;
   property FilterOptions;
   property BeforeOpen;
   property AfterOpen;
   property BeforeClose;
   property AfterClose;
   property BeforeInsert;
   property AfterInsert;
   property BeforeEdit;
   property AfterEdit;
   property BeforePost;
   property AfterPost;
   property BeforeCancel;
   property AfterCancel;
   property BeforeDelete;
   property AfterDelete;
   property BeforeScroll;
   property AfterScroll;
{$IFDEF D5H}
   property BeforeRefresh;
   property AfterRefresh;
{$ENDIF}
   property OnCalcFields;
   property OnDeleteError;
   property OnEditError;
   property OnFilterRecord;
   property OnNewRecord;
   property OnPostError;
{$IFDEF D6H}
   property OnUpdateRecord: TUpdateRecordEvent read FOnUpdateRecord write FOnUpdateRecord;
{$ENDIF}
 end; // TABSDataset



 TABSExportToSqlOptions = class(TPersistent)
  private
   FStructure:            Boolean;
   FAddDropTable:         Boolean;