(*****************************************************************************)
(* MODULE: SQLDBASE                                                          *)
(* RIGHTS: Reggatta Systems - COPYRIGHT 1995 - 2000                          *)
(* DESCR.: This module contains the Scalable SQL Database Classes            *)
(*****************************************************************************)
Unit SQLDbase;
{$I BSE.INC}
{$I BAPI.INC}
{..$DEFINE USE_NAMED_DATABASES}
Interface
Uses
  Windows,
  Bde,

  BseColl,


  BtrTypes,
  BtrDbase;

Type
  TBtrSqlDatabase =
  Class( TBtrDatabase )
    Private
      FStatements   : TTitanCollection;
      FSessionID    : SmallInt;
      FEngineLoaded : Boolean;
      FIsBtrTrans   : Boolean;
    Public
      Function GetObjType : PChar; Override;

      Constructor Create( P : TObject; Container : TTitanCollection; Desc : pDbDesc;
                    OMode : DBIOpenMode; SMode : DBIShareMode; PPass : PChar;
                    iOptFlds : Word; pOptFldDesc : pFLDDesc; pOptParams : Pointer
                  );
        Override;

      Destructor  Destroy; Override;

      Procedure   SetSessionID;
      Procedure   ProcessOptionalParam( Name, Value : PChar ); Override;
(*
      Function    IsSqlBased : Boolean; Override;
*)
      Function    IsNamedDatabase : Boolean;
      Procedure   TestForSQLEngine;

      Procedure   Login; Override;

      Procedure   LogOut; Override;

      Procedure   OpenTableList (                           { Open a cursor on "Tables" }
                    bExtended     : Bool;                   { True for extended info }
                    bSystem       : Bool;                   { True to include system tables }
                    pszWild       : PChar;                  { Wild card name }
                    var   hCur    : hDBICur                 { Returned cursor }
                  ); Override;

      Procedure   BeginTran (                               { Begin a transaction }
                    eXIL          : eXILType;               { Transaction isolation level }
                    var hXact     : hDBIXact                { Returned Xact handle }
                  ); Override;

      Procedure   EndTran (                                 { End a transaction }
                    hXact         : hDBIXact;               { Xact handle }
                    eEnd          : eXEnd                   { Xact end type }
                  ); Override;

      Procedure   QAlloc (                                  { Allocates a statement handle }
                    eQryLang      : DBIQryLang;             { Query language }
                    var hStmt     : hDBIStmt                { Returned statment handle }
                  ); Override;

      Procedure   QPrepareExt (                             { Prepare a query }
                    eQryLang      : DBIQryLang;             { Query language }
                    pszQuery      : PChar;                  { Query }
                    propBits      : Word;                   { properties for Prepare, e.g. qprepFORUPDATE }
                    var hStmt     : hDBIStmt                { Returned statment handle }
                  ); Override;

      Procedure   QPrepareProc (                            { Prepare a stored procedure }
                    pszProc       : PChar;                  { Stored procedure name }
                    uParamDescs   : Word;                   { Number of parameter descriptors }
                    paParamDescs  : pSPParamDesc;           { Array of parameter descriptors }
                    pRecBuff      : Pointer;                { Record buffer }
                    var hStmt     : hDBIStmt                { Returned statment handle }
                  ); Override;

      Procedure   OpenSPList (                              { Open a cursor on "Stored Procedures" }
                    bExtended     : Bool;                   { True for extended info (N/A) }
                    bSystem       : Bool;                   { True to include system procedures }
                    pszQual       : PChar;                  { Qualifier (N/A) }
                    var hCur      : hDBICur                 { Returned cursor }
                  ); Override;

  end;

  TBtrSqlDatabaseClass = Class of TBtrSqlDatabase;


Implementation
Uses
  SysUtils,

  BseStmt,
  BseTypes,
  BseConst,
  BseUtils,
  BseErrs,
  BseTable,
  BseSess,
  BseRgtry,

  BtrErrs,
  BtrConst,

  SqlApi,
  SqlErrs,
  SqlTable,
  SqlSess;

{$I BTRIEVE.INC}

Const
  BAPI_USER_NAME = 'User';
  BAPI_PASSWORD  = 'Password';



Constructor TBtrSqlDatabase.Create( P : TObject; Container : TTitanCollection; Desc : pDbDesc;
              OMode : DBIOpenMode; SMode : DBIShareMode; PPass : PChar;
              iOptFlds : Word; pOptFldDesc : pFLDDesc; pOptParams : Pointer
            );
var
  tmp      : ShortString;
  BapiInfo : TRightsRegistry;

  Function GetOption( Const theOption : ShortString ) : ShortString;
  begin
    if BapiInfo.ValueExists( theOption ) then
      Result := BapiInfo.ReadString( theOption )
    else
      Result := '';
  end;

