////////////////////////////////////////////////////////////////////////////////
//                                                                            //
// Copyright (c) 2022 Alexey Kuryakin kouriakine@mail.ru under MIT license.   //
//                                                                            //
// Purpose:                                                                   //
//  DataBase API routines for DaqPascal.                                      //
//                                                                            //
// History:                                                                   //
//  20221105 - 1st release                                                    //
//  20221119 - EngineId,EngineName in db_ctrl                                 //
//  20221120 - db_subst_connectionstring; ConnectionStringInit                //
//  20221121 - TimeStampInit,..,TimeStampUser1/2/3,UserData,Cookies           //
//  20221211 - Recordset Source                                               //
//  20221214 - ConnectionStringInit,UserState,UserFlags,UserLink              //
//  20221216 - Driver property                                                //
////////////////////////////////////////////////////////////////////////////////
// Use command to generate ADODB_TLB.PAS:                                     //
// TLIBIMP -P+ -O+ -Q- -H- -L- "%CommonProgramFiles%\System\ado\msado28.tlb"  //
////////////////////////////////////////////////////////////////////////////////

unit _dbapi; // DataBase API

{$I _sysdef}

interface

uses // NB: AdoInt.pas replaced with ADODB_TLB.PAS generated by TLIBIMP.
 SysUtils,Windows,Classes,Math,ComObj,OleDb,ADODB_TLB,
 _alloc,_str,_rtc,_fio,_hl,_bsencode,_dbcon;

const //////////////////// DB entity type identifiers
 db_type_nil             = 0;  // Nil pointer, entity is not exist
 db_type_connection      = 1;  // TDbConnection
 db_type_recordset       = 2;  // TDbRecordset
 db_type_command         = 3;  // TDbCommand
 db_type_parent          = 4;  // TDbParent, abstract
 db_type_entity          = 5;  // TDbEntity, abstract
 db_type_any             = db_type_entity;

const //////////////////// DB Engine identifiers
 db_engine_def           = 0;  // Use default engine number
 db_engine_ado           = 1;  // ADO = ActiveX Data Objects
 db_engine_default       : Integer = db_engine_ado;
 db_engine_list_csv      = 'ADO'; // Comma separated list of engines

const //////////////////// Well known OLEDB/ADO providers
 db_provider_msdasql     = 'MSDASQL';                // System default
 db_provider_ibpfree     = 'LCPI.IBProvider.5.Free'; // IBProvider Free

const //////////////////// Prefix uses for BugReport
 db_bugreport_prefix_def = '@!ESoftException: '; // Default detail echo
 db_bugreport_prefix_ech = '@!EEchoException: '; // Short echo
 db_bugreport_prefix_hid = '@!EHideException: '; // Hidden
 db_bugreport_prefix     : String = db_bugreport_prefix_def;

const //////////////////// Use BindRoot automatically
 db_bindroot_oncreate    : Boolean = true;
 db_bindroot_onexecute   : Boolean = true;

////////////////////////////////////////////////////////////////////////////////
// Database API objects.
////////////////////////////////////////////////////////////////////////////////

type
 TDbEntity = class;     // abstract "any DB object"
 TDbParent = class;     // abstract object with childs
 TDbConnection = class; // ADODB.Connection wrapper
 TDbRecordset = class;  // ADODB.Recordset wrapper
 TDbCommand = class;    // ADODB.Command wrapper
 TDbEntity = class(TMasterObject)
 private
  myTypeId   : Integer;
  myParent   : TDbParent;
  myBgPref   : String;
 private
  function  GetTypeId:Integer;
  function  GetParent:TDbParent;
 private
  procedure FreeAllChilds;
  function  GetChildCount:Integer;
  function  DoGetChildCount:Integer; virtual;
  function  GetChildItems(i:Integer):TDbEntity;
  function  DoGetChildItems(i:Integer):TDbEntity; virtual;
 private
  function  GetState:Integer;
  function  DoGetState:Integer; virtual;
 private
  function  DoClose:Boolean; virtual;
  function  DoCancel:Boolean; virtual;
  function  DoBindRoot:Boolean; virtual;
 private
  function  GetProperties:String;
  function  DoGetProperties:String; virtual;
  procedure SetProperties(const arg:String);
  procedure DoSetProperties(const arg:String); virtual;
 private
  function  GetMode:Integer;
  function  DoGetMode:Integer; virtual;
  procedure SetMode(arg:Integer);
  procedure DoSetMode(arg:Integer); virtual;
 private
  function  GetCursorLocation:Integer;
  function  DoGetCursorLocation:Integer; virtual;
  procedure SetCursorLocation(arg:Integer);
  procedure DoSetCursorLocation(arg:Integer); virtual;
 private
  function  GetAttributes:Integer;
  function  DoGetAttributes:Integer; virtual;
  procedure SetAttributes(arg:Integer);
  procedure DoSetAttributes(arg:Integer); virtual;
 private  // TDbRecordset related
  function  GetAbsolutePage:Integer;
  procedure SetAbsolutePage(arg:Integer);
  function  GetAbsolutePosition:Integer;
  procedure SetAbsolutePosition(arg:Integer);
  function  GetBof:Boolean;
  function  GetEof:Boolean;
  function  GetBookmark:Integer;
  procedure SetBookmark(arg:Integer);
  function  GetCacheSize:Integer;
  procedure SetCacheSize(arg:Integer);
  function  GetCursorType:Integer;
  procedure SetCursorType(arg:Integer);
  function  GetEditMode:Integer;
  function  GetFilter:String;
  procedure SetFilter(arg:String);
  function  GetIndex:String;
  procedure SetIndex(arg:String);
  function  GetLockType:Integer;
  procedure SetLockType(arg:Integer);
  function  GetMarshalOptions:Integer;
  procedure SetMarshalOptions(arg:Integer);
  function  GetMaxRecords:Integer;
  procedure SetMaxRecords(arg:Integer);
  function  GetPageCount:Integer;
  function  GetPageSize:Integer;
  procedure SetPageSize(arg:Integer);
  function  GetRecordCount:Integer;
  function  GetSort:String;
  procedure SetSort(arg:String);
  function  GetSource:String;
  procedure SetSource(arg:String);
  function  GetStatus:Integer;
  function  GetStayInSync:Boolean;
  procedure SetStayInSync(arg:Boolean);
 private  // TDbCommand related
  function  GetCommandType:Integer;
  procedure SetCommandType(arg:Integer);
  function  GetCommandText:String;
  procedure SetCommandText(arg:String);
 private
  function  DoOpen(opt:Integer):Boolean; virtual;
  function  DoExecute(const arg:String; opt:Integer):TDbRecordset; virtual;
 protected
  procedure BugReport(E:Exception; O:TObject; const S:String);
 public
  constructor Create(aParent:TDbParent);
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
  function    BindRoot:Boolean;
 public   // Basic properties
  property  TypeId           : Integer            read GetTypeId;
  property  Parent           : TDbParent          read GetParent;
 public   // Parent related properties
  property  ChildCount       : Integer            read GetChildCount;
  property  ChildItems[i:Integer] : TDbEntity     read GetChildItems;
 public   // Common properties
  property  State            : Integer            read GetState;
  property  Properties       : String             read GetProperties     write SetProperties;
  property  Mode             : Integer            read GetMode           write SetMode;
  property  CursorLocation   : Integer            read GetCursorLocation write SetCursorLocation;
  property  Attributes       : Integer            read GetAttributes     write SetAttributes;
 public   // TDbRecordset related
  property  AbsolutePage     : Integer            read GetAbsolutePage       write SetAbsolutePage;
  property  AbsolutePosition : Integer            read GetAbsolutePosition   write SetAbsolutePosition;
  property  Bof              : Boolean            read GetBof;
  property  Eof              : Boolean            read GetEof;
  property  Bookmark         : Integer            read GetBookmark           write SetBookmark;
  property  CacheSize        : Integer            read GetCacheSize          write SetCacheSize;
  property  CursorType       : Integer            read GetCursorType         write SetCursorType;
  property  EditMode         : Integer            read GetEditMode;
  property  Filter           : String             read GetFilter             write SetFilter;
  property  Index            : String             read GetIndex              write SetIndex;
  property  LockType         : Integer            read GetLockType           write SetLockType;
  property  MarshalOptions   : Integer            read GetMarshalOptions     write SetMarshalOptions;
  property  MaxRecords       : Integer            read GetMaxRecords         write SetMaxRecords;
  property  PageCount        : Integer            read GetPageCount;
  property  PageSize         : Integer            read GetPageSize           write SetPageSize;
  property  RecordCount      : Integer            read GetRecordCount;
  property  Sort             : String             read GetSort               write SetSort;
  property  Source           : String             read GetSource             write SetSource;
  property  Status           : Integer            read GetStatus;
  property  StayInSync       : Boolean            read GetStayInSync         write SetStayInSync;
 public   // TDbRecordset rows/fields related
  function  MoveFirst:Boolean;
  function  MoveLast:Boolean;
  function  MoveNext:Boolean;
  function  MovePrevious:Boolean;
  function  Update:Boolean;
  function  CancelUpdate:Boolean;
  function  FieldsCount:Integer;
  function  FieldsNames(i:Integer):String;
  function  FieldsTypes(id:String):Integer;
  function  FieldsAsInt(const id:String; op:Char; const arg:Integer):Integer;
  function  FieldsAsFloat(const id:String; op:Char; const arg:Double):Double;
  function  FieldsAsString(const id:String; op:Char; const arg:String):String;
  function  GetString(n:Integer=1; coldel:String=ASCII_HT; rowdel:String=LineEnding; nullexpr:String=''):String;
  function  AddNew(arg:String=''):Boolean;
  function  Delete(AffectRecords:Integer):Boolean;
  function  Requery(Options:Integer):Boolean;
  function  Resync(AffectRecords,ResyncValues:Integer):Boolean;
  function  Supports(CursorOptions:Integer):Boolean;
  function  Save(Destination:String; PersistFormat:Integer):Boolean;
 public   // TDbCommand related
  property  CommandType      : Integer            read GetCommandType        write SetCommandType;
  property  CommandText      : String             read GetCommandText        write SetCommandText;
 public   // Control routines
  function  Root:TDbConnection;
  function  Open(opt:Integer):Boolean;
  function  Control(arg:String):String;
  function  Execute(const arg:String; opt:Integer):TDbRecordset;
  function  Cancel:Boolean;
  function  Close:Boolean;
 public // Error counters
  class function TotalBugsCount:Integer;
  class function TotalBugsClear:Integer;
  class function IncTotalBugsCount:Integer;
 end;
 TDbParent = class(TDbEntity)
 private
  myChilds  : TList;
 private
  procedure AppendChild(aChild:TDbEntity);
  procedure DoAppendChild(aChild:TDbEntity); virtual;
  procedure RemoveChild(aChild:TDbEntity);
  procedure DoRemoveChild(aChild:TDbEntity); virtual;
 private
  function  DoGetChildCount:Integer; override;
  function  DoGetChildItems(i:Integer):TDbEntity; override;
 public
  constructor Create(aParent:TDbParent);
  destructor  Destroy; override;
 end;
 TDbConnection = class(TDbParent)
 private
  myEngineId        : Integer;
  myConStrng        : String;
  myAdoConn         : Connection;
  myBugsCount       : Integer;
  myRecordsAffected : Integer;
  myTimeStampInit   : Double;
  myTimeStampOpen   : Double;
  myTimeStampUser1  : Double;
  myTimeStampUser2  : Double;
  myTimeStampUser3  : Double;
  myUserState       : Integer;
  myUserFlags       : Integer;
  myUserLink        : Integer;
  myUserData        : String;
  myCookies         : String;
 private
  function  GetEngineId:Integer;
  procedure SetEngineId(eid:Integer);
  function  GetConnectionStringInit:String;
  function  GetTimeStampInit:Double;
  function  GetTimeStampOpen:Double;
  function  GetTimeStampUser1:Double;
  procedure SetTimeStampUser1(arg:Double);
  function  GetTimeStampUser2:Double;
  procedure SetTimeStampUser2(arg:Double);
  function  GetTimeStampUser3:Double;
  procedure SetTimeStampUser3(arg:Double);
  function  GetUserState:Integer;
  procedure SetUserState(arg:Integer);
  function  GetUserFlags:Integer;
  procedure SetUserFlags(arg:Integer);
  function  GetUserLink:Integer;
  procedure SetUserLink(arg:Integer);
  function  GetUserData:String;
  procedure SetUserData(arg:String);
  function  GetCookies:String;
  procedure SetCookies(arg:String);
  function  GetVersion:String;
  function  GetErrors:String;
  function  GetErrorsCount:Integer;
  function  GetErrorsClear:Integer;
  function  GetDriver:String;
  function  GetProvider:String;
  procedure SetProvider(const arg:String);
  function  GetConnectionString:String;
  procedure SetConnectionString(const arg:String);
  function  GetConnectionTimeout:Integer;
  procedure SetConnectionTimeout(arg:Integer);
  function  GetCommandTimeout:Integer;
  procedure SetCommandTimeout(arg:Integer);
  function  GetDefaultDatabase:String;
  procedure SetDefaultDatabase(const arg:String);
  function  GetIsolationLevel:Integer;
  procedure SetIsolationLevel(arg:Integer);
 private
  function  DoGetState:Integer; override;
  function  DoClose:Boolean; override;
  function  DoCancel:Boolean; override;
  function  DoGetProperties:String; override;
  procedure DoSetProperties(const arg:String); override;
  function  DoGetMode:Integer; override;
  procedure DoSetMode(arg:Integer); override;
  function  DoGetCursorLocation:Integer; override;
  procedure DoSetCursorLocation(arg:Integer); override;
  function  DoGetAttributes:Integer; override;
  procedure DoSetAttributes(arg:Integer); override;
  function  DoOpen(opt:Integer):Boolean; override;
  function  DoExecute(const arg:String; opt:Integer):TDbRecordset; override;
  function  GetRecordsAffected:Integer;
  function  GetBugsCount:Integer;
  function  GetBugsClear:Integer;
  procedure IncBugsCount;
 public
  constructor Create(eid:Integer=0; const arg:String='');
  destructor  Destroy; override;
 public
  property  EngineId             : Integer  read GetEngineId;
  property  ConnectionStringInit : String   read GetConnectionStringInit;
  property  TimeStampInit        : Double   read GetTimeStampInit;
  property  TimeStampOpen        : Double   read GetTimeStampOpen;
  property  TimeStampUser1       : Double   read GetTimeStampUser1 write SetTimeStampUser1;
  property  TimeStampUser2       : Double   read GetTimeStampUser2 write SetTimeStampUser2;
  property  TimeStampUser3       : Double   read GetTimeStampUser3 write SetTimeStampUser3;
  property  UserState            : Integer  read GetUserState      write SetUserState;
  property  UserFlags            : Integer  read GetUserFlags      write SetUserFlags;
  property  UserLink             : Integer  read GetUserLink       write SetUserLink;
  property  UserData             : String   read GetUserData       write SetUserData;
  property  Cookies              : String   read GetCookies        write SetCookies;
  property  Version              : String   read GetVersion;
  property  Errors               : String   read GetErrors;
  property  ErrorsCount          : Integer  read GetErrorsCount;
  property  ErrorsClear          : Integer  read GetErrorsClear;
  property  Driver               : String   read GetDriver;
  property  Provider             : String   read GetProvider          write SetProvider;
  property  ConnectionString     : String   read GetConnectionString  write SetConnectionString;
  property  ConnectionTimeout    : Integer  read GetConnectionTimeout write SetConnectionTimeout;
  property  CommandTimeout       : Integer  read GetCommandTimeout    write SetCommandTimeout;
  property  IsolationLevel       : Integer  read GetIsolationLevel    write SetIsolationLevel;
  property  DefaultDatabase      : String   read GetDefaultDatabase   write SetDefaultDatabase;
  property  RecordsAffected      : Integer  read GetRecordsAffected;
  property  BugsCount            : Integer  read GetBugsCount;
  property  BugsClear            : Integer  read GetBugsClear;
 public
  function  BeginTrans:Integer;
  function  CommitTrans:Boolean;
  function  RollbackTrans:Boolean;
 public
  function  CreateRecordset(arg:String):TDbRecordset;
  function  CreateCommand(arg:String):TDbCommand;
 end;
 TDbRecordset = class(TDbEntity)
 private
  myAdoRecs : Recordset;
 private
  function  DoBindRoot:Boolean; override;
  function  DoGetState:Integer; override;
  function  DoClose:Boolean; override;
  function  DoCancel:Boolean; override;
  function  DoGetCursorLocation:Integer; override;
  procedure DoSetCursorLocation(arg:Integer); override;
  function  DoOpen(opt:Integer):Boolean; override;
 public
  constructor Create(aParent:TDbParent; const aRecordset:Recordset);
  destructor  Destroy; override;
 end;
 TDbCommand = class(TDbEntity)
 private
  myAdoComm  : Command;
  myParams  : OleVariant;
 private
  function  DoBindRoot:Boolean; override;
  function  DoGetState:Integer; override;
  function  DoCancel:Boolean; override;
  function  DoExecute(const arg:String; opt:Integer):TDbRecordset; override;
 public
  constructor Create(aParent:TDbParent; const aCommand:Command);
  destructor  Destroy; override;
 end;

