(*****************************************************************************)
(* MODULE: BTRSESS*                                                          *)
(* RIGHTS: Reggatta Systems - COPYRIGHT 1995 - 2000                          *)
(* DESCR.: This module contains the Database Session classes.                *)
(*                                                                           *)
(* NOTES :                                                                   *)
(*                                                                           *)
(* TBaseSession:       This is the base class for the sesson class.          *)
(*                     All Session related functions are handled by this     *)
(*                     class.                                                *)
(*                                                                           *)
(* TBtrSession:        This class is derived from the TBaseSession class and *)
(*                     provides Btrieve engine operations for the Session.   *)
(*                                                                           *)
(*****************************************************************************)
Unit BtrSess;
{$I BSE.INC}
{$I BAPI.INC}
Interface
Uses
  Windows,
  BDE,

  BseColl,
  BseSess,

  BtrWObj,
  BtrIntrf;

Type
  TBtrSession =
  Class( TBaseSession )
    Private
      FClientID : TBtrClientID;
      FOpenedDB : Boolean;

      Function GetClientIdAddr : Pointer;

    Public
      Property ClientID : TBtrClientID
        Read  FClientID
        Write FClientID;

      Property ClientIDAddress : Pointer
        Read  GetClientIdAddr;

      Property OpenedDatabase : Boolean
        Read  FOpenedDB
        Write FOpenedDB;

      Constructor CreateAsSes( P : TObject; Container : TTitanCollection; PName, PNetDir : PChar );
        Override;

      Destructor  Destroy; Override;

      Function    GetDriverDescText : PChar; Override;

      Procedure   SetBtrieveSessionID;
      Procedure   SetTitanEnv; Override;

      Procedure   OpenDatabaseInternal (                      { Open a database }
                    pdbDesc       : pDBDesc;                  { Database description }
                    eOpenMode     : DBIOpenMode;              { Open type }
                    eShareMode    : DBIShareMode;             { Share type }
                    pszPassword   : PChar;                    { Password }
                    iOptFlds      : Word;                     { Number of optional Params }
                    pOptFldDesc   : pFLDDesc;                 { Optional Field Descriptors }
                    pOptParams    : Pointer;                  { Optional Params }
                    var hDb       : hDBIDb                    { Returned database handle }
                  ); Override;

      Procedure   OpenDatabase (                              { Open a database }
                    pszDbName     : PChar;                    { Database name }
                    pszDbType     : PChar;                    { Database type (NULL: Universal) }
                    eOpenMode     : DBIOpenMode;              { Open type }
                    eShareMode    : DBIShareMode;             { Share type }
                    pszPassword   : PChar;                    { Password }
                    iOptFlds      : Word;                     { Number of optional Params }
                    pOptFldDesc   : pFLDDesc;                 { Optional Field Descriptors }
                    pOptParams    : Pointer;                  { Optional Params }
                    var hDb       : hDBIDb                    { Returned database handle }
                  ); Override;

      Procedure   TranslateRecordStructure (                  { Translate a record }
                    pszSrcDriverType : PChar;                 { Source driver type }
                    iFlds         : Word;                     { Number of fields }
                    pfldsSrc      : pFLDDesc;                 { Array of source fields: logical or physical types }
                    pszDstDriverType : PChar;                 { Destination driver type }
                    pszLangDriver : PChar;                    { Language driver for destination }
                    pfldsDst      : pFLDDesc                  { Array of dest. fields returned }
                    ;
                    bCreatable    : Bool                      { TRUE -> map to creatable fields only. }
                  ); Override;

  end;

  TBtrSessionClass = Class of TBtrSession;

Implementation
Uses
  SysUtils,
  IniFiles,
  Classes,
  BseRgtry,

  BseConst,
  BseUtils,
  BseTypes,
  BseErrs,


  BtrTypes,
  BtrConst,
  BtrConv,
  BtrErrs,
  BtrMain,
  BtrDbase;

Constructor TBtrSession.CreateAsSes( P : TObject; Container : TTitanCollection;
              PName, PNetDir : PChar );
