sdengine.pas

SQLDirect Component Library is a light-weight Borland Database Engine replacement for Borland Delphi

{*******************************************************}
{							}
{       Delphi SQLDirect Component Library		}
{       SQLDirect Data Access				}
{                                                       }
{       Copyright (c) 1997,2005 by Yuri Sheino		}
{                                                       }
{*******************************************************}
{$I SqlDir.inc}
unit SDEngine {$IFDEF SD_CLR} platform {$ENDIF};

interface

uses
  Windows, Messages, SysUtils, Consts, Classes, Controls, Forms,
  Db, SyncObjs,
{$IFDEF SD_VCL5}
  DbCommon,
{$ENDIF}
{$IFDEF SD_VCL6}
  Variants, RTLConsts,
{$ENDIF}
{$IFDEF SD_CLR}
  Contnrs, System.Runtime.InteropServices,
{$ENDIF}
  SDConsts, SDCommon;

const
  SDE_ERR_NONE		= 0;
  SDE_ERR_UPDATEABORT	= -1;

  { TSDDataSet flags }

  dsfOpened     = 0;
  dsfPrepared   = 1;
  dsfExecSQL    = 2;
  dsfTable      = 3;
  dsfFieldList  = 4;
  dsfIndexList  = 5;
  dsfStoredProc = 6;
  dsfExecProc	= 7;
  dsfProcDesc   = 8;
  dsfProvider   = 10;

type
  TSDServerType = (stSQLBase, stOracle, stSQLServer, stSybase,
  		   stDB2, stInformix, stODBC, stInterbase, stFirebird,
                   stMySQL, stPostgreSQL, stOLEDB);

  TSDSession 		= class;
  TSDDatabase 		= class;
  TSDDataSet  		= class;
  TSDQuery  		= class;
  
{ ESDNoResultSet }

  ESDNoResultSet = class(EDatabaseError);

{ TSessionList }

  TSDSessionList = class(TObject)
  private
    FSessions: TThreadList;
    FSessionNumbers: TBits;
    procedure AddSession(ASession: TSDSession);
    procedure CloseAll;
    function GetCount: Integer;
    function GetSession(Index: Integer): TSDSession;
    function GetSessionByName(const SessionName: string): TSDSession;
  public
    constructor Create;
    destructor Destroy; override;
    function FindDatabase(const DatabaseName: string): TSDDatabase;
    function FindSession(const SessionName: string): TSDSession;
    procedure GetSessionNames(List: TStrings);
    function OpenSession(const SessionName: string): TSDSession;
    property Count: Integer read GetCount;
    property List[const SessionName: string]: TSDSession read GetSessionByName;
    property Sessions[Index: Integer]: TSDSession read GetSession; default;
  end;

{ TSDSession }

  TSDSession = class(TComponent)
  private
    FDatabases: TList;				// active or inactive database components, which have an associated SessionName
    FDefault: Boolean;
    FKeepConnections: Boolean;			// for temporary database objects in run-time
    FDBParams: TList;				// remote database parameters could be used, for example, for TSDDatabase with an empty Params property 
    FAutoSessionName: Boolean;
    FUpdatingAutoSessionName: Boolean;
    FSessionName: string;
    FSessionNumber: Integer;
    FLockCount: Integer;

    FActive: Boolean;
    FStreamedActive: Boolean;
    FSQLHourGlass: Boolean;
    FSQLWaitCursor: TCursor;
    procedure AddDatabase(Value: TSDDatabase);
    procedure CheckInactive;
    procedure ClearDBParams;
    function DoFindDatabase(const DatabaseName: string; AOwner: TComponent): TSDDatabase;
    function DoOpenDatabase(const DatabaseName: string; AOwner: TComponent): TSDDatabase;
    function GetActive: Boolean;
    function GetDatabase(Index: Integer): TSDDatabase;
    function GetDatabaseCount: Integer;
    procedure LockSession;
    procedure MakeCurrent;
    procedure RemoveDatabase(Value: TSDDatabase);
    function SessionNameStored: Boolean;
    procedure SetActive(Value: Boolean);
    procedure SetAutoSessionName(Value: Boolean);
    procedure SetSessionName(const Value: string);
    procedure SetSessionNames;
    procedure StartSession(Value: Boolean);
    procedure UnlockSession;
    procedure InternalAddDatabase(const ARemoteDatabase: string; AServerType: TSDServerType; List: TStrings);
    procedure UpdateAutoSessionName;
    procedure ValidateAutoSession(AOwner: TComponent; AllSessions: Boolean);
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetName(const NewName: TComponentName); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Close;
    procedure CloseDatabase(Database: TSDDatabase);
    function FindDatabase(const DatabaseName: string): TSDDatabase;
    procedure GetDatabaseNames(List: TStrings);
    procedure GetDatabaseParams(const ARemoteDatabase: string; AServerType: TSDServerType; List: TStrings);
    procedure GetStoredProcNames(const DatabaseName: string; List: TStrings);
    procedure GetFieldNames(const DatabaseName, TableName: string; List: TStrings);
    procedure GetTableNames(const DatabaseName, Pattern: string; SystemTables: Boolean; List: TStrings);
    procedure Open;
    function OpenDatabase(const DatabaseName: string): TSDDatabase;
    property DatabaseCount: Integer read GetDatabaseCount;
    property Databases[Index: Integer]: TSDDatabase read GetDatabase;
    property SQLWaitCursor: TCursor read FSQLWaitCursor write FSQLWaitCursor;
  published
    property Active: Boolean read GetActive write SetActive default False;
    property AutoSessionName: Boolean read FAutoSessionName write SetAutoSessionName default False;
    property KeepConnections: Boolean read FKeepConnections write FKeepConnections default True;
    property SessionName: string read FSessionName write SetSessionName stored SessionNameStored;
    property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default True;
  end;