type
 EDbGetFields = class(ESoftException);

////////////////////////////////////////////////////////////////////////////////
// Utility routines.
////////////////////////////////////////////////////////////////////////////////

function  NewDbConnection(eid:Integer=0; const arg:String=''):TDbConnection;
procedure Kill(var TheObject:TDbConnection); overload;
procedure Kill(var TheObject:TDbRecordset); overload;
procedure Kill(var TheObject:TDbCommand); overload;

function  FormatAdoError(Error:Error; const Prefix:String='Error '):String;
function  FormatAdoErrors(Errors:Errors; const Prefix:String='Error '):String;
function  FormatAdoProperty(Prop:Property_; const Prefix:String=''):String;
function  FormatAdoProperties(Properties:Properties; const Prefix:String=''):String;
function  CreateDatabaseWithAdoxCatalog(arg:String):Boolean;
procedure GetOleDbProviderNamesToText(Names:TText);
function  OleDbProviderNames:TText;
function  OdbcDriverNames:TText;

 ///////////////////////////////
 // Provides the List of engines
 ///////////////////////////////
function  db_engine_count:Integer;
function  db_engine_name(n:Integer):String;

 /////////////////////////////////////////////////////////////////
 // Multiname substitution for ConnectionString uses because
 // same parameters may have different names (User Id,User,UID):
 // cs:=db_subst_connectionstring(cs,'User Id;User;UID','SYSDBA');
 /////////////////////////////////////////////////////////////////
function db_subst_connectionstring(cs,id,sv:String):String;

////////////////////////////////////////////////////////////////////////////////
// DbApi - easy DB interface for DaqPascal.
////////////////////////////////////////////////////////////////////////////////
// db_create(arg)             Create new DB (file) specified by (arg). Example:
//                            if db_create('Provider=LCPI.IBProvider.5.Free;'
//                            +'User Id=SYSDBA;Password=masterkey;ctype=win1251;'
//                            +'Location=localhost:c:\test.fdb;')
//                            then Writeln('DB created in c:\test.fdb');
// db_connection(eid,arg)     Create new connection object using engine (eid)
//                            and parameters specified by (arg). Example:
//                       dbc:=db_connection('Provider=LCPI.IBProvider.5.Free;'
//                            +'User Id=SYSDBA;Password=masterkey;ctype=win1251;'
//                            +'Location=localhost:c:\test.fdb;');
// db_free(dbo)               Free (destroy) database object (dbo)
// db_ref(dbo)                Return database object by reference (dbo)
// db_root(dbo)               Return root object - connection by reference (dbo)
// db_type(dbo)               Return type of (dbo), see db_type_xxx constants
// db_parent(dbo)             Return parent of (dbo)
// db_state(dbo)              Return state of (dbo), see adStateXXX constants
// db_close(dbo)              Close connection of object (dbo)
// db_open(dbo,opt)           Open connection (db) with options (opt)
// db_ctrl(dbo,arg)           Control database object (dbo) with arguments (arg)
//                            arg is 'name' (to read) or 'name=value' (to write)
// db_bugscount(dbo)          Return bugs counter (bugs is any errors) of object
// db_bugsclear(dbo)          Return bugs counter and clear (zero)
// db_errors(dbo)             Return provider-specific errors as long text
// db_errorscount(dbo)        Return provider-specific errors counter
// db_errorsclear(dbo)        Return provider-specific errors counter and clear
// db_execute(dbo,arg,opt)    Execute SQL command (arg) with options (opt)
//                            Return reference of new recordset object
// db_cancel(dbo)             Cancel execution of SQL command
// db_update(dbr)             Update records of recordset (dbr)
// db_cancelupdate(dbr)       Cancel update of recordset (dbr)
// db_begintrans(dbc)         Begin transaction of connection (dbc)
// db_committrans(dbc)        Commit transaction of connection (dbc)
// db_rollbacktrans(dbc)      Rollback transaction of connection (dbc)
// db_bof(dbr)                Is begin of file with recordset (dbr) ?
// db_eof(dbr)                Is end   of file with recordset (dbr) ?
// db_movefirst(dbr)          Move to first record of recordset (dbr)
// db_movelast(dbr)           Move to last  record of recordset (dbr)
// db_movenext(dbr)           Move to next  record of recordset (dbr)
// db_moveprevious(dbr)       Move to prior record of recordset (dbr)
// db_fieldscount(dbr)        Return fields count  of recordset (dbr)
// db_fieldsnames(dbr,i)      Return fields names  of recordset at index (i)
// db_fieldstypes(dbr,i)      Return fields types  of recordset at index (i)
// db_fieldsasXXX(dbr,id,op,arg) Read/write (for op=r/w) data field name (id)
//                            of recordset (dbr) with data (arg).
//                        arg is default value in reading mode (op='r').
//                        arg is data to trite in wtiting mode (op='w').
//                            XXX is data type (int,float,string).
// db_addnew(dbr,arg)         Add new record to recordset (dbr) and fields (arg)
//                        arg is CRLF delimited text of 'name' or 'name=value'.
// db_delete(dbr,aff)         Delete current record from recordset (dbr).
//                        aff is affected records adAffectCurrent/adAffectGroup
//                            where group is selected by Filter property.
// db_requery(dbr,opt)        Repeat query of recordset (dbr) with options (opt)
// db_resync(dbr,aff,res)     Refresh data in recordset (dbr) with affect (aff)
//                            and resync mode (res)
// db_supports(dbr,opt)       Check if recordset (opt) supports options (opt)
// db_save(dbr,dst,fmt)       Save recordset (dbr) to destination file (dst)
//                            in format specified (fmt)
////////////////////////////////////////////////////////////////////////////////

