(*****************************************************************************)
(* MODULE: SQLTABLE                                                          *)
(* RIGHTS: Reggatta Systems - COPYRIGHT 1995 - 2000                          *)
(* DESCR.: This module contains the Scalable SQL Class                       *)
(*****************************************************************************)
Unit SqlTable;
{$I BSE.INC}
{$I BAPI.INC}
Interface
Uses
  Classes,
  WinTypes,

  DB,
  BDE,
  DbTables,

  BseBapi,
  BseColl,
  BseTypes,
  BseTable,
  BseStmt,

  BtrWobj,
  BtrTable;


Type
  TSSQLSqlStmt =
  Class( TSqlStmt )
    Private
      FCursorID  : SmallInt;
      FSessionID : SmallInt;
      FPClientID : PBtrClientID;
    Protected
      Procedure SetSQLText( P : PChar ); Override;

    Public
      Property ClientID : PBtrClientID
        Read  FPClientID
        Write FPCLientID;
      Property SessionID : SmallInt
        Read  FSessionID
        Write FSessionID;

      Constructor Create( P : TObject; Container : TTitanCollection; SQL : PChar;
                    PropBits : Word; pClientID : pBtrClientID; SessionID : SmallInt );
                    
      Procedure   SetSessionID;
      Procedure   OpenStatement; Override;
      Procedure   CloseStatement; Override;

      Procedure   QSetParams (                              { Set query options }
                    uFldDescs     : Word;                   { Number of parameter field descriptors }
                    paFldDescs    : pFLDDesc;               { Array of parameter field descriptors }
                    pRecBuff      : Pointer                 { Record buffer }
                  ); Override;

      Procedure   QSetProcParams (                          { Set procedure params }
                    uParamDescs   : Word;                   { Number of parameter descriptors }
                    paParamDescs  : pSPParamDesc;           { Array of parameter descriptors }
                    pRecBuff      : Pointer                 { Record buffer }
                  ); Override;

      Procedure   QExec (                                   { Execute prepared query }
                    phCur         : phDBICur                { Returned handle on result set }
                  ); Override;
  end;


  TBtrSqlBaseTable =
  Class( TBtrBaseTable )
    Private
      FCursorID   : SmallInt;
      FSessionID  : SmallInt;
      FUpdateMode : TUpdateMode;
    Public
      Function    GetBookMarkSize : Integer; Override;

      Constructor Create( P : TObject; Container : TTitanCollection; ID : Integer;
                    pClientID : PBtrClientID; SessionID : SmallInt );

      Procedure   SetSessionID;
      Procedure   GetNativeDesc( iField : Integer; Src : Pointer; P : pFldDesc;
                    Var LocType, LocSize : Word ); Override;

      Procedure   OpenTable; Override;

      Procedure   SqlOp( Operation : SmallInt );
      Procedure   FirstRecordRaw; Override;
      Procedure   LastRecordRaw;  Override;
      Procedure   NextRecordRaw;  Override;
      Procedure   PrevRecordRaw;  Override;

      Procedure   InsertRecord( eLock : DBILockType; pRecBuff : Pointer ); Override;
      Procedure   ModifyRecord( pRecBuff : Pointer; bFreeLock : Bool ); Override;
      Procedure   DeleteRecord( pRecBuff : Pointer ); Override;

      Procedure   GetCursorProps( var curProps : CURProps ); Override;

      Procedure   GetBookMark( P : Pointer ); Override;
      Procedure   SetToBookmark( P : Pointer ); Override;
      Procedure   GetRecordWithBookMark( P, pRecBuff : Pointer; eLock : DBILockType ); Override;
      Procedure   CompareBookMarks( pBookMark1, pBookMark2 : Pointer;
                    var CmpBkmkResult : CmpBkmkRslt ); Override;

      Procedure   ReadBlock ( Var iRecords : Longint; pBuf : Pointer ); Override;
      Procedure   WriteBlock ( Var iRecords : Longint; pBuf : Pointer ); Override;

      Procedure   GetProp (                                 { Get property }
                    iProp         : Longint;                { Property to retrieve }
                    PropValue     : Pointer;                { == NULL, validate iProp for getting }
                    iMaxLen       : Word;                   { Length of buffer pPropValue }
                    var   iLen    : Word                    { Returns required length }
                  ); Override;

      Procedure   SetProp (                                 { Get property }
                    iProp         : Longint;                { Property to retrieve }
                    PropValue     : Longint                 { == NULL, validate iProp for getting }
                  ); Override;

      Procedure   ValidateProp (                            { Validate a property }
                    iProp         : Longint;                { property to validate }
                    bSetting      : Bool                    { TRUE:setting, FALSE:getting }
                  ); Override;

      Procedure   TranslatePut(
                    P             : TFieldCacheItem;          { Field Description Info }
                    pRecBuff      : Pointer;                  { Record buffer }
                    pSrc          : Pointer                   { Source field buffer }
                  ); Override;

      Procedure   UpdateRecordBufferSize(
                    pRecBuf       : Pointer;
                    T             : TFieldCacheItem;
                    iLen          : LongInt
                  ); Override;
  end;

  TBtrSqlAggTable =
  Class( TBtrSqlBaseTable )
    Private
      FRecNo      : LongInt;
    Public
      Procedure   FirstRecordRaw; Override;
      Procedure   LastRecordRaw;  Override;
      Procedure   NextRecordRaw; Override;
      Procedure   PrevRecordRaw; Override;

      Function    GetBookMarkSize : Integer; Override;
      Procedure   GetBookMark( P : Pointer ); Override;
      Procedure   SetToBookmark( P : Pointer ); Override;
      Procedure   GetRecordWithBookMark( P, pRecBuff : Pointer; eLock : DBILockType ); Override;
  end;

  TBtrSqlProcTable =
  Class( TBtrTable )
    Public
      Extended  : Bool;
      System    : Bool;
      Qualifier : PChar;

      Constructor Create( P : TObject; Container : TTitanCollection; Path : PChar;
                    E, S : Bool; Q : PChar; pClientID : PBtrClientID );

      Function    GetBufferSize : Word; Override;
      Procedure   GetNextRecord (                                { Find/Get the next record }
                    eLock         : DBILockType;                 { Optional lock request }
                    pRecBuff      : Pointer;                     { Record buffer(client) }
                    pRecProps     : pRECProps                    { Optional record properties }
                  ); Override;
  end;

  TSSQLDatabaseTable =
  Class( TBaseTable )
    Protected
      FDBList   : TTitanCollection;
      FCfgRecs  : TTitanCollection;
      FRecIndex : SmallInt;

      Procedure LoadTitanDatabaseNames;
      Procedure LoadSQLDatabaseNames( Const IsRemote : Boolean );

    Public
      Constructor Create( P : TObject; Container, CfgRecs : TTitanCollection;
                    Name, Driver : PChar );
      Destructor  Destroy; Override;
      Procedure  InitTableStruct; Override;
      Procedure GetNextRecord (                                { Find/Get the next record }
                  eLock         : DBILockType;                 { Optional lock request }
                  pRecBuff      : Pointer;                     { Record buffer(client) }
                  pRecProps     : pRECProps                    { Optional record properties }
                ); Override;
  end;