begin
  Inherited Create( P, Container, Desc, OMode, SMode, PPass, iOptFlds, pOptFldDesc, pOptParams );
  FStatements := TTitanCollection.Create;
  FSessionID  := -1;
  If ( iOptFlds = 0 ) then
  begin
    BapiInfo := TRightsRegistry.Create;
    try
      BapiInfo.RootKey := TBaseSession( P ).TitanEnvironment.RootKey;
      BapiInfo.Rights  := KEY_READ;
      BapiInfo.OpenKey( TBaseSession( P ).TitanEnvironment.ClientPath + '\' +
        REG_ALIASES + '\' + StrPas( Description.szName ), FALSE );
      tmp := GetOption( BAPI_USER_NAME );
      If ( Length( tmp ) > 0 ) then
        StrPCopy( @FName, tmp );
      If ( PPass = NIL ) or ( StrLen( PPass ) = 0 ) then
      begin
        tmp := GetOption( BAPI_PASSWORD  );
        If ( Length( tmp ) > 0 ) then
          StrPCopy( @Password, tmp );
      end;
    finally
      BapiInfo.Free;
    end;
  end;
end;


Destructor TBtrSqlDatabase.Destroy;
begin
  FStatements.Free;
  Inherited Destroy;
end;


Procedure TBtrSQLDatabase.SetSessionID;
begin
  TestScalableSQLResult( XPutSessionID( FSessionID ) );
end;


Procedure TBtrSqlDatabase.ProcessOptionalParam( Name, Value : PChar );

  Function TestValue( Token : PChar ) : Boolean;
  begin
    Result := ( StrIComp( Name, Token ) = 0 );
  end;

begin
  if TestValue( BAPI_USER_NAME ) or TestValue( szUSERNAME ) then
    StrLCopy( @FName, Value, SizeOf( FName ) - 1 )
  else
    if TestValue( BAPI_PASSWORD ) or TestValue( szPASSWORD ) then
      StrLCopy( @Password, Value, SizeOf( Password ) - 1 );
end;


Procedure TBtrSqlDatabase.TestForSQLEngine;
begin
  If not FEngineLoaded then
  begin
    If SQLEngineLoaded then
      FEngineLoaded := TRUE
    else
      ThrowScalableSQLException( ISAM_SSQL_NOT_LOADED );
  end;
end;

(*
Function TBtrSqlDatabase.IsSqlBased : Boolean;
begin
  Result := TRUE;
end;
*)

Function TBtrSqlDatabase.IsNamedDatabase : Boolean;
begin
  Result := ( StrPos( @Description.szName, SSQL_DB_PREFIX ) <> NIL );
end;


Procedure TBtrSqlDatabase.OpenTableList (                    { Open a cursor on "Tables" }
            bExtended     : Bool;                            { True for extended info }
            bSystem       : Bool;                            { True to include system tables }
            pszWild       : PChar;                           { Wild card name }
            var   hCur    : hDBICur                          { Returned cursor }
          );
begin
  If ( StrPos( @Description.szName, SSQL_DB_PREFIX ) <> NIL ) and
     ( StrPos( @Description.szDbType, BTRIEVESQL_DRIVER_DESC ) <> NIL ) then
    ThrowScalableSQLException( ISAM_CANT_OPEN_SYS_TABLES )
  else
    Inherited OpenTableList( bExtended, bSystem, pszWild, hCur );
end;


Function TBtrSqlDatabase.GetObjType : PChar;
const
  T : PChar = 'SQL';
begin
  Result := T;
end;


Procedure TBtrSqlDatabase.QAlloc(                            { Allocates a statement handle  }
            eQryLang      : DBIQryLang;                      { Query language }
            var hStmt     : hDBIStmt                         { Returned statment handle }
          );
begin
  TestForSQLEngine;
  hStmt := hDBIStmt( TSSQLSqlStmt.Create( Self, FStatements, NIL, qprepNONE, ClientID, FSessionID ) );
end;


Procedure TBtrSqlDatabase.QPrepareExt (                      { Prepare a query }
            eQryLang      : DBIQryLang;                      { Query language }
            pszQuery      : PChar;                           { Query }
            propBits      : Word;                            { properties for Prepare, e.g. qprepFORUPDATE }
            var hStmt     : hDBIStmt                         { Returned statment handle }
         );
begin
  if ( eQryLang = qryLangSQL ) then
  begin
    LogIn;
    If ( hStmt = NIL ) then
      hStmt  := hDBIStmt( TSSQLSqlStmt.Create( Self, FStatements, NIL, PropBits, FPClientID, FSessionID ) );
    ValidateHandle( hStmt );
    With TSSQLSqlStmt( hStmt ) do
    begin
      SessionID  := FSessionID;
      SQLText    := pszQuery;
    end;
  end
  else
    Not_Supported( fnQPREPAREEXT );
end;


Procedure TBtrSqlDatabase.QPrepareProc (                     { Prepare a stored procedure }
            pszProc       : PChar;                           { Stored procedure name }
            uParamDescs   : Word;                            { Number of parameter descriptors }
            paParamDescs  : pSPParamDesc;                    { Array of parameter descriptors }
            pRecBuff      : Pointer;                         { Record buffer }
            var hStmt     : hDBIStmt                         { Returned statment handle }
          );
var
  S : String;
begin
  Login;
  S := 'CALL ' + StrPas( pszProc ) + '();';
  hStmt  := hDBIStmt( TSSQLSqlStmt.Create( Self, FStatements, pChar( S ), qprepFORUPDATE, FPClientID, FSessionID ) );
  ValidateHandle( hStmt );
  TSQLStmt( hStmt ).QSetProcParams( uParamDescs, paParamDescs, pRecBuff );
end;




Procedure TBtrSqlDatabase.Login;
Const
  SResv    : Char = #0;
  VERVAL   : Array[ Boolean ] of SmallInt = ( 0, 1 );
Var
  DPhyName : DBIPATH;
  DName    : DBIPATH;
  Status   : SmallInt;
begin
  if not LoggedIn then
  begin
    TestForSQLEngine;
    MoveZero( DPhyName, Sizeof( DPhyName ) );
    MoveZero( DName,    Sizeof( DName    ) );
    If ( StrPos( @Description.szName, SSQL_DB_PREFIX ) = NIL ) then
    begin
      StrLCopy( @DPhyName, @Description.szPhyName, Pred( Sizeof( DPhyName ) ) );
      StrLCopy( @DName,    @Description.szPhyName, Pred( Sizeof( DName    ) ) );
    end
    else
      StrLCopy( @DName, @Description.szName, Pred( Sizeof( DName ) ) );
    Status := XQLLogin( FName[ 0 ], Password[ 0 ], DName[ 0 ], DPhyName[ 0 ], SResv, VERVAL[ IsSSQL40 ] );
    Case Status of
      ISAM_SUCCESS:
        begin
          LoggedIn   := TRUE;
          FSessionID := -1;
          TestScalableSQLResult( XGetSessionID( FSessionID ) );
        end;
      ISAM_INVALID_OWNERNAME:
        ;
      ISAM_INVALID_PASSWORD:
        ThrowScalableSQLExceptionMsg( Status, StrPas( @FName ) );
    else
      ThrowScalableSQLExceptionMsg( Status, StrPas( @Description.szPhyName ) );
    end;
  end;
end;


Procedure TBtrSqlDatabase.LogOut;
begin
  if LoggedIn then
  begin
    SetSessionID;
    TestScalableSQLResult( XQLLogOut );
  end;
  LoggedIn := FALSE;
end;


Procedure TBtrSqlDatabase.OpenSPList (                      { Open a cursor on "Stored Procedures" }
           bExtended     : Bool;                            { True for extended info (N/A) }
           bSystem       : Bool;                            { True to include system procedures }
           pszQual       : PChar;                           { Qualifier (N/A) }
           var hCur      : hDBICur                          { Returned cursor }
         );
begin
  hCur := hDBICur( TBtrSqlProcTable.Create( Self, Tables, @Description.szPhyName, bExtended,
            bSystem, pszQual, FPClientID ) );
  TBaseTable( hCur ).OpenTable;
end;


Procedure TBtrSqlDatabase.BeginTran (                       { Begin a transaction }
           eXIL          : eXILType;                        { Transaction isolation level }
           var hXact     : hDBIXact                         { Returned Xact handle }
         );
begin
  if ( FexState <> xsActive ) then
  begin
    If LoggedIn then
    begin
      hXact  := hDBIXact( Self );
      QExecDirect( qryLangSQL, 'START TRANSACTION', NIL );
      FexState    := xsActive;
      FIsBtrTrans := FALSE;
    end
    else
    begin
      Inherited BeginTran( eXIL, hXact );
      FIsBtrTrans := TRUE;
    end;
  end
  else
    ThrowException( DBIERR_ACTIVETRAN );
end;


Procedure TBtrSqlDatabase.EndTran (                         { End a transaction }
           hXact         : hDBIXact;                        { Xact handle }
           eEnd          : eXEnd                            { Xact end type }
         );
Const
  CMD : Array[ Boolean ] of PChar = ( 'COMMIT WORK', 'ROLLBACK WORK' );
begin
  if ( FexState = xsActive ) then
  begin
    If not ( FIsBtrTrans ) then
    begin
      QExecDirect( qryLangSQL, CMD[ eEnd = xendAbort ], NIL );
      FexState := xsInactive;
    end
    else
      Inherited EndTran( hXAct, eEnd );
    FIsBtrTrans := FALSE;
  end
  else
    ThrowException( DBIERR_NOACTIVETRAN );
end;





end.