function db_create(arg:String):Boolean;
function db_connection(eid:Integer; arg:String):Integer;
function db_recordset(dbo:Integer; arg:String):Integer;
function db_command(dbo:Integer; arg:String):Integer;
function db_free(dbo:Integer):Boolean;
function db_ref(dbo:Integer):TDbEntity;
function db_root(dbo:Integer):TDbConnection;
function db_type(dbo:Integer):Integer;
function db_parent(dbo:Integer):Integer;
function db_state(dbo:Integer):Integer;
function db_close(dbo:Integer):Boolean;
function db_open(dbo:Integer; opt:Integer):Boolean;
function db_ctrl(dbo:Integer; arg:String):String;
function db_bugscount(dbo:Integer):Integer;
function db_bugsclear(dbo:Integer):Integer;
function db_errors(dbo:Integer):String;
function db_errorscount(dbo:Integer):Integer;
function db_errorsclear(dbo:Integer):Integer;
function db_execute(dbo:Integer; arg:String; opt:Integer):TDbRecordset;
function db_cancel(dbo:Integer):Boolean;
function db_update(dbr:Integer):Boolean;
function db_cancelupdate(dbr:Integer):Boolean;
function db_begintrans(dbc:Integer):Integer;
function db_committrans(dbc:Integer):Boolean;
function db_rollbacktrans(dbc:Integer):Boolean;
function db_bof(dbr:Integer):Boolean;
function db_eof(dbr:Integer):Boolean;
function db_movefirst(dbr:Integer):Boolean;
function db_movelast(dbr:Integer):Boolean;
function db_movenext(dbr:Integer):Boolean;
function db_moveprevious(dbr:Integer):Boolean;
function db_fieldscount(dbr:Integer):Integer;
function db_fieldsnames(dbr:Integer; i:Integer):String;
function db_fieldstypes(dbr:Integer; id:String):Integer;
function db_fieldsasint(dbr:Integer; id:String; op:Char; arg:Integer):Integer;
function db_fieldsasfloat(dbr:Integer; id:String; op:Char; arg:Double):Double;
function db_fieldsasstring(dbr:Integer; id:String; op:Char; arg:String):String;
function db_addnew(dbr:Integer; arg:String):Boolean;
function db_delete(dbr:Integer; aff:Integer):Boolean;
function db_requery(dbr:Integer; opt:Integer):Boolean;
function db_resync(dbr:Integer; aff,res:Integer):Boolean;
function db_supports(dbr:Integer; opt:Integer):Boolean;
function db_save(dbr:Integer; dst:String; fmt:Integer):Boolean;

implementation

 /////////////////////////////////////////////////////
 // Private Dictionary for fast string identification.
 /////////////////////////////////////////////////////
type
 TStringIdentifier = (
  sid_Unknown,
  ////////////////////// Properties Writable
  sid_ConnectionString,
  sid_ConnectionTimeout,
  sid_CommandTimeout,
  sid_IsolationLevel,
  sid_Driver,
  sid_Provider,
  sid_DefaultDatabase,
  sid_CursorLocation,
  sid_Attributes,
  sid_AbsolutePage,
  sid_AbsolutePosition,
  sid_TimeStampUser1,
  sid_TimeStampUser2,
  sid_TimeStampUser3,
  sid_UserState,
  sid_UserFlags,
  sid_UserLink,
  sid_UserData,
  sid_Cookies,
  sid_Bookmark,
  sid_CacheSize,
  sid_CursorType,
  sid_Mode,
  sid_Filter,
  sid_Index,
  sid_LockType,
  sid_MarshalOptions,
  sid_MaxRecords,
  sid_PageSize,
  sid_Sort,
  sid_Source,
  sid_Status,
  sid_StayInSync,
  sid_GetString,
  sid_CommandType,
  sid_CommandText,
  sid_Properties,
  ////////////////////// Properties Readable
  sid_Errors,
  sid_ErrorsCount,
  sid_ErrorsClear,
  sid_ConnectionStringInit,
  sid_TimeStampInit,
  sid_TimeStampOpen,
  sid_State,
  sid_Version,
  sid_EngineId,
  sid_EngineName,
  sid_ProviderNames,
  sid_RecordsAffected,
  sid_PageCount,
  sid_RecordCount,
  sid_EditMode,
  sid_BugsCount,
  sid_BugsClear,
  sid_TotalBugsCount,
  sid_TotalBugsClear,
  sid_BugReportPrefix,
  sid_BugReportPrefixAll,
  ////////////////////// Properties End
  sid_Asterisk,
  sid_Unused
 );

const
 Dictionary:THashList=nil;

procedure FreeDictionary;
begin
 Kill(Dictionary);
end;

procedure InitDictionary;
 procedure AddSid(const key:String; sid:TStringIdentifier);
 begin
  Dictionary.KeyedLinks[key]:=Ord(sid);
 end;
begin
 if (Dictionary<>nil) then Exit;
 Dictionary:=NewHashList(false,HashList_DefaultHasher);
 Dictionary.Master:=Dictionary;
 Dictionary.OwnsObjects:=false;
 /////////////////////////////////////////////
 // Dictionary for fast strings identification
 /////////////////////////////////////////////
 AddSid( 'ConnectionString'     , sid_ConnectionString);
 AddSid( 'ConnectionTimeout'    , sid_ConnectionTimeout);
 AddSid( 'CommandTimeout'       , sid_CommandTimeout);
 AddSid( 'IsolationLevel'       , sid_IsolationLevel);
 AddSid( 'Driver'               , sid_Driver);
 AddSid( 'Provider'             , sid_Provider);
 AddSid( 'DefaultDatabase'      , sid_DefaultDatabase);
 AddSid( 'CursorLocation'       , sid_CursorLocation);
 AddSid( 'Attributes'           , sid_Attributes);
 AddSid( 'AbsolutePage'         , sid_AbsolutePage);
 AddSid( 'AbsolutePosition'     , sid_AbsolutePosition);
 AddSid( 'TimeStampUser1'       , sid_TimeStampUser1);
 AddSid( 'TimeStampUser2'       , sid_TimeStampUser2);
 AddSid( 'TimeStampUser3'       , sid_TimeStampUser3);
 AddSid( 'UserState'            , sid_UserState);
 AddSid( 'UserFlags'            , sid_UserFlags);
 AddSid( 'UserLink'             , sid_UserLink);
 AddSid( 'UserData'             , sid_UserData);
 AddSid( 'Cookies'              , sid_Cookies);
 AddSid( 'Bookmark'             , sid_Bookmark);
 AddSid( 'CacheSize'            , sid_CacheSize);
 AddSid( 'CursorType'           , sid_CursorType);
 AddSid( 'Mode'                 , sid_Mode);
 AddSid( 'Filter'               , sid_Filter);
 AddSid( 'Index'                , sid_Index);
 AddSid( 'LockType'             , sid_LockType);
 AddSid( 'MarshalOptions'       , sid_MarshalOptions);
 AddSid( 'MaxRecords'           , sid_MaxRecords);
 AddSid( 'PageCount'            , sid_PageCount);
 AddSid( 'PageSize'             , sid_PageSize);
 AddSid( 'RecordCount'          , sid_RecordCount);
 AddSid( 'Sort'                 , sid_Sort);
 AddSid( 'Source'               , sid_Source);
 AddSid( 'Status'               , sid_Status);
 AddSid( 'StayInSync'           , sid_StayInSync);
 AddSid( 'GetString'            , sid_GetString);
 AddSid( 'CommandType'          , sid_CommandType);
 AddSid( 'CommandText'          , sid_CommandText);
 AddSid( 'Properties'           , sid_Properties);
 AddSid( 'Errors'               , sid_Errors);
 AddSid( 'ErrorsCount'          , sid_ErrorsCount);
 AddSid( 'ErrorsClear'          , sid_ErrorsClear);
 AddSid( 'ConnectionStringInit' , sid_ConnectionStringInit);
 AddSid( 'TimeStampInit'        , sid_TimeStampInit);
 AddSid( 'TimeStampOpen'        , sid_TimeStampOpen);
 AddSid( 'State'                , sid_State);
 AddSid( 'Version'              , sid_Version);
 AddSid( 'EngineId'             , sid_EngineId);
 AddSid( 'EngineName'           , sid_EngineName);
 AddSid( 'ProviderNames'        , sid_ProviderNames);
 AddSid( 'RecordsAffected'      , sid_RecordsAffected);
 AddSid( 'EditMode'             , sid_EditMode);
 AddSid( 'BugsCount'            , sid_BugsCount);
 AddSid( 'BugsClear'            , sid_BugsClear);
 AddSid( 'TotalBugsCount'       , sid_TotalBugsCount);
 AddSid( 'TotalBugsClear'       , sid_TotalBugsClear);
 AddSid( 'BugReportPrefix'      , sid_BugReportPrefix);
 AddSid( 'BugReportPrefixAll'   , sid_BugReportPrefixAll);
 AddSid( '*'                    , sid_Asterisk);
end;

function Identify(const key:String):TStringIdentifier;
var sid:Integer;
begin
 if (Dictionary=nil) then InitDictionary;
 sid:=Dictionary.KeyedLinks[key];
 if (sid>=Ord(Low(TStringIdentifier))) and (sid<=Ord(High(TStringIdentifier)))
 then Result:=TStringIdentifier(sid)
 else Result:=sid_Unknown;
end;

const
 sid_Control_Writable = [Succ(sid_Unknown)..Pred(sid_Errors)];
 sid_Control_Readable = [Succ(sid_Unknown)..Pred(sid_Asterisk)];

///////////////////////////
// Internal helper routines
///////////////////////////

function SafeListCount(aList:TList):Integer;
begin
 if (aList<>nil)
 then Result:=aList.Count
 else Result:=0;
end;

function SafeListItems(aList:TList; aIndex:Integer):Pointer;
begin
 if (aList<>nil) and (aIndex>=0) and (aIndex<aList.Count)
 then Result:=aList.Items[aIndex]
 else Result:=nil;
end;

procedure SafeListAdd(aList:TList; aItem:Pointer);
begin
 if (aList<>nil) and (aItem<>nil)
 then aList.Add(aItem);
end;

procedure SafeListRemove(aList:TList; aItem:Pointer);
begin
 if (aList<>nil) and (aItem<>nil)
 then aList.Remove(aItem);
end;

///////////////////
// Utility routines
///////////////////

procedure BugReport(E:Exception; O:TObject; const S:String);
begin
 TDbConnection.IncTotalBugsCount;
 if (StrFetch(S,1)='@')
 then _alloc.BugReport(E,O,S)
 else _alloc.BugReport(E,O,db_bugreport_prefix+S);
end;

function Br2sp(const s:String):String; // Line breaks to spaces
begin
 Result:=SysUtils.Trim(StringReplace(AdjustLineBreaks(s),LineEnding,' ',[rfReplaceAll]));
end;

function VarToStrDef(const v:Variant; const def:String):String;
begin
 Result:=def;
 try
  Result:=VarToStr(v);
 except
  on E:Exception do BugReport(E,nil,'VarToStrDef');
  //TDbConnection.IncTotalBugsCount; Result:=def;
 end;
end;

function FormatAdoError(Error:Error; const Prefix:String='Error '):String;
begin
 Result:='';
 if (Error<>nil) then
 try
  Result:=Prefix+
          Format('Number=$%X;Description=%s;'
                +'HelpFile=%s;HelpContext=%d;'
                +'Source=%s;SQLState=%s;NativeError=$%X;',
                [Error.Number,Br2sp(Error.Description),
                 Error.HelpFile,Error.HelpContext,
                 Error.Source,Error.SQLState,Error.NativeError]);
 except
  on E:Exception do BugReport(E,nil,'FormatAdoError');
 end;
end;

function FormatAdoErrors(Errors:Errors; const Prefix:String='Error '):String;
var i:Integer; Line:String; Lines:TStringList;
begin
 Result:='';
 if (Errors<>nil) then
 try
  Lines:=TStringList.Create;
  try
   for i:=0 to Errors.Count-1 do begin
    Line:=FormatAdoError(Errors.Item[i],Prefix);
    if (Line<>'') then Lines.Add(Line);
   end;
   if (Lines.Count>0) then Result:=Lines.Text;
  finally
   Lines.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'FormatAdoErrors');
 end;