Implementation
Uses
  SysUtils,
  Dialogs,

  BseUtils,
  BseErrs,
  BseConst,
  BseDbase,
  BseSess,

  BtrErrs,
  BtrConst,
  BtrTypes,
  BtrConv,
  BtrMain,

  SQLApi,
  SQLErrs;

Const
  SSQLERR_UNRESOLVED_VARS     = -108;
  SSQLERR_NO_MORE_RECORDS     = -109;
  SSQLERR_BADBUFFER_SIZE      = 210;

  SSQL_FETCH_CURRENT          : SmallInt = 0;
  SSQL_FETCH_FIRST            : SmallInt = 1;
  SSQL_FETCH_NEXT             : SmallInt = 2;
  SSQL_FETCH_PREVIOUS         : SmallInt = 3;
  SSQL_FETCH_LAST             : SmallInt = 4;
  SSQL_FETCH_POSITION         : SmallInt = 5;
  SSQL_FETCH_COMPUTED         : SmallInt = 6;
  SSQL_FETCH_UNLOCK           : SmallInt = 7;

  SSQL_USE_POSITION           : SmallInt = 256;
  SSQL_NOWAIT_IMPLICIT_UNLOCK : SmallInt = 1024;

  MAX_SQL_TABLES              = 24;
  SSQL_FIELD_CHAR             = '^';
  BDE_FIELD_CHAR              = '_';

  SSQL_PARAM_CHAR             = '@';
  BDE_PARAM_CHAR1             = ':';
  BDE_PARAM_CHAR2             = '?';
  BDE_CR                      = #13;
  BDE_LF                      = #10;
  VAR_PARAM_FMT1              = 'QVAR%4.4d';
  VAR_PARAM_FMT2              = SSQL_PARAM_CHAR + VAR_PARAM_FMT1;

  CLOSED_CURSOR_ID            = -1;

  AGGFUNCTIONS :
    Array[0..5] of PChar =
      ( 'COUNT(', 'SUM(', 'AVG(', 'GROUP', 'HAVING', 'DISTINCT' );


{$I BTRIEVE.INC}

Type
  TBtrSQLBookMark =
  Record
    Size      : Word;
    Positions : Array[ 1..MAX_SQL_TABLES ] of LongInt;
  end;


Constructor TSSQLSqlStmt.Create( P : TObject; Container : TTitanCollection; SQL : PChar;
              PropBits : Word; pClientID : pBtrClientID; SessionID : SmallInt );
begin
  FCursorID  := CLOSED_CURSOR_ID;
  FSessionID := SessionID;
  Inherited Create( P, Container, SQL, PropBits );
  FPClientID := pClientID;
end;


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




Procedure TSSQLSqlStmt.SetSQLText( P : PChar );
var
  tmp : PChar;
  i,l : integer;
  j   : integer;
  Num : Array[0..20] of Char;
begin
  if Assigned( FSQLText ) then
    StrDispose( FSQLText );
  if Assigned( P ) then
  begin
    l   := StrLen( P ) * 2;
    tmp := StrAlloc( l );
    Try
      StrCopy( tmp, P );
      j := StrLen( tmp );
      ChangeNonLiteralChar( tmp, j, BDE_PARAM_CHAR1, SSQL_PARAM_CHAR );
      i := 0;
      Repeat
        StrLFmt( @Num, SizeOf( Num ), VAR_PARAM_FMT2, [ i ] );
        if not ReplaceSubStr( tmp, BDE_PARAM_CHAR2, @Num, l ) then
          Break
        else
          Inc( i );
      Until FALSE;
      FSQLText := StrNew( tmp );
    Finally
      StrDispose( tmp );
    end;
  end;
end;


Procedure TSSQLSqlStmt.OpenStatement;
var
  i      : SmallInt;
  Status : SmallInt;