{ TSDDatabase }

  TSDTransIsolation = (tiDirtyRead, tiReadCommitted, tiRepeatableRead);

  TSDDesignDBOption=(ddoIsDefaultDatabase, ddoStoreConnected{, ddoStorePassword});
  TSDDesignDBOptions = set of TSDDesignDBOption;

  TSDLoginEvent = procedure(Database: TSDDatabase; LoginParams: TStrings) of object;

{ TSDCustomDatabase }
{$IFNDEF SD_VCL5}
  TConnectChangeEvent = procedure(Sender: TObject; Connecting: Boolean) of object;
  
  TSDCustomDatabase = class(TComponent)
  private
    FDataSets: TList;
    FStreamedConnected: Boolean;	// Connected value while it's reading from stream
    FAfterConnect: TNotifyEvent;
    FAfterDisconnect: TNotifyEvent;
    FBeforeConnect: TNotifyEvent;
    FBeforeDisconnect: TNotifyEvent;
  protected
    FLoginPrompt: Boolean;  
    procedure DoConnect; virtual;
    procedure DoDisconnect; virtual;
    function GetConnected: Boolean; virtual;
    function GetDataSet(Index: Integer): TDataSet; virtual;
    function GetDataSetCount: Integer; virtual;
    procedure Loaded; override;
    procedure RegisterClient(Client: TObject; Event: TConnectChangeEvent = nil); virtual;
    procedure SetConnected(Value: Boolean); virtual;
    property StreamedConnected: Boolean read FStreamedConnected write FStreamedConnected;
    procedure UnRegisterClient(Client: TObject); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open; virtual;
    procedure Close;
    property Connected: Boolean read GetConnected write SetConnected default False;
    property DataSets[Index: Integer]: TDataSet read GetDataSet;
    property DataSetCount: Integer read GetDataSetCount;
    property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt default False;
    property AfterConnect: TNotifyEvent read FAfterConnect write FAfterConnect;
    property BeforeConnect: TNotifyEvent read FBeforeConnect write FBeforeConnect;
    property AfterDisconnect: TNotifyEvent read FAfterDisconnect write FAfterDisconnect;
    property BeforeDisconnect: TNotifyEvent read FBeforeDisconnect write FBeforeDisconnect;
  end;
{$ELSE}
  TSDCustomDatabase = class(TCustomConnection);
{$ENDIF}

  TSDThreadTimer = class(TThread)
  private
    FDatabase: TSDDatabase;
    FInterval: Integer;
    FOnTimer: TNotifyEvent;
    procedure SetInterval(Value: Integer);
    procedure SetOnTimer(Value: TNotifyEvent);
  protected
    procedure Timer; dynamic;
    procedure Execute; override;
  public
    constructor Create(ADatabase: TSDDatabase; CreateSuspended: Boolean);
    destructor Destroy; override;
    property Interval: Integer read FInterval write SetInterval default 1000;
    property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
  end;

  TSDDatabase = class(TSDCustomDatabase)
  private
    FTransIsolation: TSDTransIsolation;
    FKeepConnection: Boolean;
    FTemporary: Boolean;
    FAcquiredHandle: Boolean;
    FParams: TStrings;
    FRefCount: Integer;			// dataset's reference count(connected dataset) to the current database
    FSession: TSDSession;
    FSessionName: string;
    FDatabaseName: string;

    FRemoteDatabase: string;          	// real database name on server
    FServerType: TSDServerType;		// server type
    FSqlDatabase: TISqlDatabase;
    FDesignOptions: TSDDesignDBOptions;

    FIdleTimeOut: Integer;
    FTimer: TSDThreadTimer;		// to process disconnecting when idle time has been elapsed
    FIdleTimeoutStarted: Boolean;
    FIsConnectionBusy: Boolean;		// True, in case of server long-running process (for example: a complex SQL statement is executed)

    FClientVersion: LongInt;		// client version as MajorVer.MinorVer (-1 and 0 - unloaded and undefined)
    FServerVersion: LongInt;		// server version as MajorVer.MinorVer
    FVersion: string;			// server info with full version and name

    FOnLogin: TSDLoginEvent;
    procedure CheckActive;
    procedure CheckInactive;
    procedure CheckInTransaction;
    procedure CheckNotInTransaction;
    procedure CheckDatabaseName;
    procedure CheckRemoteDatabase(var Password: string);
    procedure CheckSessionName(Required: Boolean);
    function ConnectedStored: Boolean;
    function GetHandle: PSDCursor;
    function GetIdleTimeOut: Integer;
    function GetIsSQLBased: Boolean;
    function GetInTransaction: Boolean;
    function GetVersion: string;
    function GetServerMajor: Word;
    function GetServerMinor: Word;
    function GetClientMajor: Word;
    function GetClientMinor: Word;
    procedure IdleTimerHandler(Sender: TObject);
    procedure Login(LoginParams: TStrings);
    procedure BusyStateReset(Sender: TObject);
    procedure IdleTimeOutReset(Sender: TObject);
    procedure ResetServerInfo;
    procedure SetDatabaseName(const Value: string);
    procedure SetDesignOptions(Value: TSDDesignDBOptions);    
    procedure SetHandle(Value: PSDCursor);
    procedure SetIdleTimeOut(Value: Integer);
    procedure SetKeepConnection(Value: Boolean);
    procedure SetParams(Value: TStrings);
    procedure SetRemoteDatabase(const Value: string);
    procedure SetServerType(Value: TSDServerType);
    procedure SetSessionName(const Value: string);
    procedure SetTransIsolation(Value: TSDTransIsolation);
    procedure UpdateTimer(NewTimeout: Integer);
  protected
    property SqlDatabase: TISqlDatabase read FSqlDatabase;
    property AcquiredHandle: Boolean read FAcquiredHandle;
    procedure InitSqlDatabase(const ADatabaseName, AUserName, APassword: string; AHandle: PSDCursor);
    procedure DoneSqlDatabase;
    procedure InternalClose(Force: Boolean);
  	// call server API
    procedure ISqlGetStoredProcNames(List: TStrings);
    procedure ISqlGetTableNames(Pattern: string; SystemTables: Boolean; List: TStrings);
    procedure ISqlGetFieldNames(const TableName: string; List: TStrings);
    function ISqlParamValue(Value: TSDDatabaseParam): Integer;
  protected
    procedure DoConnect; override;
    procedure DoDisconnect; override;
    function GetConnected: Boolean; override;
    function GetDataSet(Index: Integer): TDataSet; override;
    function GetSDDataSet(Index: Integer): TSDDataSet; virtual;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure RegisterClient(Client: TObject; Event: TConnectChangeEvent = nil); override;
    procedure UnRegisterClient(Client: TObject); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ApplyUpdates(const DataSets: array of TSDDataSet);
    procedure CloseDataSets;
    procedure Commit;
    procedure ForceClose;
    procedure GetFieldNames(const TableName: string; List: TStrings);
    procedure GetTableNames(const Pattern: string; SystemTables: Boolean; List: TStrings);
//    procedure GetProcNames(List: TStrings);
    function GetSchemaInfo(ASchemaType: TSDSchemaType; AObjectName: string): TDataSet;
    procedure Rollback;
    procedure StartTransaction;
    function TestConnected: Boolean;
    procedure ValidateName(const Name: string);
    property DataSets[Index: Integer]: TSDDataSet read GetSDDataSet;
    property Handle: PSDCursor read GetHandle write SetHandle;
    property InTransaction: Boolean read GetInTransaction;
    property IsSQLBased: Boolean read GetIsSQLBased;
    property Session: TSDSession read FSession;
    property Temporary: Boolean read FTemporary write FTemporary;
    property ClientMajor: Word read GetClientMajor;
    property ClientMinor: Word read GetClientMinor;
    property ServerMajor: Word read GetServerMajor;
    property ServerMinor: Word read GetServerMinor;
    property Version: string read GetVersion;
  published
{$IFDEF SD_VCL5}
    property Connected stored ConnectedStored;
    property LoginPrompt default True;
{$ELSE}
    property Connected: Boolean read GetConnected write SetConnected stored ConnectedStored;
    property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt default True;