end;

function FormatAdoProperty(Prop:Property_; const Prefix:String=''):String;
var pt,pa:Integer; pn,pv:String;
begin
 Result:='';
 if (Prop<>nil) then
 try
  pn:=Prop.Name; pt:=Prop.Type_; pa:=Prop.Attributes; pv:=VarToStrDef(Prop.Value,'');
  Result:=Prefix+Format('%s=%d,%d,%s',[pn,pt,pa,pv]);
 except
  on E:Exception do BugReport(E,nil,'FormatAdoProperty');
 end;
end;

function FormatAdoProperties(Properties:Properties; const Prefix:String=''):String;
var i:Integer; Line:String; Lines:TStringList;
begin
 Result:='';
 if (Properties<>nil) then
 try
  Lines:=TStringList.Create;
  try
   for i:=0 to Properties.Count-1 do begin
    Line:=FormatAdoProperty(Properties.Item[i],Prefix);
    if (Line<>'') then Lines.Add(Line);
   end;
   if (Lines.Count>0) then Result:=Lines.Text;
  finally
   Lines.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'FormatAdoProperties');
 end;
end;

function AssignAdoProperties(Properties:Properties; const arg:String):Boolean;
var i,p,pa:Integer; Line,sn,sv:String; Lines:TStringList;
begin
 Result:=false;
 if (arg<>'') then
 if (Properties<>nil) then
 try
  Lines:=TStringList.Create;
  try
   Lines.Text:=AdjustLineBreaks(arg);
   for i:=0 to Lines.Count-1 do begin
    Line:=Lines[i]; p:=Pos('=',Line); if (p=0) then Continue;
    sn:=Copy(Line,1,p-1); sv:=Copy(Line,p+1,MaxInt);
    sn:=SysUtils.Trim(sn); sv:=SysUtils.Trim(sv);
    pa:=Properties.Item[sn].Attributes;
    if ((pa and adPropWrite)=0) then Continue;
    Properties.Item[sn].Value:=sv;
   end;
   Result:=true;
  finally
   Lines.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'AssignAdoProperties');
 end;
end;

function CreateDatabaseWithAdoxCatalog(arg:String):Boolean;
var catalog:Variant;
begin
 Result:=false;
 if (arg<>'') then
 try
  catalog:=CreateOleObject('ADOX.Catalog');
  try
   catalog.Create(arg);
   Result:=true;
  finally
   catalog:=Unassigned;
  end;
 except
  on E:Exception do BugReport(E,nil,'CreateDatabaseWithAdoxCatalog');
 end;
end;

procedure GetOleDbProviderNamesToText(Names:TText); // From AdoDb, modified
var
 RSCon: ADORecordsetConstruction;
 Rowset: IRowset;
 SourcesRowset: ISourcesRowset;
 SourcesRecordset: _Recordset;
 SourceType:Integer; SourceName:String;
begin
 if (Names<>nil) then
 try
  // First prepare OleDb enumerator
  SourcesRecordset := CoRecordset.Create;
  RSCon := SourcesRecordset as ADORecordsetConstruction;
  SourcesRowset := CreateComObject(CLSID_OLEDB_ENUMERATOR) as ISourcesRowset;
  OleCheck(SourcesRowset.GetSourcesRowset(nil, IRowset, 0, nil, IUnknown(Rowset)));
  RSCon.Set_Rowset(RowSet);
  // Then update list
  while not  SourcesRecordset.EOF do begin
   SourceType:=SourcesRecordset.Fields.Item['SOURCES_TYPE'].Value;
   if (SourceType=DBSOURCETYPE_DATASOURCE) then begin
    SourceName:=SourcesRecordset.Fields.Item['SOURCES_NAME'].Value;
    Names.Addln(SourceName);
   end;
   SourcesRecordset.MoveNext;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetOleDbProviderNamesToText');
 end;
end;

const
 TheOleDbProviderNames:TText=nil;

function OleDbProviderNames:TText;
begin
 if (TheOleDbProviderNames=nil) then begin
  TheOleDbProviderNames:=NewText(32);
  TheOleDbProviderNames.Master:=TheOleDbProviderNames;
 end;
 if (TheOleDbProviderNames.Count=0)
 then GetOleDbProviderNamesToText(TheOleDbProviderNames);
 Result:=TheOleDbProviderNames;
end;

////////////////////////////////////////////////////////////////////////////////
// SQLGetInstalledDrivers reads the [ODBC Drivers] section of the system information
// and returns a list of descriptions of the installed drivers.
//
// Location: odbccp32.dll
//
// BOOL SQLGetInstalledDrivers(LPSTR lpszBuf, WORD cbBufMax, WORD *  pcbBufOut);
//
// pszBuf    [Output] List of descriptions of the installed drivers.
// cbBufMax  [Input]  Length of lpszBuf.
// pcbBufOut [Output] Total number of bytes (excluding the null-termination byte)
//           returned in lpszBuf. If the number of bytes available to return
//           is greater than or equal to cbBufMax, the list of driver descriptions
//           in lpszBuf is truncated to cbBufMax minus the null-termination character.
//           The pcbBufOut argument can be a null pointer.
// The function returns TRUE if it is successful, FALSE if it fails.
////////////////////////////////////////////////////////////////////////////////
// https://github.com/MicrosoftDocs/sql-docs/blob/live/docs/odbc/reference/syntax/sqlgetinstalleddrivers-function.md
////////////////////////////////////////////////////////////////////////////////

function SQLGetInstalledDrivers(lpszBuf:PChar; cbBufMax:WORD; pcbBufOut:PWORD):BOOL; stdcall;
type FunSQLGetInstalledDrivers=function(lpszBuf:PChar; cbBufMax:WORD; pcbBufOut:PWORD):BOOL; stdcall;
const F:FunSQLGetInstalledDrivers=nil; hDll:THandle=0; Flag:Boolean=false;
const sDll='odbccp32.dll'; sFun='SQLGetInstalledDrivers';
begin
 Result:=false;
 try
  if not Flag then begin
   hDll:=GetModuleHandle(sDll);
   if (hDll=0) then hDll:=LoadLibrary(sDll);
   if (hDll<>0) then @F:=GetProcAddress(hDll,sFun);
   Flag:=true;
  end;
  if (@F<>nil) then Result:=F(lpszBuf,cbBufMax,pcbBufOut);
 except
  on E:Exception do BugReport(E,nil,'SQLGetInstalledDrivers');
 end;
end;

function GetInstalledOdbcDrivers:String;
var Lines:TStringList; Buf,Line:String;
    lpszBuf:PChar; cbBufMax,pcbBufOut:WORD; n,len:Integer;
begin
 Result:='';
 try
  Lines:=TStringList.Create;
  try
   Buf:=StringOfChar(#0,1024*48); n:=0;
   lpszBuf:=PChar(Buf); cbBufMax:=Length(Buf); pcbBufOut:=0;
   if SQLGetInstalledDrivers(lpszBuf,cbBufMax,@pcbBufOut) then
   if (lpszBuf<>nil) and (pcbBufOut>0) then
   while (StrLen(lpszBuf)>0) and (n<pcbBufOut) do begin
    Line:=lpszBuf; Line:=SysUtils.Trim(Line);
    if (Length(Line)>0) then Lines.Add(Line);
    len:=StrLen(lpszBuf);
    inc(lpszBuf,len+1);
    inc(n,len+1);
   end;
   Result:=Lines.Text;
  finally
   Lines.Free;
   Line:='';
   Buf:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'GetInstalledOdbcDrivers');
 end;
end;

const
 TheOdbcDriverNames:TText=nil;

function OdbcDriverNames:TText;
begin
 if (TheOdbcDriverNames=nil) then begin
  TheOdbcDriverNames:=NewText(64);
  TheOdbcDriverNames.Master:=TheOdbcDriverNames;
 end;
 if (TheOdbcDriverNames.Count=0)
 then TheOdbcDriverNames.Text:=GetInstalledOdbcDrivers;
 Result:=TheOdbcDriverNames;
end;

function db_engine_count:Integer;
begin
 Result:=WordCount(db_engine_list_csv,ScanSpaces);
end;

function db_engine_name(n:Integer):String;
begin
 if (n=db_engine_def) then n:=db_engine_default;
 Result:=ExtractWord(n,db_engine_list_csv,ScanSpaces);
end;

function db_subst_connectionstring(cs,id,sv:String):String;
var Lines:TStringList; i,pe,nc:Integer; sl,sn:String;
begin
 Result:=cs; nc:=0;
 cs:=SysUtils.Trim(cs); if (cs='') then Exit;
 id:=SysUtils.Trim(id); if (id='') then Exit;
 sv:=SysUtils.Trim(sv); if (sv='') then Exit;
 try
  Lines:=TStringList.Create;
  try
   Lines.Text:=StringReplace(cs,';',LineEnding,[rfReplaceAll]);
   for i:=0 to Lines.Count-1 do begin
    sl:=Lines.Strings[i];
    pe:=Pos('=',sl); if (pe=0) then continue;
    sn:=SysUtils.Trim(Copy(sl,1,pe-1)); // Find name:
    if (WordIndex(sn,id,ScanSpaces)=0) then continue;
    Lines.Strings[i]:=sn+'='+sv; inc(nc);
   end;
   if (nc>0) then Result:=StringReplace(Lines.Text,LineEnding,';',[rfReplaceAll]);
  finally
   Lines.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'db_subst_connectionstring');
 end;
end;

///////////////////////////
// TDbEntity implementation
///////////////////////////

constructor TDbEntity.Create(aParent:TDbParent);
begin
 inherited Create;
 myTypeId:=db_type_entity;
 myParent:=aParent;
 myBgPref:=db_bugreport_prefix;
end;

destructor TDbEntity.Destroy;
begin
 myBgPref:='';
 myParent:=nil;
 inherited Destroy;
end;

procedure TDbEntity.AfterConstruction;
begin
 inherited AfterConstruction;
 Parent.AppendChild(Self);
 if db_bindroot_oncreate
 then BindRoot;
end;

procedure TDbEntity.BeforeDestruction;
begin
 FreeAllChilds;
 Parent.RemoveChild(Self);
 inherited BeforeDestruction;
end;

procedure TDbEntity.FreeAllChilds;
var i:Integer;
begin
 for i:=ChildCount-1 downto 0 do ChildItems[i].Free;
end;

function TDbEntity.GetChildCount:Integer;
begin
 if (Self<>nil)
 then Result:=DoGetChildCount
 else Result:=0;
end;

function TDbEntity.DoGetChildCount:Integer;
begin
 Result:=0;
end;

function TDbEntity.GetChildItems(i:Integer):TDbEntity;
begin
 if (Self<>nil)
 then Result:=DoGetChildItems(i)
 else Result:=nil;
end;

function TDbEntity.DoGetChildItems(i:Integer):TDbEntity;
begin
 Result:=nil;
end;

procedure TDbEntity.BugReport(E:Exception; O:TObject; const S:String);
begin
 Root.IncBugsCount;
 if (Self=nil)
 then _dbapi.BugReport(E,O,S)
 else _dbapi.BugReport(E,O,myBgPref+S);
end;

function TDbEntity.GetTypeId:Integer;
begin
 if (Self<>nil)
 then Result:=myTypeId
 else Result:=0;
end;

function TDbEntity.GetParent:TDbParent;
begin
 if (Self<>nil)
 then Result:=myParent
 else Result:=nil;
end;

function TDbEntity.Root:TDbConnection;
var E:TDbEntity;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 E:=Self; while (E<>nil) and (E.TypeId<>db_type_connection) do E:=E.Parent;
 if (E is TDbConnection) then Result:=TDbConnection(E);
end;

function TDbEntity.BindRoot:Boolean;
begin
 if (Self<>nil)
 then Result:=DoBindRoot
 else Result:=false;