begin
  CloseStatement;
  If ( FSQLText <> NIL ) then
  begin
    SetSessionID;
    TestScalableSQLResult( XQLCursor( FCursorID ) );
    i := StrLen( FSQLText );
    Status := XQLCompile( FCursorID, i, FSQLText^ );
    if ( Status <> SSQLERR_UNRESOLVED_VARS ) then
      TestScalableSQLResult( Status );
  end;
end;


Procedure TSSQLSqlStmt.CloseStatement;
begin
  if ( FCursorID <> CLOSED_CURSOR_ID ) then
  begin
    SetSessionID;
    TestScalableSQLResult( XQLFree( FCursorID ) );
    FCursorID := CLOSED_CURSOR_ID;
  end;
end;


Function DateToSSQLDateParam( Const X : TDateTime )  : String;
{ P.SQL wants this in the format yyyy-mm-dd }
Var
  Year  : Word;
  Month : Word;
  Day   : Word;
begin
  DecodeDate( X, Year, Month, Day );
  FmtStr( Result, '%4.4u-%2.2u-%2.2u', [ Year, Month, Day ] );
end;


Function TimeToSSQLTimeParam( Const X : TDateTime; UseMilli : Boolean )  : String;
{ P.SQL wants this in the format hh:mm:ss:uu }
Var
  Hour : Word;
  Min  : Word;
  Sec  : Word;
  Mill : Word;
begin
  DecodeTime( X, Hour, Min, Sec, Mill );
  If UseMilli and ( Mill > 0 ) then
  begin
    Mill := Mill div 10; { Convert to hundreds }
    FmtStr( Result, '%2.2u:%2.2u:%2.2u:%2.2u', [ Hour, Min, Sec, Mill ] )
  end
  else
    FmtStr( Result, '%2.2u:%2.2u:%2.2u', [ Hour, Min, Sec ] );
end;


Function TimeStampToSSQLTimeStampParam( Const X : TDateTime ) : String;
{ P.SQL wants this in the format yyyy-mm-dd hh:tt:ss[,ffff] }
begin
  Result := DateToSSQLDateParam( X ) + ' ' + TimeToSSQLTimeParam( X, FALSE );
end;


Function FixDecimalChar( Const S : ShortString ) : ShortString;
var
  i : Integer;
begin
  Result := S;
  If ( DecimalSeparator <> '.' ) then
  begin
    i := PosOfCh( DecimalSeparator, Result );               { Assuming only 1 occurrence }
    if ( i <> 0 ) then
      Result[ i ] := '.';
  end;
end;


Procedure TSSQLSqlStmt.QSetParams (                         { Set query options }
           uFldDescs     : Word;                            { Number of parameter field descriptors }
           paFldDescs    : pFLDDesc;                        { Array of parameter field descriptors }
           pRecBuff      : Pointer                          { Record buffer }
         );
Const
  BOOLTEXT : Array[ Boolean ] of String[5] =( 'false', 'true' );
var
  i        : Word;
  P        : pFLDDesc;
  Num      : Array[0..20] of Char;
  Fld      : Pointer;
  tmp      : ShortString;
  Ts       : TTimeStamp;
  CurrSess : TBaseSession;
  DataLoss : Bool;