var
  BapiReg : TRightsRegistry;
  temp    : ShortString;
  DLLTemp : String;
  Name    : String;
  NDir    : String;
  Status  : SmallInt;

  Function GetBoolValue( Const Setting : String; Default : Boolean ) : Boolean;
  begin
    If BapiReg.ValueExists( Setting ) then
      Result := BapiReg.ReadBool( Setting )
    else
      Result := Default;
  end;

  Function GetStringValue( Const Setting : String ) : String;
  begin
    If BapiReg.ValueExists( Setting ) then
      Result := BapiReg.ReadString( Setting )
    else
      Result := '';
  end;

  Function OpenKey( Const S : String ) : Boolean;
  begin
    Result := BapiReg.OpenKey( FTitanEnv.ClientPath + '\' + REG_CONFIG + '\' + S, FALSE );
  end;

begin
  SetTitanEnv;
  BapiReg := TRightsRegistry.Create;
  Try
    BapiReg.RootKey := FTitanEnv.RootKey;
    BapiReg.Rights  := KEY_READ;
    If ( MainThreadID = GetCurrentThreadID ) then
    begin
      temp    := '';
      DllTemp := '';
      If OpenKey( BAPI_BTRIEVE_SECTION ) then
      begin
        temp := GetStringValue( BAPI_BTRIEVE_OPTIONS );
        If ( Length( temp ) = 0 ) then
          MoveZero( Temp, SizeOf( Temp ) );
        DllTemp := LowerCase( GetStringValue( BAPI_DLL_NAME ) ) + #0;
        IGNORESQLDATABASES := GetBoolValue( BAPI_IGNORE_SQL_DBS, IGNORESQLDATABASES );
      end;
      If ( Length( DLLtemp ) = 0 ) then
        MoveZero( DLLTemp, SizeOf( DLLTemp ) );
      Status  := BtrvInit( @temp[ 1 ], PChar( DLLTemp ) );
      If ( Status = ISAM_ENGINE_INITIALIZED ) then
        Status := ISAM_SUCCESS;
      If ( Status <> ISAM_SUCCESS ) then
        ThrowBtrieveExceptionMsg( Status, temp );

      If OpenKey( BAPI_INTL_SECTION ) then
        SetIntlFlags(
          GetBoolValue( BAPI_OEMANSI_FLAG, FALSE ),
          GetBoolValue( BAPI_ANSIOEM_FLAG, FALSE )
        );

      If OpenKey( BAPI_FIELD_SECTION ) then
      begin
        IGNORE_READFIELD_ERR  := GetBoolValue( BAPI_READ_FIELD_FLAG,   IGNORE_READFIELD_ERR   );
        IGNORE_WRITEFIELD_ERR := GetBoolValue( BAPI_WRITE_FIELD_FLAG,  IGNORE_WRITEFIELD_ERR  );
        SMALLINTASBYTE        := GetBoolValue( BAPI_SMALLINTASBYTE,    SMALLINTASBYTE         );
        STRINGPADDEDSPACES    := GetBoolValue( BAPI_STRING_PAD_SPACES, STRINGPADDEDSPACES     );
        INTEGERSSHOWASZERO    := GetBoolValue( BAPI_RETURN_INTS_FLAG,  INTEGERSSHOWASZERO     );
      end;

      If OpenKey( BAPI_RECORD_SECTION ) then
        TRUERECORDCOUNT       := GetBoolValue( BAPI_TRUERECORDCOUNT,   TRUERECORDCOUNT        );

    end;

    Name := PName;
    If not Assigned ( PName ) then
      If OpenKey( BAPI_SESSION_SECTION ) then
        Name := GetStringValue( BAPI_SESSION_NAME );

    NDir := PNetDir;
    if not Assigned( PNetDir ) then
      If OpenKey( BAPI_SESSION_SECTION ) then
        NDir := GetStringValue( BAPI_SESSION_DIR );

  Finally
    BapiReg.Free;
  end;
  Inherited CreateAsSes( P, Container, PChar( Name ), PChar( NDir ) );
  SetBtrieveSessionID;
end;



Destructor TBtrSession.Destroy;
var
  WinBtr : TWinBtr;
begin
  Inherited Destroy;
  If FOpenedDB then
  begin
    WinBtr := TWinBtr.Create( ClientIDAddress );
    Try
      WinBtr.ShutDownClientSession;
    Finally
      WinBtr.Free;
    end;
  end;
  If ( Container <> NIL ) and ( Container.Count = 0 ) then
    if ( MainThreadID = GetCurrentThreadID ) then
      BtrvStop;
end;

Procedure TBtrSession.SetTitanEnv;
begin
  FTitanEnv := BtrTitanEnv;
end;

Function TBtrSession.GetClientIdAddr : Pointer;
begin
  Result := @FClientID;
end;


Function TBtrSession.GetDriverDescText : PChar;
begin
  Result := BTRIEVE_DRIVER_DESC;
end;


Procedure TBtrSession.SetBtrieveSessionID;
var
  Tmp : TDateTime;
  hr  : Word;
  mn  : Word;
  sc  : Word;
  ms  : Word;
begin
  { Enter the last 4 bytes of the client ID, as described in Btrieve docs. }
  { on page A-14 of the Btrieve Programmers Manual                         }
  { Also see Btrieve Developer's Journal Autumn 96                         }
  (* MoveZero( FClientID, SizeOf( FClientID ) ); *)
  Tmp := SysUtils.Time;
  DecodeTime( Tmp, hr, mn, sc, ms );
  FClientID[ 13 ] := Byte( 65 + ( ms mod 26 ) );
  FClientID[ 14 ] := Byte( 65 + ( sc mod 26 ) );
  FClientID[ 15 ] := Byte( hr );
  FClientID[ 16 ] := Byte( mn );
end;


Procedure TBtrSession.OpenDatabaseInternal (                { Open a database }
           pdbDesc       : pDBDesc;                         { Database description }
           eOpenMode     : DBIOpenMode;                     { Open type }
           eShareMode    : DBIShareMode;                    { Share type }
           pszPassword   : PChar;                           { Password }
           iOptFlds      : Word;                            { Number of optional Params }
           pOptFldDesc   : pFLDDesc;                        { Optional Field Descriptors }
           pOptParams    : Pointer;                         { Optional Params }
           var   hDb     : hDBIDb                           { Returned database handle }
         );
begin
  hDB := hDBIDb( TBtrDatabase.Create( Self, Databases, pdbDesc, eOpenMode, eShareMode,
         pszPassword, iOptFlds, pOptFldDesc, pOptParams ) );
  TBtrDatabase( hDb ).ClientID := ClientIDAddress;
  FOpenedDB  := TRUE;
end;


Procedure TBtrSession.OpenDatabase (                        { Open a database }
           pszDbName     : PChar;                           { Database name }
           pszDbType     : PChar;                           { Database type (NULL: Universal) }
           eOpenMode     : DBIOpenMode;                     { Open type }
           eShareMode    : DBIShareMode;                    { Share type }
           pszPassword   : PChar;                           { Password }
           iOptFlds      : Word;                            { Number of optional Params }
           pOptFldDesc   : pFLDDesc;                        { Optional Field Descriptors }
           pOptParams    : Pointer;                         { Optional Params }
           var hDb       : hDBIDb                           { Returnd database handle }
         );
var
  Desc   : DbDesc;
  Curr   : ShortString;
begin
  If HasPath( pszDBName, TRUE ) then
  begin
    Curr := StrPas( pszDBName );
    If ( Curr = '' ) then
      GetDir( 0, Curr );
    Curr := AddBackSlash( Curr );
    If TRUE then     {We don't care if FILE.DDF exists}
    begin
      MoveZero( Desc, SizeOf( Desc ) );
      With Desc do
      begin
        StrCopy(  @szName,    WBTRV_DATABASE_NAME );        { Logical name (Or alias) }
        StrPCopy( @szPhyName, Curr                );        { Physical name/path }
        StrCopy(  @szDbType,  BTRIEVE_DRIVER_DESC );        { Database type }
      end;
      OpenDatabaseInternal( @Desc, eOpenMode, eShareMode, pszPassword, iOptFlds, pOptFldDesc, pOptParams, hDb );
    end
    else
      ThrowExceptionMsg( DBIERR_UNKNOWNDB, StrPas( pszDbName ) );
  end
  else
    Inherited OpenDatabase(
                pszDbName,
                pszDbType,
                eOpenMode,
                eShareMode,
                pszPassword,
                iOptFlds,
                pOptFldDesc,
                pOptParams,
                hDb
              );
end;


Procedure TBtrSession.TranslateRecordStructure (            { Translate a record }
            pszSrcDriverType : PChar;                       { Source driver type }
            iFlds         : Word;                           { Number of fields }
            pfldsSrc      : pFLDDesc;                       { Array of source fields: logical or physical types }
            pszDstDriverType : PChar;                       { Destination driver type }
            pszLangDriver : PChar;                          { Language driver for destination }
            pfldsDst      : pFLDDesc                        { Array of dest. fields returned }
            ;
            bCreatable    : Bool                            { TRUE -> map to creatable fields only. }
          );
var
  i   : Word;
  Src : pFLDDesc;
  Dst : pFLDDesc;
begin
  If ( pszSrcDriverType <> NIL ) or ( iFlds = 0 ) then
    Not_Supported( fnTRANSLATERECORDSTRUCTURE );
  Src := pFldsSrc;
  Dst := pFldsDst;
  Move( Src^, Dst^, SizeOf( FLDDesc ) * iFlds );
  For i := 1 to iFlds do
  begin
    With Dst^ do
    begin
      Case Src^.iFldType of
        fldZSTRING:
          iFldType := btrFldZSTRING;
        fldDATE:
          begin
            iFldType := btrFldDATE;
            iLen     := SizeOf( BtrieveDateType );
          end;
        fldBLOB:
          (* PGB Update this when P.SQL blobs are supported *)
          if ( Src^.iSubType = fldStMemo ) then
            iFldType := btrFldNOTE
          else
            iFldType := btrFldSTRING;
        fldBOOL:
          begin
            iFldType := btrFldLOGICAL;
            If ( iLen = 0 ) then
              iLen := SizeOf( Word );
          end;
        fldINT16:
          begin
            iFldType := btrFldINTEGER;
            iLen     := SizeOf( SmallInt );
          end;
        fldINT32:
          begin
            iFldType := btrFldINTEGER;
            iLen     := SizeOf( LongInt );
          end;
        fldFLOAT:
          begin
            iFldType := btrFldFLOAT;
            If ( iLen = 0 ) then
              iLen := SizeOf( Double );
          end;
        fldBCD:
          iFldType := btrFldDECIMAL;
        fldBYTES:
          iFldType := btrFldUBINARY;
        fldTIME:
          begin
            iFldType := btrFldTIME;
            iLen     := SizeOf( BtrieveTimeType );
          end;
        fldTIMESTAMP:
          begin
            iFldType := btrFldTIMESTAMP;
            iLen     := SizeOf( Comp );
          end;
        fldUINT16:
          begin
            iFldType := btrFldUBINARY;
            iLen     := SizeOf( Word );
          end;
        fldUINT32:
          begin
            iFldType := btrFldUBINARY;
            iLen     := SizeOf( LongWord );
          end;
        fldFLOATIEEE:
          begin
            iFldType := btrFldFLOAT;
            If ( iLen = 0 ) then
              iLen := SizeOf( Double );
          end;
        fldVARBYTES:
          iFldType := btrFldLSTRING;
        fldINT64:
          begin
            iFldType := btrFldINTEGER;
            iLen     := SizeOf( Int64 );
          end;
        fldUINT64:
          begin
            iFldType := btrFldUBINARY;
            iLen     := SizeOf( Int64 );
          end;  
      else
        Not_Supported( fnTRANSLATERECORDSTRUCTURE );
      end;
    end;
    Inc( Src  );
    Inc( Dst );
  end;
end;


end.