end;

function TDbEntity.DoBindRoot:Boolean;
begin
 Result:=false;
end;

function TDbEntity.GetState:Integer;
begin
 if (Self<>nil)
 then Result:=DoGetState
 else Result:=0;
end;

function TDbEntity.DoGetState:Integer;
begin
 Result:=0;
end;

function TDbEntity.Close:Boolean;
begin
 if (Self<>nil)
 then Result:=DoClose
 else Result:=false;
end;

function TDbEntity.DoClose:Boolean;
begin
 Result:=false;
end;

function TDbEntity.Cancel:Boolean;
begin
 if (Self<>nil)
 then Result:=DoCancel
 else Result:=false;
end;

function TDbEntity.DoCancel:Boolean;
begin
 Result:=false;
end;

function TDbEntity.GetProperties:String;
begin
 if (Self<>nil)
 then Result:=DoGetProperties
 else Result:='';
end;

function TDbEntity.DoGetProperties:String;
begin
 Result:=''
end;

procedure TDbEntity.SetProperties(const arg:String);
begin
 if (Self=nil) then Exit;
 DoSetProperties(arg);
end;

procedure TDbEntity.DoSetProperties(const arg:String);
begin
end;

function TDbEntity.Open(opt:Integer):Boolean;
begin
 if (Self<>nil)
 then Result:=DoOpen(opt)
 else Result:=false;
end;

function TDbEntity.DoOpen(opt:Integer):Boolean;
begin
 Result:=false;
end;

function TDbEntity.GetMode:Integer;
begin
 if (Self<>nil)
 then Result:=DoGetMode
 else Result:=0;
end;

function TDbEntity.DoGetMode:Integer;
begin
 Result:=0;
end;

procedure TDbEntity.SetMode(arg:Integer);
begin
 if (Self=nil) then Exit;
 DoSetMode(arg);
end;

procedure TDbEntity.DoSetMode(arg:Integer);
begin
end;

function TDbEntity.GetCursorLocation:Integer;
begin
 if (Self<>nil)
 then Result:=DoGetCursorLocation
 else Result:=0;
end;

function TDbEntity.DoGetCursorLocation:Integer;
begin
 Result:=0;
end;

procedure TDbEntity.SetCursorLocation(arg:Integer);
begin
 if (Self=nil) then Exit;
 DoSetCursorLocation(arg);
end;

procedure TDbEntity.DoSetCursorLocation(arg:Integer);
begin
end;

function TDbEntity.GetAttributes:Integer;
begin
 if (Self<>nil)
 then Result:=DoGetAttributes
 else Result:=0;
end;

function TDbEntity.DoGetAttributes:Integer;
begin
 Result:=0;
end;

procedure TDbEntity.SetAttributes(arg:Integer);
begin
 if (Self=nil) then Exit;
 DoSetAttributes(arg);
end;

procedure TDbEntity.DoSetAttributes(arg:Integer);
begin
end;

function TDbEntity.GetAbsolutePage:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.AbsolutePage;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetAbsolutePage');
 end;
end;

procedure TDbEntity.SetAbsolutePage(arg:Integer);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.AbsolutePage:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetAbsolutePage');
 end;
end;

function TDbEntity.GetAbsolutePosition:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.AbsolutePosition;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetAbsolutePosition');
 end;
end;

procedure TDbEntity.SetAbsolutePosition(arg:Integer);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.AbsolutePosition:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetAbsolutePosition');
 end;
end;

function TDbEntity.GetBof:Boolean;
begin
 Result:=true;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.BOF;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetBof');
 end;
end;

function TDbEntity.GetEof:Boolean;
begin
 Result:=true;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.EOF;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetEof');
 end;
end;

function TDbEntity.GetBookmark:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.Bookmark;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetBookmark');
 end;
end;

procedure TDbEntity.SetBookmark(arg:Integer);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.Bookmark:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetBookmark');
 end;
end;

function TDbEntity.GetCacheSize:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.CacheSize;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetCacheSize');
 end;
end;

procedure TDbEntity.SetCacheSize(arg:Integer);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.CacheSize:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetCacheSize');
 end;
end;

function TDbEntity.GetCursorType:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.CursorType;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetCursorType');
 end;
end;

procedure TDbEntity.SetCursorType(arg:Integer);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.CursorType:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetCursorType');
 end;
end;

function TDbEntity.GetEditMode:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.EditMode;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetEditMode');
 end;
end;

function TDbEntity.GetFilter:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.Filter;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetFilter');
 end;
end;

procedure TDbEntity.SetFilter(arg:String);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.Filter:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetFilter');
 end;
end;

function TDbEntity.GetIndex:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.Index;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetIndex');
 end;
end;

procedure TDbEntity.SetIndex(arg:String);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.Index:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetIndex');
 end;
end;

function TDbEntity.GetLockType:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.LockType;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetLockType');
 end;
end;

procedure TDbEntity.SetLockType(arg:Integer);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.LockType:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetLockType');
 end;
end;

function TDbEntity.GetMarshalOptions:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.MarshalOptions;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetMarshalOptions');
 end;
end;

procedure TDbEntity.SetMarshalOptions(arg:Integer);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.MarshalOptions:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetMarshalOptions');
 end;
end;

function TDbEntity.GetMaxRecords:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.MaxRecords;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetMaxRecords');
 end;
end;

procedure TDbEntity.SetMaxRecords(arg:Integer);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.MaxRecords:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetMaxRecords');
 end;
end;

function TDbEntity.GetPageCount:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.PageCount;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetPageCount');
 end;
end;

function TDbEntity.GetPageSize:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.PageSize;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetPageSize');
 end;
end;

procedure TDbEntity.SetPageSize(arg:Integer);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.PageSize:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetPageSize');
 end;
end;

function TDbEntity.GetRecordCount:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.RecordCount;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetRecordCount');
 end;
end;

function TDbEntity.GetSort:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.Sort;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetSort');
 end;
end;

procedure TDbEntity.SetSort(arg:String);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.Sort:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetSort');
 end;
end;

function TDbEntity.GetSource:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.Get_Source;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetSource');
 end;
end;

procedure TDbEntity.SetSource(arg:String);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs._Set_Source(arg);
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetSource');
 end;
end;

function TDbEntity.GetStatus:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.Status;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetStatus');
 end;
end;

function TDbEntity.GetStayInSync:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.StayInSync;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetStayInSync');
 end;
end;

procedure TDbEntity.SetStayInSync(arg:Boolean);
begin
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.StayInSync:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetStayInSync');
 end;
end;

function TDbEntity.MoveFirst:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.MoveFirst;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'MoveFirst');
 end;
end;

function TDbEntity.MoveLast:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.MoveLast;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'MoveLast');
 end;
end;

function TDbEntity.MoveNext:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.MoveNext;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'MoveNext');
 end;
end;

function TDbEntity.MovePrevious:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.MovePrevious;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'MovePrevious');
 end;
end;

function TDbEntity.Update:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.Update(EmptyParam,EmptyParam);
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'Update');
 end;
end;

function TDbEntity.CancelUpdate:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.CancelUpdate;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'CancelUpdate');
 end;
end;

function TDbEntity.Requery(Options:Integer):Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.Requery(Options);
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'Requery');
 end;
end;

function TDbEntity.Resync(AffectRecords,ResyncValues:Integer):Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.Resync(AffectRecords,ResyncValues);
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'Resync');
 end;
end;

function TDbEntity.Supports(CursorOptions:Integer):Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.Supports(CursorOptions);
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'Supports');
 end;
end;

function TDbEntity.Save(Destination:String; PersistFormat:Integer):Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.Save(Destination,PersistFormat);
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'Save');
 end;
end;

function TDbEntity.FieldsCount:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbRecordset).myAdoRecs.Fields.Count;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'FieldsCount');
 end;
end;

function TDbEntity.FieldsNames(i:Integer):String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    if (i<0) or (i>=FieldsCount) then Exit;
    Result:=(Self as TDbRecordset).myAdoRecs.Fields.Item[i].Name;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'FieldsNames');
 end;
end;

function TDbEntity.FieldsTypes(id:String):Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    if (id='') then Exit;
    Result:=(Self as TDbRecordset).myAdoRecs.Fields.Item[id].Type_;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'FieldsTypes');
 end;
end;

function TDbEntity.FieldsAsInt(const id:String; op:Char; const arg:Integer):Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  Result:=arg;
  case Root.EngineId of
   db_engine_ado: begin
    if (id='') then Exit;
    case UpCase(op) of
     'R','?','<' : begin
      Result:=(Self as TDbRecordset).myAdoRecs.Fields.Item[id].Value;
     end;
     'W','=','>' : begin
      (Self as TDbRecordset).myAdoRecs.Fields.Item[id].Value:=arg;
     end;
     else raise EDbGetFields.Create('Invalid operation ('+op+') in FieldsAsInt.');
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'FieldsAsInt');
 end;
end;

function TDbEntity.FieldsAsFloat(const id:String; op:Char; const arg:Double):Double;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  Result:=arg;
  case Root.EngineId of
   db_engine_ado: begin
    if (id='') then Exit;
    case UpCase(op) of
     'R','?','<' : begin
      Result:=(Self as TDbRecordset).myAdoRecs.Fields.Item[id].Value;
     end;
     'W','=','>' : begin
      (Self as TDbRecordset).myAdoRecs.Fields.Item[id].Value:=arg;
     end;
     else raise EDbGetFields.Create('Invalid operation ('+op+') in FieldsAsFloat.');
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'FieldsAsFloat');
 end;
end;

function TDbEntity.FieldsAsString(const id:String; op:Char; const arg:String):String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  Result:=arg;
  case Root.EngineId of
   db_engine_ado: begin
    if (id='') then Exit;
    case UpCase(op) of
     'R','?','<' : begin
      Result:=VarToStrDef((Self as TDbRecordset).myAdoRecs.Fields.Item[id].Value,arg);
     end;
     'W','=','>' : begin
      (Self as TDbRecordset).myAdoRecs.Fields.Item[id].Value:=arg;
     end;
     else raise EDbGetFields.Create('Invalid operation ('+op+') in FieldsAsString.');
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'FieldsAsString');
 end;
end;

function TDbEntity.GetString(n:Integer=1; coldel:String=ASCII_HT; rowdel:String=LineEnding; nullexpr:String=''):String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    if (n>0) and (coldel<>'') and (rowdel<>'') then
    Result:=(Self as TDbRecordset).myAdoRecs.GetString(adClipString,n,coldel,rowdel,nullexpr);
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetString');
 end;
end;

function TDbEntity.AddNew(arg:String=''):Boolean;
var Fields,Values:OleVariant; Lines:TStringList;
 procedure PrepareFieldsValues;
 var i,p:Integer; sn,sv,sl:String;
 begin
  if (arg<>'') then begin
   Lines:=TStringList.Create;
   try
    Lines.Text:=AdjustLineBreaks(arg);
    for i:=Lines.Count-1 downto 0 do begin
     sl:=Lines[i]; sn:=sl; sv:=''; p:=Pos('=',sl);
     if (p>0) then begin sn:=Copy(sl,1,p-1); sv:=Copy(sl,p+1,MaxInt); end;
     sn:=SysUtils.Trim(sn); if (sn='') then Lines.Delete(i);
    end;
    if Lines.Count=0 then Exit;
    Fields:=VarArrayCreate([0,Lines.Count-1],varVariant);
    Values:=VarArrayCreate([0,Lines.Count-1],varVariant);
    for i:=0 to Lines.Count-1 do begin
     sl:=Lines[i]; sn:=sl; sv:=''; p:=Pos('=',sl);
     if (p>0) then begin sn:=Copy(sl,1,p-1); sv:=Copy(sl,p+1,MaxInt); end;
     sn:=SysUtils.Trim(sn);
     Fields[i]:=sn;
     Values[i]:=sv;
    end;
   finally
    Kill(Lines);
   end;
  end;
 end;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Fields:=EmptyParam;
    Values:=EmptyParam;
    PrepareFieldsValues;
    try
     (Self as TDbRecordset).myAdoRecs.AddNew(Fields,Values);
    finally
     Fields:=Unassigned;
     Values:=Unassigned;
    end;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'AddNew');
 end;