begin
  If ( uFldDescs > 0 ) then
  begin
    SetSessionID;
    if ( FCursorID = CLOSED_CURSOR_ID ) then
      OpenStatement;
    CurrSess := TBaseSession( TBaseDatabase( Parent ).Parent );
    P := pFLDDesc( paFLDDescs );
    For i := 0 to Pred( uFldDescs ) do
    begin
      If ( StrLen( @P^.szName ) = 0 ) then
      begin
        { Handles code for '?' type substitution variables }
        Fld := PChar( PRecBuff ) + P^.iOffset;
        StrLFmt( @Num, SizeOf( Num ), VAR_PARAM_FMT1, [ i ] );
        Case P^.iFldType of
          fldZSTRING:
            begin
              CurrSess.AnsiToNative( NIL, @Tmp[ 1 ], Fld, P^.iLen, DataLoss );
			  { Thanks to Mieczyslaw Dyla for fix below}
              SetLength( Tmp, StrLen( @Tmp[ 1 ] ) );
            end;
          fldDATE:
            begin
              { Coming in as the date part of a TimeStamp }
              Ts.Time := 0;
              Move( Fld^, Ts.Date, SizeOf( Ts.Date ) );
              tmp := DateToSSQLDateParam( TimeStampToDateTime( Ts ) );
            end;
          fldBOOL:
            Tmp := BOOLTEXT[ Boolean( Fld^ ) ];
          fldINT16:
            Tmp := IntToStr( SmallInt( Fld^ ) );
          fldINT32:
            Tmp := IntToStr( LongInt( Fld^ ) );
          fldFLOAT,
          fldBCD:
            tmp := FixDecimalChar( FloatToStr( Double( Fld^ ) ) );
          fldTIME:
            begin
              { Coming in as the time part of a TimeStamp }
              Ts.Date := 0;
              Move( Fld^, Ts.Time, SizeOf( Ts.Time ) );
              tmp := TimeToSSQLTimeParam( TimeStampToDateTime( Ts ), TRUE );
            end;
          fldUINT16:
            tmp := IntToStr( Word( Fld^ ) );
          fldUINT32:
            tmp := IntToStr( LongWord( Fld^ ) );
          fldFLOATIEEE:
            tmp := FixDecimalChar( FloatToStr( Double( Fld^ ) ) );
          fldINT64,
          fldUINT64:
            tmp := IntToStr( Int64( Fld^ ) );
          fldTIMESTAMP:
            begin
              { Coming in as a double in Milliseconds }
               Ts  := MSecsToTimeStamp( Double( Fld^ ) );
               tmp := TimeStampToSSQLTimeStampParam( TimeStampToDateTime( Ts ) );
            end;
        else
          tmp := '';
        end;
        AddChar( Tmp, #0 );
        TestScalableSQLResult( XQLSubst( FCursorID, 1, Succ( StrLen( @Num ) ), Num,
                    Length( Tmp ), Tmp[ 1 ] ) );
      end;
      Inc( P );
    end;
  end;
end;


Procedure TSSQLSqlStmt.QSetProcParams (                     { Set procedure params }
            uParamDescs   : Word;                           { Number of parameter descriptors }
            paParamDescs  : pSPParamDesc;                   { Array of parameter descriptors }
            pRecBuff      : Pointer                         { Record buffer }
          );
begin
  SetSessionID;
  If ( uParamDescs > 0 ) and ( FCursorID = CLOSED_CURSOR_ID ) then
    OpenStatement;
end;


(* Special thanks to Wayne Brantley for the Unidirectional fix *)
Procedure TSSQLSqlStmt.QExec (                              { Execute prepared query }
           phCur         : phDBICur                         { Returned handle on result set }
         );
var
  ExecOnly : Boolean;
  FTable   : TBaseTable;
begin
  ExecOnly := ( phCur = NIL );
  If not ExecOnly then
    phCur^ := NIL;
  SetSessionID;
  If ( FCursorID = CLOSED_CURSOR_ID ) then
    OpenStatement
  else
    if ExecOnly then
      TestScalableSQLResult( XQLExec( FCursorID ) );
  if not ExecOnly then
  begin
    TestScalableSQLResult( XQLExec( FCursorID ) );
    If FUniDirectional then
      FTable := TBtrSqlAggTable.Create( Self, NIL, FCursorID, FPClientID, FSessionID )
    else
      FTable := TBtrSqlBaseTable.Create( Self, NIL, FCursorID, FPClientID, FSessionID );
    FTable.OpenTable;
    phCur^ := hDBICur( FTable );
  end;
end;


Constructor TBtrSqlBaseTable.Create( P : TObject; Container : TTitanCollection;
              ID : Integer; pClientID : PBtrClientID; SessionID : SmallInt );
begin
  FSessionID := SessionID;
  Inherited Create( P, Container, NIL, 0, dbiREADWRITE, dbiOPENSHARED, pClientID );
  FCursorID  := ID;
end;


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



Procedure TBtrSqlBaseTable.GetCursorProps( var curProps : CURProps );
var
  i : Integer;
  P : TFieldCacheItem;
begin
  BufferSize := SCALABLE_ROW_LENGTH_SIZE;
  i := 1;
  Try
    Repeat
      P := FFieldDescs[ i ];
      If ( P <> NIL ) then
      begin
        BufferSize := BufferSize + P.FieldLength;
        Inc( i );
      end
      else
        Break;
    Until FALSE;
  Except
    On E:EScalableSQLEngineError do
      If ( E.NativeError <> ISAM_BAD_COLUMN_POSITION ) then
        Raise;
  end;
  BufferSize := BufferSize + SizeOf( LongInt );  { Not sure why this is needed! }
  Inherited GetCursorProps( curProps );
  With curProps do
  begin
    iFields         := i;                                 { No of fields in Table }
    iRecSize        := BufferSize;                        { Logical Record Buffer Size }
    iRecBufSize     := iRecSize;                          { Record size (physical record) }
  end;
end;


Procedure TBtrSqlBaseTable.OpenTable;
begin
  SetSessionID;
  TestScalableSQLResult( XQLExec( FCursorID ) );
end;


Procedure TBtrSqlBaseTable.SqlOp( Operation : SmallInt );
Var
  Size   : SmallInt;
  Data   : Pointer;
  Count  : Longint;
  Status : SmallInt;
begin
  SetSessionID;
  Data   := DriverBuffer;
  Size   := BufferSize;
  Count  := 1;
  Status := XQLFetch( FCursorID, Operation, Size, Data^, Count, 0, 0 );
  If ( Status = SSQLERR_NO_MORE_RECORDS ) then
  begin
    If ( Count <= 0 ) then
    begin
      if ( Operation in [ SSQL_FETCH_FIRST, SSQL_FETCH_PREVIOUS ] ) then
        ThrowBOFException
      else
        ThrowEOFException;
    end
  end
  else
    TestScalableSQLResult( Status );
end;


Procedure TBtrSqlBaseTable.FirstRecordRaw;
begin
  SqlOp( SSQL_FETCH_FIRST );
end;


Procedure TBtrSqlBaseTable.LastRecordRaw;
begin
  SqlOp( SSQL_FETCH_LAST );
end;


Procedure TBtrSqlBaseTable.NextRecordRaw;
begin
  SqlOp( SSQL_FETCH_NEXT );
end;


Procedure TBtrSqlBaseTable.PrevRecordRaw;
begin
  SqlOp( SSQL_FETCH_PREVIOUS );
end;


Function TBtrSqlBaseTable.GetBookMarkSize : Integer;
begin
  Result := SizeOf( TBtrSQLBookMark );
end;


Procedure TBtrSqlBaseTable.GetBookMark( P : Pointer );
var
  Size    : SmallInt;
  Recs    : Longint;
  Rejects : Longint;
begin
  ValidateParameter( P );
  Size    := BookMarkSize;
  Recs    := 1;
  Rejects := 0;
  MoveZero( P^, Size );
  SetSessionID;
  TestScalableSQLResult( xFetch( FCursorID, Size, SSQL_FETCH_POSITION, Recs, Rejects, P^ ) );
  if ( Recs = 0 ) then
    ThrowException( DBIERR_NOCURRREC );
end;


Procedure TBtrSqlBaseTable.SetToBookmark( P : Pointer );
var
  Buff     : PChar;
  Recs     : Longint;
  Rejects  : Longint;
  Size     : SmallInt;
  BuffSize : Word;
begin
  ValidateParameter( P );
  BuffSize := BufferSize;
  If ( BookMarkSize > BufferSize ) then
    BuffSize := BookMarkSize;
  Inc( BuffSize, BuffSize * 2 ); { Add Cushion }
  Size     := BuffSize;
  Recs     :=  1;
  Rejects  := -1;
  Buff     := AllocMem( BuffSize );
  Try
    Move( P^, Buff^, TBtrSqlBookMark( P^ ).Size + SizeOf( Word ) );
    SetSessionID;
    TestScalableSQLResult( xFetch( FCursorID, Size, SSQL_USE_POSITION, Recs, Rejects, Char( Buff^ ) ) );
  Finally
    FreeMem( Buff, BuffSize );
  end;
  if ( Recs = 0 ) then
    ThrowException( DBIERR_NOCURRREC );
  UpdateTableState;
end;


Procedure TBtrSqlBaseTable.GetRecordWithBookMark( P, pRecBuff : Pointer; eLock : DBILockType );
var
  Recs    : Longint;
  Rejects : Longint;
  Size    : SmallInt;
  Action  : SmallInt;
begin
  ValidateParameter( P );
  Size    := BufferSize;
  Recs    :=  1;
  Rejects := -1;
  Move( P^, pRecBuff^, TBtrSqlBookMark( P^ ).Size + SizeOf( Word ) );
  Action := SSQL_USE_POSITION;
  if ( eLock = DBIWRITELOCK ) then
    Inc( Action, SSQL_NOWAIT_IMPLICIT_UNLOCK );
  SetSessionID;
  TestScalableSQLResult( xFetch( FCursorID, Size, Action, Recs, Rejects, Char( pRecBuff^ ) ) );
  if ( Recs = 0 ) then
    ThrowException( DBIERR_NOCURRREC );
  UpdateTableState;
end;


Procedure TBtrSqlBaseTable.CompareBookMarks( pBookMark1, pBookMark2 : Pointer;
            var CmpBkmkResult : CmpBkmkRslt );
{ This function needs to compare the bookmark data structure }
{ returned by the XQLFetch function                          }
Var
  i     : Integer;
  Loops : Integer;
begin
  CmpBkMkResult := CMPEql;
  ValidateParameter( pBookMark1 );
  ValidateParameter( pBookMark2 );
  If ( TBtrSqlBookMark( pBookMark1^ ).Size <> TBtrSqlBookMark( pBookMark2^ ).Size ) then
    ThrowException( DBIERR_INVALIDBOOKMARK );
  Loops := TBtrSqlBookMark( pBookMark1^ ).Size;
  Inc( LongInt( pBookMark1 ), SizeOf( Word ) ); { Skip to 1st Position }
  Inc( LongInt( pBookMark2 ), SizeOf( Word ) ); { Skip to 1st Position }
  For i := 1 to ( Loops div SizeOf( LongInt ) ) do
  begin
    If ( LongInt( pBookMark1^ ) < LongInt( pBookMark2^ ) ) then
    begin
      CmpBkMkResult := CMPLess;
      Break;
    end
    else
    begin
      If ( LongInt( pBookMark1^ ) > LongInt( pBookMark2^ ) ) then
      begin
        CmpBkMkResult := CMPGtr;
        Break;
      end
      else
      begin
        Inc( LongInt( pBookMark1 ), SizeOf( LongInt ) ); { Skip to next Position }
        Inc( LongInt( pBookMark2 ), SizeOf( LongInt ) ); { Skip to next Position }
      end;
    end;
  end;
end;


Procedure TBtrSqlBaseTable.GetNativeDesc( iField : Integer; Src : Pointer; P : pFldDesc;
           Var LocType, LocSize : Word );
var
  Count  : SmallInt;
  FType  : SmallInt;
  FSize  : SmallInt;
  FDec   : SmallInt;
  FDisp  : SmallInt;
  FnLen  : SmallInt;
  FName  : Array[0..255] of Char;
  found  : boolean;
  Info   : TFieldDDF;
  offset : SmallInt;
  s      : ShortString;
begin
  SetSessionID;
  found  := FALSE;
  count  := 1;
  offset := SCALABLE_ROW_LENGTH_SIZE;
  Repeat
    FnLen := SizeOf( FName );
    TestScalableSQLResult( XQLDescribe( FCursorID, count, FType, FSize, FDec, FDisp, FnLen, FName[ 0 ] ) );
    if ( Count = iField ) then
    begin
      found := ( FSize + FnLen > 0 );
      if found then
      begin
        If ( FSize = 0 ) and( FType = 0 ) then
        begin
          S := UpperCase( StrPas( @FName ) );
          If ( Pos( StrPas( AGGFUNCTIONS[ 0 ] ), S ) > 0 ) then
          begin
            FType := btrFLDINTEGER;
            FSize := SizeOf( LongInt );
          end
          else
            If ( ( Pos( StrPas( AGGFUNCTIONS[ 1 ] ), S ) > 0 ) or
                 ( Pos( StrPas( AGGFUNCTIONS[ 2 ] ), S ) > 0 )
               ) and ( FDec = 0 ) then
            begin
              FType := btrFLDFLOAT;
              FSize := SizeOf( Double );
            end;
        end;
        LocType := FType;
        LocSize := FSize;
        MoveZero( Info, SizeOf( Info ) );
        With Info do
        begin
          ChangeChar( @FName, FnLen, SSQL_FIELD_CHAR, BDE_FIELD_CHAR );
          Move( FName, Xe_Name, FnLen );
          Xe_DataType  := Lo( FType );
          Xe_Size      := FSize;
          Xe_Dec       := Lo( FDec  );
          Xe_Offset    := OffSet;
        end;
        MapFieldDDFToDBIFieldInfo( Info, Count, P );
        { Added for supporting field names > Xe_Name }
        StrLCopy( @P^.szName, @FName, Pred( SizeOf( P^.szName ) ) );
        if ( P^.iSubType = fldstMEMO ) then
          TestForBlob( iField, P );
      end;
      Break;
    end;
    inc( Offset, FSize );
    inc( Count );
  until FALSE;
  if not found then
    ThrowException( DBIERR_INVALIDPARAM );
end;


Procedure TBtrSqlBaseTable.InsertRecord( eLock : DBILockType; pRecBuff : Pointer );
var
  TableCount : SmallInt;
  TableNames : ShortString;
  RecCount   : Longint;
  Data       : Pointer;
  RecLen     : ^SmallInt;
  T          : TFieldCacheItem;
  Operation  : SmallInt;
  MemoPtr    : PChar;
  iSize      : Word;
begin
  TableCount := 1;
  RecCount   := 1;
  TableNames := '*.*' + #0;
  Data       := pRecBuff;
  RecLen     := pRecBuff;
  If ( RecLen^ = 0 ) then
  begin
    RecLen^ := BufferSize;
    If ( FBlobCount > 0 )  then
    begin
      T := Fields[ Fields.Count ];
      if ( T.FieldSubType = fldstMEMO ) then
      begin
        T.Buffer := pRecBuff;
        MemoPtr := T.Data;
        Inc( MemoPtr, Pred( T.FieldLength ) );
        MemoPtr^ := #0;
        Try
          iSize := StrLen( T.Data );
        Except
          iSize := 0;
        end;
        if ( iSize > T.FieldLength ) then
          iSize := T.FieldLength;
        RecLen^ := T.DataOffset + iSize;
      end;
    end
  end;
  SetSessionID;
  TestScalableSQLResult( xInsert( FCursorID, TableCount, TableNames[ 1 ], RecCount, Data^ ) );
  DriverBuffer := pRecBuff;
  Operation := SSQL_FETCH_CURRENT;
  if ( eLock = dbiWRITELOCK ) then
    Inc( Operation, SSQL_NOWAIT_IMPLICIT_UNLOCK );
  SqlOp( Operation );
end;


Procedure TBtrSqlBaseTable.ModifyRecord( pRecBuff : Pointer; bFreeLock : Bool );
var
  TableCount : SmallInt;
  TableNames : ShortString;
  RecCount   : Longint;
  Data       : Pointer;
  Size       : SmallInt;
begin
  TableCount := 1;
  RecCount   := 1;
  TableNames := '*.*' + #0;
  Data       := pRecBuff;
  SetSessionID;
  TestScalableSQLResult( xUpdate( FCursorID, TableCount, TableNames[ 1 ], RecCount, Data^ ) );
  DriverBuffer := pRecBuff;
  if bFreeLock then
  begin
    Size       := 0;
    RecCount   := 0;
    TableCount := 0;
    Data       := @TableCount; {TableCount used as a throwaway variable here }
    XQLFetch( FCursorID, SSQL_FETCH_UNLOCK, Size, Data^, RecCount, 0, 0 );
  end;
  SqlOp( SSQL_FETCH_CURRENT );
end;


Procedure TBtrSqlBaseTable.DeleteRecord( pRecBuff : Pointer );
var
  TableCount : SmallInt;
  TableNames : ShortString;
  RecCount   : Longint;
begin
  TableCount := 1;
  RecCount   := 1;
  TableNames := '*.*' + #0;
  SetSessionID;
  TestScalableSQLResult( xRemove( FCursorID, TableCount, TableNames[ 1 ], RecCount ) );
  State      := TblOnCrack;
end;


Procedure TBtrSqlBaseTable.ReadBlock ( Var iRecords : Longint; pBuf : Pointer );
var
  Size  : SmallInt;
  Data  : Pointer;
begin
  Data   := pBuf;
  Size   := ( BufferSize * iRecords );
  SetSessionID;
  TestScalableSQLResult( XQLFetch( FCursorID, 2, Size, Data^, iRecords, 0, 0 ) );
end;


Procedure TBtrSqlBaseTable.WriteBlock ( Var iRecords : Longint; pBuf : Pointer );
var
  TableCount : SmallInt;
  TableNames : ShortString;
  Data       : Pointer;
begin
  TableCount := 1;
  TableNames := '*.*' + #0;
  Data       := pBuf;
  SetSessionID;
  TestScalableSQLResult( xInsert( FCursorID, TableCount, TableNames[ 1 ], iRecords, Data^ ) );
end;


Procedure TBtrSqlBaseTable.GetProp (                        { Get property }
           iProp         : Longint;                         { Property to retrieve }
           PropValue     : Pointer;                         { == NULL, validate iProp for getting }
           iMaxLen       : Word;                            { Length of buffer pPropValue }
           var   iLen    : Word                             { Returns required length }
         );
begin
  iLen := 0;
  Case TPropertyRec( iProp ).Prop of
    Word( curUPDLOCKMODE ):                                 { rw UPDLockMode ,Update lock mode }
      begin
        iLen := SizeOf( TUpdateMode );
        TUpdateMode( PropValue^ ) := FUpdateMode;
      end;
    Word( curNATIVEHNDL  ):                                 { ro pBYTE       ,Native cursor handle }
      begin
        iLen := SizeOf( FCursorID );
        SmallInt( PropValue^ ) := FCursorID;
      end;
  else
    Inherited GetProp( iProp, PropValue, iMaxLen, iLen );
  end;
end;


Procedure TBtrSqlBaseTable.SetProp (                        { Get property }
           iProp         : Longint;                         { Property to retrieve }
           PropValue     : Longint                          { == NULL, validate iProp for getting }
         );
begin
  Case TPropertyRec( iProp ).Prop of
    Word( curUPDLOCKMODE ):                                 { rw UPDLockMode ,Update lock mode }
      FUpdateMode := TUpdateMode( PropValue );
  else
    Inherited SetProp( iProp, PropValue );
  end;
end;


Procedure TBtrSqlBaseTable.ValidateProp (                   { Validate a property }
           iProp         : Longint;                         { property to validate }
           bSetting      : Bool                             { TRUE:setting, FALSE:getting }
         );
begin
  Case TPropertyRec( iProp ).Prop of
    Word( curNATIVEHNDL ):                                  { ro pBYTE       ,Native cursor handle }
      If bSetting then
        ThrowException( DBIERR_NOTSUPPORTED );
  else
    Inherited ValidateProp( iProp, bSetting );
  end;
end;


Procedure TBtrSQLBaseTable.TranslatePut(
            P             : TFieldCacheItem;                 { Field descript }
            pRecBuff      : Pointer;                         { Record buffer }
            pSrc          : Pointer                          { Source field buffer }
          );
Var
  Tmp : ^ShortString;
begin
  If ( FBlobCount > 0 )  and ( pSrc <> NIL ) and ( P.FieldSubType = fldStMEMO ) and
    ( P.FieldNumber = FFieldDescs.Count ) then
  begin
    Tmp := pSrc;
    PutBlob( pRecBuff, P.FieldNumber, 0, Length( Tmp^ ), @Tmp^[ 1 ] )
  end
  else
    Inherited TranslatePut( P, pRecBuff, pSrc );
end;


Procedure TBtrSQLBaseTable.UpdateRecordBufferSize( pRecBuf : Pointer; T : TFieldCacheItem; iLen : LongInt );
begin
  Word( pRecBuf^ ) := T.DataOffset + iLen;
end;


Procedure TBtrSqlAggTable.FirstRecordRaw;
begin
  Inherited FirstRecordRaw;
  FRecNo := 1;
end;


Procedure TBtrSqlAggTable.LastRecordRaw;
begin
  Inherited LastRecordRaw;
  FRecNo := MaxLongInt;
end;


Procedure TBtrSqlAggTable.NextRecordRaw;
begin
  Inherited NextRecordRaw;
  Inc( FRecNo );
end;


Procedure TBtrSqlAggTable.PrevRecordRaw;
begin
  If ( FRecNo > 1 ) then
  begin
    Inherited PrevRecordRaw;
    Dec( FRecNo );
  end
  else
    ThrowBOFException;  
end;


Function TBtrSqlAggTable.GetBookMarkSize : Integer;
begin
  Result := SizeOf( LongInt );
end;


Procedure TBtrSqlAggTable.GetBookMark( P : Pointer );
begin
  Move( FRecNo, P^, GetBookMarkSize );
end;


Procedure TBtrSqlAggTable.SetToBookmark( P : Pointer );
var
  BookMark   : Longint;
  Buffer     : Pointer;
begin
  Buffer := AllocMem( BufferSize );
  Try
    BookMark := LongInt( P^ );
    State    := TblNoPos;
    Repeat
      GetNextRecord( dbiNOLOCK, Buffer, NIL );
      if ( FRecNo = BookMark ) then
        Break;
    Until FALSE;
  Finally
    FreeMem( Buffer, BufferSize );
  end;
  UpdateTableState;
end;


Procedure TBtrSqlAggTable.GetRecordWithBookMark( P, pRecBuff : Pointer; eLock : DBILockType );
begin
  DriverBuffer := pRecBuff;
  SetToBookMark( P );
  If ( eLock = DBIWRITELOCK ) then
    SqlOp( SSQL_FETCH_CURRENT + SSQL_NOWAIT_IMPLICIT_UNLOCK );
  UpdateTableState;
end;


Constructor TBtrSqlProcTable.Create( P : TObject; Container : TTitanCollection;
              Path : PChar; E, S : Bool; Q : PChar; pClientID : PBtrClientID );
var
  FileOnly : ShortString;
  tmp      : ShortString;
begin
  FileOnly := StrPas( Path ) + WBTRV_PROCTABLE_FILE;
  tmp      := FileOnly + BAPI_OWNER_TOKEN + WBTRV_DDF_OWNER + #0;
  Inherited Create( P, Container, @tmp[ 1 ], 0, dbiREADONLY, dbiOPENSHARED, pClientID );
  StrPCopy( @FBaseDesc.szFileName, FileOnly );
  FBtrDriver.IgnoreSizeError := TRUE;
  Extended  := E;
  System    := S;
  Qualifier := Q;
end;


Procedure TBtrSQLProcTable.GetNextRecord(
           eLock     : DBILockType;
           pRecBuff  : Pointer;
           pRecProps : pRECProps
         );
var
  Info : TProcDDF;
  Buff : ShortString;
begin
  Inherited GetNextRecord( eLock, @Info, pRecProps );
  if Assigned( pRecBuff ) then
  begin
    MoveZero( pRecBuff^, SizeOf( SPDesc ) );
    With SPDesc( pRecBuff^ ) Do
    begin
      Buff := ArrayToStrZ( Info.Xp_Name, SizeOf( Info.Xp_Name ) );
      StrLCopy( @szName, @Buff[ 1 ], Pred( SizeOf( szName ) ) );
    end;
  end;
end;


Function TBtrSQLProcTable.GetBufferSize : Word;
begin
  Result := SizeOf( TProcDDF );
end;


Type
  TDBListObject =
  Class( TObject )
    Desc : DBDesc;
    Constructor Create( D : DBDesc );
  end;


Constructor TDBListObject.Create( D : DBDesc );
begin
  Inherited Create;
  Desc := D;
end;


Constructor TSSQLDatabaseTable.Create( P : TObject; Container, CfgRecs : TTitanCollection;
              Name, Driver : PChar );
begin
  FDBList  := TTitanCollection.Create;
  FCfgRecs := CfgRecs;
  Inherited Create( P, Container, Name, NIL, 0, dbiREADONLY, dbiOPENEXCL );
end;


Destructor TSSQLDatabaseTable.Destroy;
begin
  FDBList.Free;
  Inherited Destroy;
end;


Procedure TSSQLDatabaseTable.InitTableStruct;
begin
  LoadTitanDatabaseNames;
  LoadSQLDatabaseNames( FALSE );
  LoadSQLDatabaseNames( TRUE  );
  FRecIndex := 0;
end;




Procedure TSSQLDatabaseTable.LoadTitanDatabaseNames;
var
  Desc    : DBDesc;
  TitanDB : TBaseDBListTable;
begin
  TitanDB := TRegDBListTable.Create( Self, NIL, FCfgRecs, BTRIEVESQL_DRIVER_DESC, @BtrTitanEnv );
  Try
    TitanDB.OpenTable;
    Try
      Repeat
        TitanDB.GetNextRecord( dbiNOLOCK, @Desc, NIL );
        FDBList.Insert( TDBListObject.Create( Desc ) );
      Until FALSE;
    Except
      On E:ETitanBoundryError do
        ;
    end;
  Finally
    TitanDB.Free;
  end;
end;


Procedure TSSQLDatabaseTable.LoadSQLDatabaseNames( Const IsRemote : Boolean );
var
  Desc   : DBDesc;
  Buff   : Array[1..SCALABLE_DB_NAME_SIZE] of Char;
  Count  : SmallInt;
  iLen   : SmallInt;
  NS     : PChar;
  i      : Word;
  S      : ShortString;
  Status : SmallInt;
begin
  If IsRemote then
  begin
    Status := SQLGetCountRemoteDatabaseNames( Count );
    NS     := SSQL_REMOTE_TYPE;
  end
  else
  begin
    Status := SQLGetCountDatabaseNames( Count );
    NS     := SSQL_LOCAL_TYPE;
  end;
  If ( Status <> ISAM_SUCCESS ) or ( Count = 0 ) then
    Exit;
  MoveZero( Buff, SizeOf( Buff ) );
  For i := 1 to Count do
  begin
    iLen := SizeOf( Buff );
    If IsRemote then
      Status := SQLGetRemoteDatabaseNames( iLen, Buff[ 1 ] )
    else
      Status := SQLGetDatabaseNames( iLen, Buff[ 1 ] );
    If ( iLen > 0 ) then
    begin
      MoveZero( Desc, SizeOf( Desc ) );
      With Desc do
      begin
        S := ArrayToStr( Buff, SizeOf( Buff ) );
        StrPCopy( @szName,   SSQL_DB_PREFIX + S );          { Logical name (Or alias) }
        StrCopy( @szText,    NS );                          { Descriptive Text }
        StrCopy( @szPhyName, @szName );                     { Physical name/path }
        StrCopy( @szDbType,  BTRIEVESQL_DRIVER_DESC );      { Database type }
      end;
      FDBList.Insert( TDBListObject.Create( Desc ) );
    end;
    If ( Status <> ISAM_SUCCESS ) then
      Break;
  end;
end;


Procedure TSSQLDatabaseTable.GetNextRecord(
           eLock     : DBILockType;
           pRecBuff  : Pointer;
           pRecProps : pRECProps
         );
var
  DescObj : TDBListObject;
begin
  ValidateParameter( pRecBuff );
  If ( FRecIndex < FDBList.Count ) then
  begin
    DescObj := TDBListObject( FDBList.Items[ FRecIndex ] );
    Inc( FRecIndex );
    If ( DescObj <> NIL ) then
    begin
      Move( DescObj.Desc, pRecBuff^, SizeOf( DBDesc ) );
      Exit;
    end;
  end;
  ThrowEOFException;
end;


end.