end;

function TDbEntity.Delete(AffectRecords:Integer):Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 if (Self is TDbRecordset) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbRecordset).myAdoRecs.Delete(AffectRecords);
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'Delete');
 end;
end;

function TDbEntity.GetCommandType:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 if (Self is TDbCommand) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbCommand).myAdoComm.CommandType;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetCommandType');
 end;
end;

procedure TDbEntity.SetCommandType(arg:Integer);
begin
 if (Self=nil) then Exit;
 if (Self is TDbCommand) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbCommand).myAdoComm.CommandType:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetCommandType');
 end;
end;

function TDbEntity.GetCommandText:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (Self is TDbCommand) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=(Self as TDbCommand).myAdoComm.CommandText;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetCommandText');
 end;
end;

procedure TDbEntity.SetCommandText(arg:String);
begin
 if (Self=nil) then Exit;
 if (Self is TDbCommand) then
 try
  case Root.EngineId of
   db_engine_ado: begin
    (Self as TDbCommand).myAdoComm.CommandText:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetCommandText');
 end;
end;

function TDbEntity.Control(arg:String):String;
var i,pe,iv,si:Integer; sn,sv,sc,sr,sz:String; rv:Double;
begin
 Result:='';
 if (Self=nil) then Exit;
 if (arg='') then Exit;
 try
  pe:=Pos('=',arg);
  if (pe>0) then begin
   sn:=Copy(arg,1,pe-1);
   sv:=Copy(arg,pe+1,Length(arg)-pe);
  end else begin
   sn:=arg;
   sv:='';
  end;
  case Identify(sn) of
   sid_State: begin
    Result:=IntToStr(State);
   end;
   sid_Version: begin
    Result:=Root.Version;
   end;
   sid_EngineId: begin
    Result:=IntToStr(Root.EngineId);
   end;
   sid_EngineName: begin
    Result:=ExtractWord(Root.EngineId,db_engine_list_csv,ScanSpaces);
   end;
   sid_Errors: begin
    Result:=Root.Errors;
   end;
   sid_ErrorsCount: begin
    Result:=IntToStr(Root.ErrorsCount);
   end;
   sid_ErrorsClear: begin
    Result:=IntToStr(Root.ErrorsClear);
   end;
   sid_Driver: begin
    Result:=Root.Driver;
   end;
   sid_Provider: begin
    if (pe>0) then Root.Provider:=SysUtils.Trim(sv);
    Result:=Root.Provider;
   end;
   sid_DefaultDatabase: begin
    if (pe>0) then Root.DefaultDatabase:=SysUtils.Trim(sv);
    Result:=Root.DefaultDatabase;
   end;
   sid_Properties: begin
    if (pe>0) then Properties:=SysUtils.Trim(sv);
    Result:=Properties;
   end;
   sid_CursorLocation: begin
    if (pe>0) and Str2Int(sv,iv) then CursorLocation:=iv;
    Result:=IntToStr(CursorLocation);
   end;
   sid_Attributes: begin
    if (pe>0) and Str2Int(sv,iv) then Attributes:=iv;
    Result:=IntToStr(Attributes);
   end;
   sid_AbsolutePage: begin
    if (pe>0) and Str2Int(sv,iv) then AbsolutePage:=iv;
    Result:=IntToStr(AbsolutePage);
   end;
   sid_AbsolutePosition: begin
    if (pe>0) and Str2Int(sv,iv) then AbsolutePosition:=iv;
    Result:=IntToStr(AbsolutePosition);
   end;
   sid_Bookmark: begin
    if (pe>0) and Str2Int(sv,iv) then Bookmark:=iv;
    Result:=IntToStr(Bookmark);
   end;
   sid_CacheSize: begin
    if (pe>0) and Str2Int(sv,iv) then CacheSize:=iv;
    Result:=IntToStr(CacheSize);
   end;
   sid_CursorType: begin
    if (pe>0) and Str2Int(sv,iv) then CursorType:=iv;
    Result:=IntToStr(CursorType);
   end;
   sid_Mode: begin
    if (pe>0) and Str2Int(sv,iv) then Mode:=iv;
    Result:=IntToStr(Mode);
   end;
   sid_EditMode: begin
    Result:=IntToStr(EditMode);
   end;
   sid_Filter: begin
    if (pe>0) then Filter:=SysUtils.Trim(sv);
    Result:=Filter;
   end;
   sid_Index: begin
    if (pe>0) then Index:=SysUtils.Trim(sv);
    Result:=Index;
   end;
   sid_LockType: begin
    if (pe>0) and Str2Int(sv,iv) then LockType:=iv;
    Result:=IntToStr(LockType);
   end;
   sid_MarshalOptions: begin
    if (pe>0) and Str2Int(sv,iv) then MarshalOptions:=iv;
    Result:=IntToStr(MarshalOptions);
   end;
   sid_MaxRecords: begin
    if (pe>0) and Str2Int(sv,iv) then MaxRecords:=iv;
    Result:=IntToStr(MaxRecords);
   end;
   sid_PageCount: begin
    Result:=IntToStr(PageCount);
   end;
   sid_PageSize: begin
    if (pe>0) and Str2Int(sv,iv) then PageSize:=iv;
    Result:=IntToStr(PageSize);
   end;
   sid_RecordCount: begin
    Result:=IntToStr(RecordCount);
   end;
   sid_Sort: begin
    if (pe>0) then Sort:=SysUtils.Trim(sv);
    Result:=Sort;
   end;
   sid_Source: begin
    if (pe>0) then Source:=SysUtils.Trim(sv);
    Result:=Source;
   end;
   sid_StayInSync: begin
    if (pe>0) and Str2Int(sv,iv) then StayInSync:=(iv<>0);
    Result:=IntToStr(Ord(StayInSync));
   end;
   sid_GetString: begin
    if (pe>0) then begin
     if Str2Int(ExtractWord(1,sv,ScanSpaces),iv) then iv:=max(1,iv) else iv:=1;
     sc:=Backslash_Decode(ExtractWord(2,sv,ScanSpaces)); if (sc='') then sc:=ASCII_HT;
     sr:=Backslash_Decode(ExtractWord(3,sv,ScanSpaces)); if (sr='') then sr:=LineEnding;
     sz:=Backslash_Decode(ExtractWord(4,sv,ScanSpaces));
    end else begin
     iv:=1; sc:=ASCII_HT; sr:=LineEnding; sz:='';
    end;
    Result:=GetString(iv,sc,sr,sz);
   end;
   sid_CommandType: begin
    if (pe>0) and Str2Int(sv,iv) then CommandType:=iv;
    Result:=IntToStr(CommandType);
   end;
   sid_CommandText: begin
    if (pe>0) then CommandText:=SysUtils.Trim(sv);
    Result:=CommandText;
   end;
   sid_ConnectionStringInit: begin
    Result:=Root.ConnectionStringInit;
   end;
   sid_ConnectionString: begin
    if (pe>0) then Root.ConnectionString:=SysUtils.Trim(sv);
    Result:=Root.ConnectionString;
   end;
   sid_ConnectionTimeout: begin
    if (pe>0) and Str2Int(sv,iv) then Root.ConnectionTimeout:=iv;
    Result:=IntToStr(Root.ConnectionTimeout);
   end;
   sid_CommandTimeout: begin
    if (pe>0) and Str2Int(sv,iv) then Root.CommandTimeout:=iv;
    Result:=IntToStr(Root.CommandTimeout);
   end;
   sid_IsolationLevel: begin
    if (pe>0) and Str2Int(sv,iv) then Root.IsolationLevel:=iv;
    Result:=IntToStr(Root.IsolationLevel);
   end;
   sid_ProviderNames: begin
    Result:=OleDbProviderNames.Text;
   end;
   sid_RecordsAffected: begin
    Result:=IntToStr(Root.RecordsAffected);
   end;
   sid_BugsCount: begin
    Result:=IntToStr(Root.BugsCount);
   end;
   sid_BugsClear: begin
    Result:=IntToStr(Root.BugsClear);
   end;
   sid_TotalBugsCount: begin
    Result:=IntToStr(Root.TotalBugsCount);
   end;
   sid_TotalBugsClear: begin
    Result:=IntToStr(Root.TotalBugsClear);
   end;
   sid_BugReportPrefix: begin
    if (pe>0) then myBgPref:=sv;
    Result:=myBgPref;
   end;
   sid_BugReportPrefixAll: begin
    if (pe>0) then db_bugreport_prefix:=sv;
    Result:=db_bugreport_prefix;
   end;
   sid_TimeStampInit: if Root.Ok then begin
    Result:=FloatToStr(Root.TimeStampInit);
   end;
   sid_TimeStampOpen: if Root.Ok then begin
    Result:=FloatToStr(Root.TimeStampOpen);
   end;
   sid_TimeStampUser1: if Root.Ok then begin
    if (pe>0) and Str2Real(sv,rv) then Root.TimeStampUser1:=rv;
    Result:=FloatToStr(Root.TimeStampUser1);
   end;
   sid_TimeStampUser2: if Root.Ok then begin
    if (pe>0) and Str2Real(sv,rv) then Root.TimeStampUser2:=rv;
    Result:=FloatToStr(Root.TimeStampUser2);
   end;
   sid_TimeStampUser3: if Root.Ok then begin
    if (pe>0) and Str2Real(sv,rv) then Root.TimeStampUser3:=rv;
    Result:=FloatToStr(Root.TimeStampUser3);
   end;
   sid_UserState: if Root.Ok then begin
    if (pe>0) and Str2Int(sv,iv) then Root.UserState:=iv;
    Result:=IntToStr(Root.UserState);
   end;
   sid_UserFlags: if Root.Ok then begin
    if (pe>0) and Str2Int(sv,iv) then Root.UserFlags:=iv;
    Result:=IntToStr(Root.UserFlags);
   end;
   sid_UserLink: if Root.Ok then begin
    if (pe>0) and Str2Int(sv,iv) then Root.UserLink:=iv;
    Result:=IntToStr(Root.UserLink);
   end;
   sid_UserData: if Root.Ok then begin
    if (pe>0) then Root.UserData:=sv;
    Result:=Root.UserData;
   end;
   sid_Cookies: if Root.Ok then begin
    if (pe>0) then Root.Cookies:=sv;
    Result:=Root.Cookies;
   end;
   sid_Asterisk: begin
    if (Dictionary<>nil) then
    for i:=0 to Dictionary.Count-1 do begin
     si:=Dictionary.Links[i];
     if (si<=Ord(sid_Unknown)) then continue;
     if (si>=Ord(sid_Asterisk)) then continue;
     if not (TStringIdentifier(si) in sid_Control_Readable) then continue;
     if (pe>0) and not (TStringIdentifier(si) in sid_Control_Writable) then continue;
     Result:=Result+Dictionary.Keys[i]+LineEnding;
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'Control');
 end;
end;

function TDbEntity.Execute(const arg:String; opt:Integer):TDbRecordset;
begin
 if (Self<>nil)
 then Result:=DoExecute(arg,opt)
 else Result:=nil;
end;

function TDbEntity.DoExecute(const arg:String; opt:Integer):TDbRecordset;
begin
 Result:=nil;
end;

const
 TheTotalBugsCount : Integer = 0;

class function TDbEntity.TotalBugsCount:Integer;
begin
 Result:=LockedAdd(TheTotalBugsCount,0);
end;

class function TDbEntity.TotalBugsClear:Integer;
begin
 Result:=LockedExchange(TheTotalBugsCount,0);
end;

class function TDbEntity.IncTotalBugsCount:Integer;
begin
 Result:=LockedInc(TheTotalBugsCount);
end;

///////////////////////////
// TDbParent implementation
///////////////////////////

constructor TDbParent.Create(aParent:TDbParent);
begin
 inherited Create(aParent);
 myTypeId:=db_type_parent;
 myChilds:=TList.Create;
end;

destructor TDbParent.Destroy;
begin
 Kill(myChilds);
 inherited Destroy;
end;

procedure TDbParent.AppendChild(aChild:TDbEntity);
begin
 if Assigned(Self) then DoAppendChild(aChild);
end;

procedure TDbParent.DoAppendChild(aChild:TDbEntity);
begin
 if (aChild=nil) then Exit;
 SafeListAdd(myChilds,aChild);
end;

procedure TDbParent.RemoveChild(aChild:TDbEntity);
begin
 if Assigned(Self) then DoRemoveChild(aChild);
end;

procedure TDbParent.DoRemoveChild(aChild:TDbEntity);
begin
 if (aChild=nil) then Exit;
 SafeListRemove(myChilds,aChild);
end;

function TDbParent.DoGetChildCount:Integer;
begin
 Result:=SafeListCount(myChilds);
end;

function TDbParent.DoGetChildItems(i:Integer):TDbEntity;
begin
 Result:=SafeListItems(myChilds,i);
end;

///////////////////////////////
// TDbConnection implementation
///////////////////////////////

constructor TDbConnection.Create(eid:Integer=0; const arg:String='');
begin
 inherited Create(nil);
 myTypeId:=db_type_connection;
 myConStrng:=SysUtils.Trim(arg);
 myEngineId:=0;
 myAdoConn:=nil;
 myBugsCount:=0;
 myRecordsAffected:=0;
 myTimeStampInit:=0;
 myTimeStampOpen:=0;
 myTimeStampUser1:=0;
 myTimeStampUser2:=0;
 myTimeStampUser3:=0;
 myUserState:=0;
 myUserFlags:=0;
 myUserLink:=0;
 myUserData:='';
 myCookies:='';
 SetEngineId(eid);
end;

destructor TDbConnection.Destroy;
begin
 myConStrng:='';
 myAdoConn:=nil;
 myUserData:='';
 myCookies:='';
 inherited;
end;

procedure TDbConnection.SetEngineId(eid:Integer);
 procedure ExtractParam(sn,id:String);
 var sv:String;
 begin
  id:=SysUtils.Trim(id);
  sn:=SysUtils.Trim(sn);
  sv:=CookieScan(myConStrng,id,Ord(';'));
  if (id<>'') and (sn<>'') and (sv<>'')
  then Control(sn+'='+sv);
 end;
begin
 if (Self=nil) then Exit;
 if (eid=0) then eid:=db_engine_default;
 try
  case eid of
   db_engine_ado: begin
    myAdoConn:=CoConnection.Create;
    if (myConStrng<>'') then begin
     ExtractParam('Provider','Provider');
     myAdoConn.ConnectionString:=myConStrng;
    end;
    myEngineId:=eid;
    myTimeStampInit:=msecnow;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetEngineId');
 end;
end;

function TDbConnection.GetEngineId:Integer;
begin
 if (Self=nil)
 then Result:=0
 else Result:=myEngineId;
end;

function TDbConnection.GetConnectionStringInit:String;
begin
 if (Self=nil)
 then Result:=''
 else Result:=myConStrng;
end;

function TDbConnection.GetTimeStampInit:Double;
begin
 if (Self=nil)
 then Result:=0
 else Result:=myTimeStampInit;
end;

function TDbConnection.GetTimeStampOpen:Double;
begin
 if (Self=nil)
 then Result:=0
 else Result:=myTimeStampOpen;
end;

function TDbConnection.GetTimeStampUser1:Double;
begin
 if (Self=nil)
 then Result:=0
 else Result:=myTimeStampUser1;
end;

procedure TDbConnection.SetTimeStampUser1(arg:Double);
begin
 if (Self=nil) then Exit;
 myTimeStampUser1:=arg;
end;

function TDbConnection.GetTimeStampUser2:Double;
begin
 if (Self=nil)
 then Result:=0
 else Result:=myTimeStampUser2;
end;

procedure TDbConnection.SetTimeStampUser2(arg:Double);
begin
 if (Self=nil) then Exit;
 myTimeStampUser2:=arg;
end;

function TDbConnection.GetTimeStampUser3:Double;
begin
 if (Self=nil)
 then Result:=0
 else Result:=myTimeStampUser3;
end;

procedure TDbConnection.SetTimeStampUser3(arg:Double);
begin
 if (Self=nil) then Exit;
 myTimeStampUser3:=arg;
end;

function TDbConnection.GetUserState:Integer;
begin
 if (Self=nil)
 then Result:=0
 else Result:=myUserState;
end;

procedure TDbConnection.SetUserState(arg:Integer);
begin
 if (Self=nil) then Exit;
 myUserState:=arg;
end;

function TDbConnection.GetUserFlags:Integer;
begin
 if (Self=nil)
 then Result:=0
 else Result:=myUserFlags;
end;

procedure TDbConnection.SetUserFlags(arg:Integer);
begin
 if (Self=nil) then Exit;
 myUserFlags:=arg;
end;

function TDbConnection.GetUserLink:Integer;
begin
 if (Self=nil)
 then Result:=0
 else Result:=myUserLink;
end;

procedure TDbConnection.SetUserLink(arg:Integer);
begin
 if (Self=nil) then Exit;
 myUserLink:=arg;
end;

function TDbConnection.GetUserData:String;
begin
 if (Self=nil)
 then Result:=''
 else Result:=myUserData;
end;

procedure TDbConnection.SetUserData(arg:String);
begin
 if (Self=nil) then Exit;
 myUserData:=arg;
end;

function TDbConnection.GetCookies:String;
begin
 if (Self=nil)
 then Result:=''
 else Result:=myCookies;
end;

procedure TDbConnection.SetCookies(arg:String);
begin
 if (Self=nil) then Exit;
 myCookies:=arg;
end;

function TDbConnection.GetDriver:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 try
  Result:=SysUtils.Trim(CookieScan(ConnectionStringInit,'Driver',Ord(';')));
 except
  on E:Exception do BugReport(E,Self,'GetDriver');
 end;
end;


function TDbConnection.GetProvider:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.Provider;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetProvider');
 end;
end;

procedure TDbConnection.SetProvider(const arg:String);
begin
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    myAdoConn.Provider:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetProvider');
 end;
end;

function TDbConnection.GetConnectionString:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.ConnectionString;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetConnectionString');
 end;
end;

procedure TDbConnection.SetConnectionString(const arg:String);
begin
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    myAdoConn.ConnectionString:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetConnectionString');
 end;
end;

function TDbConnection.GetConnectionTimeout:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.ConnectionTimeout;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetConnectionTimeout');
 end;
end;

procedure TDbConnection.SetConnectionTimeout(arg:Integer);
begin
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    myAdoConn.ConnectionTimeout:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetConnectionTimeout');
 end;
end;

function TDbConnection.GetCommandTimeout:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.CommandTimeout;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetCommandTimeout');
 end;
end;

procedure TDbConnection.SetCommandTimeout(arg:Integer);
begin
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    myAdoConn.CommandTimeout:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetCommandTimeout');
 end;
end;

function TDbConnection.GetIsolationLevel:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.IsolationLevel;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetIsolationLevel');
 end;
end;

procedure TDbConnection.SetIsolationLevel(arg:Integer);
begin
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    myAdoConn.IsolationLevel:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetIsolationLevel');
 end;
end;

function TDbConnection.GetDefaultDatabase:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.DefaultDatabase;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetDefaultDatabase');
 end;
end;

procedure TDbConnection.SetDefaultDatabase(const arg:String);
begin
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    myAdoConn.DefaultDatabase:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetDefaultDatabase');
 end;
end;

function TDbConnection.DoGetState:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.State;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoGetState');
 end;
end;

function TDbConnection.DoClose:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    myAdoConn.Close;
    myTimeStampOpen:=0;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoGetClose');
 end;
end;

function TDbConnection.DoCancel:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    myAdoConn.Cancel;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoGetCancel');
 end;
end;

function TDbConnection.GetVersion:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.Version;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoGetVersion');
 end;
end;

function TDbConnection.GetErrors:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=FormatAdoErrors(myAdoConn.Errors);
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetErrors');
 end;
end;

function TDbConnection.GetErrorsCount:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.Errors.Count;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetErrorsCount');
 end;
end;

function TDbConnection.GetErrorsClear:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.Errors.Count;
    myAdoConn.Errors.Clear;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetErrorsClear');
 end;
end;

function TDbConnection.DoGetProperties:String;
begin
 Result:='';
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=FormatAdoProperties(myAdoConn.Properties);
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoGetProperties');
 end;
end;

procedure TDbConnection.DoSetProperties(const arg:String);
begin
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    AssignAdoProperties(myAdoConn.Properties,arg);
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoSetProperties');
 end;
end;

function TDbConnection.DoGetMode:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.Mode;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoGetMode');
 end;
end;

procedure TDbConnection.DoSetMode(arg:Integer);
begin
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    myAdoConn.Mode:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoSetMode');
 end;
end;

function TDbConnection.DoGetCursorLocation:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.CursorLocation;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoGetCursorLocation');
 end;
end;

procedure TDbConnection.DoSetCursorLocation(arg:Integer);
begin
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    myAdoConn.CursorLocation:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoSetCursorLocation');
 end;
end;

function TDbConnection.DoGetAttributes:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.Attributes;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoGetAttributes');
 end;
end;

procedure TDbConnection.DoSetAttributes(arg:Integer);
begin
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    myAdoConn.Attributes:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoSetAttributes');
 end;
end;

function TDbConnection.DoOpen(opt:Integer):Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    myAdoConn.Open('','','',opt);
    myTimeStampOpen:=msecnow;
    myRecordsAffected:=0;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoOpen');
 end;
end;

function TDbConnection.DoExecute(const arg:String; opt:Integer):TDbRecordset;
var ra:OleVariant;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 try
  case EngineId of
   db_engine_ado: begin
    ra:=Unassigned;
    Result:=TDbRecordset.Create(Self,myAdoConn.Execute(arg,ra,opt));
    myRecordsAffected:=ra;
    ra:=Unassigned;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoExecute');
 end;
end;

function TDbConnection.BeginTrans:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=myAdoConn.BeginTrans;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'BeginTrans');
 end;
end;

function TDbConnection.CommitTrans:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    myAdoConn.CommitTrans;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'CommitTrans');
 end;
end;

function TDbConnection.RollbackTrans:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    myAdoConn.RollbackTrans;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'RollbackTrans');
 end;
end;

function TDbConnection.GetRecordsAffected:Integer;
begin
 if (Self<>nil)
 then Result:=myRecordsAffected
 else Result:=0;
end;

function TDbConnection.CreateRecordset(arg:String):TDbRecordset;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 try
  arg:=SysUtils.Trim(arg);
  Result:=TDbRecordset.Create(Self,CoRecordset.Create);
  if (arg<>'') then Result.Source:=arg;
 except
  on E:Exception do BugReport(E,Self,'CreateRecordset');
 end;
end;

function TDbConnection.CreateCommand(arg:String):TDbCommand;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 try
  arg:=SysUtils.Trim(arg);
  Result:=TDbCommand.Create(Self,CoCommand.Create);
  if (arg<>'') then Result.CommandText:=arg;
 except
  on E:Exception do BugReport(E,Self,'CreateCommand');
 end;
end;
 
function TDbConnection.GetBugsCount:Integer;
begin
 if (Self<>nil)
 then Result:=LockedAdd(myBugsCount,0)
 else Result:=0;
end;

function TDbConnection.GetBugsClear:Integer;
begin
 if (Self<>nil)
 then Result:=LockedExchange(myBugsCount,0)
 else Result:=0;
end;

procedure TDbConnection.IncBugsCount;
begin
 if (Self=nil) then Exit;
 LockedInc(myBugsCount);
end;

////////////////////////////////
// TDbConnection helper routines
////////////////////////////////

function NewDbConnection(eid:Integer=0; const arg:String=''):TDbConnection;
begin
 Result:=nil;
 try
  Result:=TDbConnection.Create(eid,arg);
  if (Result.EngineId=0) then Kill(Result);
 except
  on E:Exception do BugReport(E,nil,'NewDbConnection');
 end;
end;

procedure Kill(var TheObject:TDbConnection); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

//////////////////////////////
// TDbRecordset implementation
//////////////////////////////

constructor TDbRecordset.Create(aParent:TDbParent; const aRecordset:Recordset);
begin
 inherited Create(aParent);
 myTypeId:=db_type_recordset;
 myAdoRecs:=aRecordset;
end;

destructor TDbRecordset.Destroy;
begin
 myAdoRecs:=nil;
 inherited Destroy;
end;

function TDbRecordset.DoBindRoot:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    if VarIsEmpty(myAdoRecs.Get_ActiveConnection) then begin
     if (Root.State in [adStateOpen]) then begin
      myAdoRecs.Set_ActiveConnection(Root.myAdoConn);
      Result:=true;
     end else
     if (Root.State in [adStateClosed]) then begin
      myAdoRecs._Set_ActiveConnection(Root.ConnectionStringInit);
      Result:=true;
     end;
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoBindRoot');
 end;
end;

function TDbRecordSet.DoGetState:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=myAdoRecs.State;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoGetState');
 end;
end;

function TDbRecordset.DoClose:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    myAdoRecs.Close;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoClose');
 end;
end;

function TDbRecordset.DoCancel:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    myAdoRecs.Cancel;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoCancel');
 end;
end;

function TDbRecordset.DoGetCursorLocation:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=myAdoRecs.CursorLocation;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoGetCursorLocation');
 end;
end;

procedure TDbRecordset.DoSetCursorLocation(arg:Integer);
begin
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    myAdoRecs.CursorLocation:=arg;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoSetCursorLocation');
 end;
end;

function TDbRecordset.DoOpen(opt:Integer):Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    if (Root.State in [adStateClosed])
    then myAdoRecs.Open(Source,Root.ConnectionStringInit,CursorType,LockType,opt)
    else myAdoRecs.Open(Source,Root.myAdoConn,CursorType,LockType,opt);
    Root.myRecordsAffected:=0;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoOpen');
 end;
end;

///////////////////////////////
// TDbRecordset helper routines
///////////////////////////////

procedure Kill(var TheObject:TDbRecordset); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

////////////////////////////
// TDbCommand implementation
////////////////////////////

constructor TDbCommand.Create(aParent:TDbParent; const aCommand:Command);
begin
 inherited Create(aParent);
 myTypeId:=db_type_command;
 myParams:=EmptyParam;
 myAdoComm:=aCommand;
end;

destructor TDbCommand.Destroy;
begin
 myAdoComm:=nil;
 myParams:=Unassigned;
 inherited Destroy;
end;

function TDbCommand.DoBindRoot:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    if VarIsEmpty(myAdoComm.Get_ActiveConnection) then begin
     if (Root.State in [adStateOpen]) then begin
      myAdoComm.Set_ActiveConnection(Root.myAdoConn);
      Result:=true;
     end else
     if (Root.State in [adStateClosed]) then begin
      myAdoComm._Set_ActiveConnection(Root.ConnectionStringInit);
      Result:=true;
     end;
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoBindRoot');
 end;
end;

function TDbCommand.DoGetState:Integer;
begin
 Result:=0;
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    Result:=myAdoComm.State;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoGetState');
 end;
end;

function TDbCommand.DoCancel:Boolean;
begin
 Result:=false;
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    myAdoComm.Cancel;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoGetCancel');
 end;
end;

function TDbCommand.DoExecute(const arg:String; opt:Integer):TDbRecordset;
var ra:OleVariant;
begin
 Result:=nil;
 if (Self=nil) then Exit;
 try
  case Root.EngineId of
   db_engine_ado: begin
    ra:=Unassigned;
    if db_bindroot_onexecute then BindRoot;
    if (arg<>'') then myAdoComm.CommandText:=arg;
    Result:=TDbRecordset.Create(Root,myAdoComm.Execute(ra,myParams,opt));
    Root.myRecordsAffected:=ra;
    ra:=Unassigned;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'DoExecute');
 end;
end;

/////////////////////////////
// TDbCommand helper routines
/////////////////////////////

procedure Kill(var TheObject:TDbCommand); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

////////////////////////////////////////
// DbApi easy DB interface for DaqPascal
////////////////////////////////////////

function db_create(arg:String):Boolean;
begin
 Result:=CreateDatabaseWithAdoxCatalog(arg);
end;

function db_connection(eid:Integer; arg:String):Integer;
begin
 Result:=0;
 try
  Result:=NewDbConnection(eid,arg).Ref;
 except
  on E:Exception do BugReport(E,nil,'db_connection');
 end;
end;

function db_recordset(dbo:Integer; arg:String):Integer;
var con:TDbConnection;
begin
 Result:=0;
 try
  con:=db_ref(dbo).Root;
  if (con=nil) then Exit;
  Result:=con.CreateRecordset(arg).Ref;
 except
  on E:Exception do BugReport(E,nil,'db_recordset');
 end;
end;

function db_command(dbo:Integer; arg:String):Integer;
var con:TDbConnection;
begin
 Result:=0;
 try
  con:=db_ref(dbo).Root;
  if (con=nil) then Exit;
  Result:=con.CreateCommand(arg).Ref;
 except
  on E:Exception do BugReport(E,nil,'db_command');
 end;
end;

function db_free(dbo:Integer):Boolean;
var obj:TObject;
begin
 Result:=false;
 if (dbo<>0) then
 try
  obj:=db_ref(dbo);
  if (obj is TDbEntity) then begin
   FreeAndNil(obj);
   Result:=true;
  end;
 except
  on E:Exception do BugReport(E,nil,'db_free');
 end;
end;

function db_ref(dbo:Integer):TDbEntity;
var obj:TObject;
begin
 Result:=nil;
 if (dbo=0) then Exit;
 obj:=ObjectRegistry[dbo];
 if (obj is TDbEntity) then Result:=TDbEntity(obj);
end;

function db_root(dbo:Integer):TDbConnection;
begin
 Result:=db_ref(dbo).Root;
end;

function db_type(dbo:Integer):Integer;
begin
 Result:=db_ref(dbo).TypeId;
end;

function db_parent(dbo:Integer):Integer;
begin
 Result:=db_ref(dbo).Parent.Ref;
end;

function db_state(dbo:Integer):Integer;
begin
 Result:=db_ref(dbo).State;
end;

function db_close(dbo:Integer):Boolean;
begin
 Result:=db_ref(dbo).Close;
end;

function db_open(dbo:Integer; opt:Integer):Boolean;
begin
 Result:=db_ref(dbo).Open(opt);
end;

function db_ctrl(dbo:Integer; arg:String):String;
begin
 Result:=db_ref(dbo).Control(arg);
end;

function db_bugscount(dbo:Integer):Integer;
begin
 Result:=db_ref(dbo).Root.BugsCount;
end;

function db_bugsclear(dbo:Integer):Integer;
begin
 Result:=db_ref(dbo).Root.BugsClear;
end;

function db_errors(dbo:Integer):String;
begin
 Result:=db_ref(dbo).Root.Errors;
end;

function db_errorscount(dbo:Integer):Integer;
begin
 Result:=db_ref(dbo).Root.ErrorsCount;
end;

function db_errorsclear(dbo:Integer):Integer;
begin
 Result:=db_ref(dbo).Root.ErrorsClear;
end;

function db_execute(dbo:Integer; arg:String; opt:Integer):TDbRecordset;
begin
 Result:=db_ref(dbo).Execute(arg,opt);
end;

function db_cancel(dbo:Integer):Boolean;
begin
 Result:=db_ref(dbo).Cancel;
end;

function db_update(dbr:Integer):Boolean;
begin
 Result:=db_ref(dbr).Update;
end;

function db_cancelupdate(dbr:Integer):Boolean;
begin
 Result:=db_ref(dbr).CancelUpdate;
end;

function db_begintrans(dbc:Integer):Integer;
begin
 Result:=db_ref(dbc).Root.BeginTrans;
end;

function db_committrans(dbc:Integer):Boolean;
begin
 Result:=db_ref(dbc).Root.CommitTrans;
end;

function db_rollbacktrans(dbc:Integer):Boolean;
begin
 Result:=db_ref(dbc).Root.RollbackTrans;
end;

function db_bof(dbr:Integer):Boolean;
begin
 Result:=db_ref(dbr).Bof;
end;

function db_eof(dbr:Integer):Boolean;
begin
 Result:=db_ref(dbr).Eof;
end;

function db_movefirst(dbr:Integer):Boolean;
begin
 Result:=db_ref(dbr).MoveFirst;
end;

function db_movelast(dbr:Integer):Boolean;
begin
 Result:=db_ref(dbr).MoveLast;
end;

function db_movenext(dbr:Integer):Boolean;
begin
 Result:=db_ref(dbr).MoveNext;
end;

function db_moveprevious(dbr:Integer):Boolean;
begin
 Result:=db_ref(dbr).MovePrevious;
end;

function db_fieldscount(dbr:Integer):Integer;
begin
 Result:=db_ref(dbr).FieldsCount;
end;

function db_fieldsnames(dbr:Integer; i:Integer):String;
begin
 Result:=db_ref(dbr).FieldsNames(i);
end;

function db_fieldstypes(dbr:Integer; id:String):Integer;
begin
 Result:=db_ref(dbr).FieldsTypes(id);
end;

function db_fieldsasint(dbr:Integer; id:String; op:Char; arg:Integer):Integer;
begin
 Result:=db_ref(dbr).FieldsAsInt(id,op,arg);
end;

function db_fieldsasfloat(dbr:Integer; id:String; op:Char; arg:Double):Double;
begin
 Result:=db_ref(dbr).FieldsAsFloat(id,op,arg);
end;

function db_fieldsasstring(dbr:Integer; id:String; op:Char; arg:String):String;
begin
 Result:=db_ref(dbr).FieldsAsString(id,op,arg);
end;

function db_addnew(dbr:Integer; arg:String):Boolean;
begin
 Result:=db_ref(dbr).AddNew(arg);
end;

function db_delete(dbr:Integer; aff:Integer):Boolean;
begin
 Result:=db_ref(dbr).Delete(aff);
end;

function db_requery(dbr:Integer; opt:Integer):Boolean;
begin
 Result:=db_ref(dbr).Requery(opt);
end;

function db_resync(dbr:Integer; aff,res:Integer):Boolean;
begin
 Result:=db_ref(dbr).Resync(aff,res);
end;

function db_supports(dbr:Integer; opt:Integer):Boolean;
begin
 Result:=db_ref(dbr).Supports(opt);
end;

function db_save(dbr:Integer; dst:String; fmt:Integer):Boolean;
begin
 Result:=db_ref(dbr).Save(dst,fmt);
end;

initialization

 InitDictionary;

finalization

 FreeDictionary;
 
 Kill(TheOleDbProviderNames);
 Kill(TheOdbcDriverNames);

end.
