fpc/packages/fcl-db/src/sqldb/oracle/oracleconnection.pp

unit oracleconnection;

{
    Copyright (c) 2006-2014 by Joost van der Sluis, FPC contributors

    Oracle RDBMS connector using the OCI protocol

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

 **********************************************************************}

{$mode objfpc}{$H+}

{$Define LinkDynamically}

interface

uses
  Classes, SysUtils, db, dbconst, sqldb, bufdataset,
{$IfDef LinkDynamically}
  ocidyn,
{$ELSE}
  oci,
{$ENDIF}
  oratypes;

const
  DefaultTimeOut = 60;

type
  EOraDatabaseError = class(ESQLDatabaseError)
    public
      property ORAErrorCode: integer read ErrorCode; deprecated 'Please use ErrorCode instead of ORAErrorCode'; // June 2014
  end;

  TOracleTrans = Class(TSQLHandle)
  protected
    FOciSvcCtx  : POCISvcCtx;
    FOciTrans   : POCITrans;
    FOciFlags   : ub4;
  public
    destructor Destroy(); override;
  end;
  
  TOraFieldBuf = record
    DescType : ub4;      // descriptor type
    Buffer   : pointer;
    Ind      : sb2;      // indicator
    Len      : ub4;
    Size     : ub4;
  end;

  TOracleCursor = Class(TSQLCursor)
    protected
      FOciStmt     : POCIStmt;
      FieldBuffers : array of TOraFieldBuf;
      ParamBuffers : array of TOraFieldBuf;
    end;

  { TOracleConnection }

  TOracleConnection = class (TSQLConnection)
  private
    FOciEnvironment : POciEnv;
    FOciError       : POCIError;
    FOciServer      : POCIServer;
    FOciUserSession : POCISession;
    FUserMem        : pointer;
    procedure HandleError;
    procedure GetParameters(cursor : TSQLCursor; AParams : TParams);
    procedure SetParameters(cursor : TSQLCursor; AParams : TParams);
  protected
    // - Connect/disconnect
    procedure DoInternalConnect; override;
    procedure DoInternalDisconnect; override;
    // - Handle (de)allocation
    function AllocateCursorHandle:TSQLCursor; override;
    procedure DeAllocateCursorHandle(var cursor:TSQLCursor); override;
    function AllocateTransactionHandle:TSQLHandle; override;
    // - Statement handling
    procedure PrepareStatement(cursor:TSQLCursor; ATransaction:TSQLTransaction; buf:string; AParams:TParams); override;
    procedure UnPrepareStatement(cursor:TSQLCursor); override;
    // - Transaction handling
    procedure InternalStartDBTransaction(trans:TOracleTrans);
    function GetTransactionHandle(trans:TSQLHandle):pointer; override;
    function StartDBTransaction(trans:TSQLHandle; AParams:string):boolean; override;
    function Commit(trans:TSQLHandle):boolean; override;
    function Rollback(trans:TSQLHandle):boolean; override;
    procedure CommitRetaining(trans:TSQLHandle); override;
    procedure RollbackRetaining(trans:TSQLHandle); override;
    // - Statement execution
    procedure Execute(cursor:TSQLCursor; ATransaction:TSQLTransaction; AParams:TParams); override;
    function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
    // - Result retrieval
    procedure AddFieldDefs(cursor:TSQLCursor; FieldDefs:TFieldDefs); override;
    function Fetch(cursor:TSQLCursor):boolean; override;
    function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer; out CreateBlob : boolean):boolean; override;
    procedure LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction); override;
    procedure FreeFldBuffers(cursor:TSQLCursor); override;
    procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); override;
    function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;

  public
    constructor Create(AOwner : TComponent); override;
  end;

  { TOracleConnectionDef }

  TOracleConnectionDef = Class(TConnectionDef)
    Class Function TypeName : String; override;
    Class Function ConnectionClass : TSQLConnectionClass; override;
    Class Function Description : String; override;
    Class Function DefaultLibraryName : String; override;
    Class Function LoadFunction : TLibraryLoadFunction; override;
    Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
    Class Function LoadedLibraryName: string; override;
  end;

implementation

uses
  math, StrUtils, FmtBCD;

const
  ObjectQuote='"'; //beginning and ending quote for objects such as table names. Note: can be different from quotes around field names

ResourceString
  SErrEnvCreateFailed = 'The creation of an Oracle environment failed.';
  SErrHandleAllocFailed = 'The allocation of the error handle failed.';
  SErrOracle = 'Oracle returned error %s:';

type
  TODateTime = record
    year  : sb2;
    month : ub1;
    day   : ub1;
    hour  : ub1;
    min   : ub1;
    sec   : ub1;
    fsec  : ub4;
  end;

// Callback functions

function cbf_no_data(ictxp:Pdvoid; bindp:POCIBind; iter:ub4; index:ub4; bufpp:PPdvoid;
             alenp:Pub4; piecep:Pub1; indp:PPdvoid):sb4;cdecl;

begin
  bufpp^ := nil;
  alenp^ := 0;
  indp^ := nil;
  piecep^ := OCI_ONE_PIECE;
  result:=OCI_CONTINUE;
end;


function cbf_get_data(octxp:Pdvoid; bindp:POCIBind; iter:ub4; index:ub4; bufpp:PPdvoid;
             alenp:PPub4; piecep:Pub1; indp:PPdvoid; rcodep:PPub2):sb4;cdecl;

begin
// Only 1 row can be stored. No support for multiple rows: only the last row is kept.
  bufpp^:=TOraFieldBuf(octxp^).Buffer;
  indp^ := @TOraFieldBuf(octxp^).Ind;
  TOraFieldBuf(octxp^).Len:=TOraFieldBuf(octxp^).Size;   //reset size to full buffer
  alenp^ := @TOraFieldBuf(octxp^).Len;
  rcodep^:=nil;
  piecep^ := OCI_ONE_PIECE;
  result:=OCI_CONTINUE;
end;

// Conversions

Procedure FmtBCD2Nvu(bcd:tBCD;b:pByte);
var
  i,j,cnt   : integer;
  nibbles   : array [0..maxfmtbcdfractionsize-1] of byte;
  exp       : shortint;
  bb        : byte;
begin
  fillchar(b[0],22,#0);
  if BCDPrecision(bcd)=0 then // zero, special case
    begin
    b[0]:=1;
    b[1]:=$80;
    end
  else
    begin
    if (BCDPrecision(bcd)-BCDScale(bcd)) mod 2 <>0 then // odd number before decimal point
      begin
      nibbles[0]:=0;
      j:=1;
      end
    else
      j:=0;
    for i:=0 to bcd.Precision -1 do
      if i mod 2 =0 then
        nibbles[i+j]:=bcd.Fraction[i div 2] shr 4
      else
        nibbles[i+j]:=bcd.Fraction[i div 2] and $0f;
    nibbles[bcd.Precision+j]:=0; // make sure last nibble is also 0 in case we have odd scale
    exp:=(BCDPrecision(bcd)-BCDScale(bcd)+1) div 2;
    cnt:=exp+(BCDScale(bcd)+1) div 2;
    // to avoid "ora 01438: value larger than specified precision allowed for this column"
    // remove trailing zeros (scale < 0)...
    while (nibbles[cnt*2-2]*10+nibbles[cnt*2-1])=0 do
      cnt:=cnt-1;
    // ... and remove leading zeros (scale > precision)
    j:=0;
    while (nibbles[j*2]*10+nibbles[j*2+1])=0 do
      begin
      j:=j+1;
      exp:=exp-1;
      end;
    if IsBCDNegative(bcd) then
      begin
      b[0]:=cnt-j+1;
      b[1]:=not(exp+64) and $7f ;
      for i:=j to cnt-1 do
        begin
        bb:=nibbles[i*2]*10+nibbles[i*2+1];
        b[2+i-j]:=101-bb;
        end;
      if 2+cnt-j<22 then  // add a 102 at the end of the number if place left.
        begin
        b[0]:=b[0]+1;
        b[2+cnt-j]:=102;
        end;
      end
    else
      begin
      b[0]:=cnt-j+1;
      b[1]:=(exp+64) or $80 ;
      for i:=j to cnt-1 do
        begin
        bb:=nibbles[i*2]*10+nibbles[i*2+1];
        b[2+i-j]:=1+bb;
        end;
      end;
    end;
end;

function Nvu2FmtBCE(b:pbyte):tBCD;
var
  i,j       : integer;
  bb,size   : byte;
  exp       : shortint;
  nibbles   : array [0..maxfmtbcdfractionsize-1] of byte;
  scale     : integer;
begin
  size := b[0];
  if (size=1) and (b[1]=$80) then // special representation for 0
    result:=IntegerToBCD(0)
  else
    begin
    result.SignSpecialPlaces:=0; //sign positive, non blank, scale 0
    result.Precision:=1;         //BCDNegate works only if Precision <>0
    if (b[1] and $80)=$80 then // then the number is positive
      begin
      exp := (b[1] and $7f)-65;
      for i := 0 to size-2 do
        begin
        bb := b[i+2]-1;
        nibbles[i*2]:=bb div 10;
        nibbles[i*2+1]:=(bb mod 10);
        end;
      end
    else
      begin
      BCDNegate(result);
      exp := (not(b[1]) and $7f)-65;
      if b[size]=102 then  // last byte doesn't count if = 102
        size:=size-1;
      for i := 0 to size-2 do
        begin
        bb := 101-b[i+2];
        nibbles[i*2]:=bb div 10;
        nibbles[i*2+1]:=(bb mod 10);
        end;
      end;
    nibbles[(size-1)*2]:=0;
    result.Precision:=(size-1)*2;
    scale:=result.Precision-(exp*2+2);
    if scale>=0 then
      begin
      if (scale>result.Precision) then  // need to add leading 0s
        begin
        for i:=0 to (scale-result.Precision+1) div 2 do
          result.Fraction[i]:=0;
        i:=scale-result.Precision;
        result.Precision:=scale;
        end
      else
        i:=0;
      j:=i;
      if (i=0) and (nibbles[0]=0) then // get rid of leading zero received from oci
        begin
        result.Precision:=result.Precision-1;
        j:=-1;
        end;
      while i<=result.Precision do // copy nibbles
        begin
        if i mod 2 =0 then
          result.Fraction[i div 2]:=nibbles[i-j] shl 4
        else
          result.Fraction[i div 2]:=result.Fraction[i div 2] or nibbles[i-j];
        i:=i+1;
        end;
      result.SignSpecialPlaces:=result.SignSpecialPlaces or scale;
      end
    else
      begin // add trailing zeroes, increase precision to take them into account
      i:=0;
      while i<=result.Precision do // copy nibbles
        begin
        if i mod 2 =0 then
          result.Fraction[i div 2]:=nibbles[i] shl 4
        else
          result.Fraction[i div 2]:=result.Fraction[i div 2] or nibbles[i];
        i:=i+1;
        end;
      result.Precision:=result.Precision-scale;
      for i := size -1 to High(result.Fraction) do
        result.Fraction[i] := 0;
      end;
    end;
end;



// TOracleConnection

procedure TOracleConnection.HandleError;

var errcode : sb4;
    buf     : array[0..1023] of char;
    E       : EOraDatabaseError;

begin
  OCIErrorGet(FOciError,1,nil,errcode,@buf[0],1024,OCI_HTYPE_ERROR);

  if (Self.Name <> '') then
    E := EOraDatabaseError.CreateFmt('%s : %s',[Self.Name,pchar(buf)])
  else
    E := EOraDatabaseError.Create(pchar(buf));

  E.ErrorCode := errcode;
  Raise E;
end;

procedure TOracleConnection.GetParameters(cursor: TSQLCursor; AParams: TParams);
var
    i    : integer;
    odt  : TODateTime;
    s    : string;

begin
  with cursor as TOracleCursor do for i := 0 to High(ParamBuffers) do
    with AParams[i] do
      if ParamType=ptOutput then
      begin
      if ParamBuffers[i].ind = -1 then
        Value:=null;

      case DataType of
        ftInteger         : AsInteger := PInteger(ParamBuffers[i].buffer)^;
        ftFloat           : AsFloat := PDouble(ParamBuffers[i].buffer)^;
        ftString          : begin
                            SetLength(s,ParamBuffers[i].Len);
                            move(ParamBuffers[i].buffer^,s[1],length(s)+1);
                            AsString:=s;
                            end;
        ftDate, ftDateTime: begin
                            OCIDateTimeGetDate(FOciUserSession, FOciError, ParamBuffers[i].buffer, @odt.year, @odt.month, @odt.day);
                            OCIDateTimeGetTime(FOciUserSession, FOciError, ParamBuffers[i].buffer, @odt.hour, @odt.min, @odt.sec, @odt.fsec);
                            AsDateTime := ComposeDateTime(EncodeDate(odt.year,odt.month,odt.day), EncodeTime(odt.hour,odt.min,odt.sec,odt.fsec div 1000000));
                            end;
        ftFMTBcd          : begin
                            AsFMTBCD:=Nvu2FmtBCE(ParamBuffers[i].buffer);
                            end;
        end;

      end;

end;

procedure TOracleConnection.DoInternalConnect;

var
  ConnectString : string;
  TempServiceContext : POCISvcCtx;

begin
{$IfDef LinkDynamically}
  InitialiseOCI;
{$EndIf}

  inherited DoInternalConnect;
  //todo: get rid of FUserMem, as it isn't used
  FUserMem := nil;

  // Create environment handle
  if OCIEnvCreate(FOciEnvironment,oci_default,nil,nil,nil,nil,0,FUserMem) <> OCI_SUCCESS then
    DatabaseError(SErrEnvCreateFailed,self);
  // Create error handle
  if OciHandleAlloc(FOciEnvironment,FOciError,OCI_HTYPE_ERROR,0,FUserMem) <> OCI_SUCCESS then
    DatabaseError(SErrHandleAllocFailed,self);
  // Create Server handle
  if OciHandleAlloc(FOciEnvironment,FOciServer,OCI_HTYPE_SERVER,0,FUserMem) <> OCI_SUCCESS then
    DatabaseError(SErrHandleAllocFailed,self);
  // Initialize Server handle
  if hostname='' then connectstring := databasename
  else connectstring := '//'+hostname+'/'+databasename;
  if OCIServerAttach(FOciServer,FOciError,@(ConnectString[1]),Length(ConnectString),OCI_DEFAULT) <> OCI_SUCCESS then
    HandleError();

  // Create temporary service-context handle for user authentication
  if OciHandleAlloc(FOciEnvironment,TempServiceContext,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
    DatabaseError(SErrHandleAllocFailed,self);

  // Create user-session handle
  if OciHandleAlloc(FOciEnvironment,FOciUserSession,OCI_HTYPE_SESSION,0,FUserMem) <> OCI_SUCCESS then
    DatabaseError(SErrHandleAllocFailed,self);
  // Set the server-handle in the service-context handle
  if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
    HandleError();
  // Set username and password in the user-session handle
  if OCIAttrSet(FOciUserSession,OCI_HTYPE_SESSION,@(Self.UserName[1]),Length(Self.UserName),OCI_ATTR_USERNAME,FOciError) <> OCI_SUCCESS then
    HandleError();
  if OCIAttrSet(FOciUserSession,OCI_HTYPE_SESSION,@(Self.Password[1]),Length(Self.Password),OCI_ATTR_PASSWORD,FOciError) <> OCI_SUCCESS then
    HandleError();
  // Authenticate
  if OCISessionBegin(TempServiceContext,FOciError,FOcIUserSession,OCI_CRED_RDBMS,OCI_DEFAULT) <> OCI_SUCCESS then
    HandleError();
  // Free temporary service-context handle
  OCIHandleFree(TempServiceContext,OCI_HTYPE_SVCCTX);
end;

procedure TOracleConnection.DoInternalDisconnect;
var
  TempServiceContext : POCISvcCtx;
begin
  inherited DoInternalDisconnect;

  // Create temporary service-context handle for user-disconnect
  if OciHandleAlloc(FOciEnvironment,TempServiceContext,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
    DatabaseError(SErrHandleAllocFailed,self);

  // Set the server handle in the service-context handle
  if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
    HandleError();
  // Set the user session handle in the service-context handle
  if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciUserSession,0,OCI_ATTR_SESSION,FOciError) <> OCI_SUCCESS then
    HandleError();
  // Disconnect uses-session handle
  if OCISessionEnd(TempServiceContext,FOciError,FOcIUserSession,OCI_DEFAULT) <> OCI_SUCCESS then
    HandleError();
  // Free user-session handle
  OCIHandleFree(FOciUserSession,OCI_HTYPE_SESSION);
  // Free temporary service-context handle
  OCIHandleFree(TempServiceContext,OCI_HTYPE_SVCCTX);

  // Disconnect server handle
  if OCIServerDetach(FOciServer,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
    HandleError();

  // Free connection handles
  OCIHandleFree(FOciServer,OCI_HTYPE_SERVER);
  OCIHandleFree(FOciError,OCI_HTYPE_ERROR);
  OCIHandleFree(FOciEnvironment,OCI_HTYPE_ENV);
{$IfDef LinkDynamically}
  ReleaseOCI;
{$EndIf}

end;

function TOracleConnection.AllocateCursorHandle: TSQLCursor;

var Cursor : TOracleCursor;

begin
  Cursor:=TOracleCursor.Create;
  Result := cursor;
end;

procedure TOracleConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);

  procedure FreeOraFieldBuffers(b: array of TOraFieldBuf);
  var i : integer;
  begin
    if Length(b) > 0 then
      for i := low(b) to high(b) do
        if b[i].DescType <> 0 then
          OciDescriptorFree(b[i].buffer, b[i].DescType)
        else
          freemem(b[i].buffer);
  end;

begin
  with cursor as TOracleCursor do
    begin
    FreeOraFieldBuffers(FieldBuffers);
    FreeOraFieldBuffers(ParamBuffers);
    end;
  FreeAndNil(cursor);
end;

function TOracleConnection.AllocateTransactionHandle: TSQLHandle;
var
  locRes : TOracleTrans;
begin
  locRes := TOracleTrans.Create();
  try
    // Allocate service-context handle
    if OciHandleAlloc(FOciEnvironment,locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
      DatabaseError(SErrHandleAllocFailed,self);
    // Set the server-handle in the service-context handle
    if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
      HandleError();
    // Set the user-session handle in the service-context handle
    if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,FOciUserSession,0,OCI_ATTR_SESSION,FOciError) <> OCI_SUCCESS then
      HandleError();

    // Allocate transaction handle
    if OciHandleAlloc(FOciEnvironment,locRes.FOciTrans,OCI_HTYPE_TRANS,0,FUserMem) <> OCI_SUCCESS then
      DatabaseError(SErrHandleAllocFailed,self);
    // Set the transaction handle in the service-context handle
    if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,locRes.FOciTrans,0,OCI_ATTR_TRANS,FOciError) <> OCI_SUCCESS then
      HandleError();
  except
    locRes.Free();
    raise;
  end;
  Result := locRes;
end;

procedure TOracleConnection.PrepareStatement(cursor: TSQLCursor;
  ATransaction: TSQLTransaction; buf: string; AParams: TParams);
  
var i        : integer;
    FOcibind : POCIDefine;
    
    OFieldType   : ub2;
    OFieldSize   : sb4;
    ODescType    : ub4;
    OBuffer      : pointer;

    stmttype     : ub2;

begin
  with cursor as TOracleCursor do
    begin
    if OCIStmtPrepare2(TOracleTrans(ATransaction.Handle).FOciSvcCtx,FOciStmt,FOciError,@buf[1],length(buf),nil,0,OCI_NTV_SYNTAX,OCI_DEFAULT) = OCI_ERROR then
      HandleError;
    // Get statement type
    if OCIAttrGet(FOciStmt,OCI_HTYPE_STMT,@stmttype,nil,OCI_ATTR_STMT_TYPE,FOciError) = OCI_ERROR then
      HandleError;
    case stmttype of
      OCI_STMT_SELECT: FStatementType := stSelect;
      OCI_STMT_UPDATE: FStatementType := stUpdate;
      OCI_STMT_DELETE: FStatementType := stDelete;
      OCI_STMT_INSERT: FStatementType := stInsert;
      OCI_STMT_CREATE,
      OCI_STMT_DROP,
      OCI_STMT_DECLARE,
      OCI_STMT_ALTER:  FStatementType := stDDL;
    else
      FStatementType := stUnknown;
    end;
    if FStatementType in [stUpdate,stDelete,stInsert,stDDL] then
      FSelectable:=false;
    if assigned(AParams) then
      begin
      setlength(ParamBuffers,AParams.Count);
      for i := 0 to AParams.Count-1 do
        begin
        ODescType := 0;
        case AParams[i].DataType of
          ftSmallInt, ftInteger :
            begin OFieldType := SQLT_INT; OFieldSize := sizeof(integer); end;
          ftLargeInt :
            begin OFieldType := SQLT_INT; OFieldSize := sizeof(int64); end;
          ftFloat :
            begin OFieldType := SQLT_FLT; OFieldSize := sizeof(double); end;
          ftDate, ftDateTime :
            begin OFieldType := SQLT_TIMESTAMP; OFieldSize := sizeof(pointer); ODescType := OCI_DTYPE_TIMESTAMP; end;
          ftFixedChar, ftString :
            begin OFieldType := SQLT_STR; OFieldSize := 4000; end;
          ftFMTBcd, ftBCD :
            begin OFieldType := SQLT_VNU; OFieldSize := 22; end;
          ftBlob :
            begin OFieldType := SQLT_LVB; OFieldSize := 65535; end;
          ftMemo :
            begin OFieldType := SQLT_LVC; OFieldSize := 65535; end;
        else
          DatabaseErrorFmt(SUnsupportedParameter,[Fieldtypenames[AParams[i].DataType]],self);
        end;

        ParamBuffers[i].DescType := ODescType;
        ParamBuffers[i].Len      := OFieldSize;
        ParamBuffers[i].Size     := OFieldSize;
        if ODescType <> 0 then
          begin
          OBuffer := @ParamBuffers[i].buffer;
          OCIDescriptorAlloc(FOciEnvironment, OBuffer, ODescType, 0, nil);
          end
        else
          begin
          OBuffer := getmem(OFieldSize);
          ParamBuffers[i].buffer := OBuffer;
          end;

        FOciBind := nil;

        if AParams[i].ParamType=ptInput then
          begin
          if OCIBindByName(FOciStmt,FOcibind,FOciError,pchar(AParams[i].Name),length(AParams[i].Name),OBuffer,OFieldSize,OFieldType,@ParamBuffers[i].ind,nil,nil,0,nil,OCI_DEFAULT )= OCI_ERROR then
            HandleError;
          end
        else if AParams[i].ParamType=ptOutput then
          begin
          if OCIBindByName(FOciStmt,FOcibind,FOciError,pchar(AParams[i].Name),length(AParams[i].Name),nil,OFieldSize,OFieldType,nil,nil,nil,0,nil,OCI_DATA_AT_EXEC )= OCI_ERROR then
            HandleError;
          if OCIBindDynamic(FOcibind, FOciError, nil, @cbf_no_data, @parambuffers[i], @cbf_get_data) <> OCI_SUCCESS then
            HandleError;
          end;
        end;
      end;
    FPrepared := True;
    end;
end;

procedure TOracleConnection.SetParameters(cursor : TSQLCursor; AParams : TParams);

var i              : integer;
    year, month, day, hour, min, sec, msec : word;
    s              : string;
    blobbuf        : string;
    bloblen        : ub4;

begin
  with cursor as TOracleCursor do for i := 0 to High(ParamBuffers) do with AParams[i] do
    if ParamType=ptInput then
      begin
      if IsNull then ParamBuffers[i].ind := -1 else ParamBuffers[i].ind := 0;

      case DataType of
        ftSmallInt,
        ftInteger         : PInteger(ParamBuffers[i].buffer)^ := AsInteger;
        ftLargeInt        : PInt64(ParamBuffers[i].buffer)^ := AsLargeInt;
        ftFloat           : PDouble(ParamBuffers[i].buffer)^ := AsFloat;
        ftString,
        ftFixedChar       : begin
                            s := asString+#0;
                            move(s[1],parambuffers[i].buffer^,length(s)+1);
                            end;
        ftDate, ftDateTime: begin
                            DecodeDate(asDateTime,year,month,day);
                            DecodeTime(asDateTime,hour,min,sec,msec);
                            if OCIDateTimeConstruct(FOciUserSession, FOciError, ParamBuffers[i].buffer, year, month, day, hour, min, sec, msec*1000000, nil, 0) = OCI_ERROR then
                              HandleError;
{                           pb := ParamBuffers[i].buffer;
                            pb[0] := (year div 100)+100;
                            pb[1] := (year mod 100)+100;
                            pb[2] := month;
                            pb[3] := day;
                            pb[4] := hour+1;
                            pb[5] := minute+1;
                            pb[6] := second+1;
}
                            end;
        ftFmtBCD, ftBCD   : begin
                            FmtBCD2Nvu(asFmtBCD,parambuffers[i].buffer);
                            end;
        ftBlob, ftMemo    : begin
                            blobbuf := AsBlob; // todo: use AsBytes
                            bloblen := length(blobbuf);
                            if bloblen > 65531 then bloblen := 65531;
                            PInteger(ParamBuffers[i].Buffer)^ := bloblen;
                            Move(blobbuf[1], (ParamBuffers[i].Buffer+sizeof(integer))^, bloblen);
                            //if OciLobWrite(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, ParamBuffers[i].buffer, @bloblen, 1, @blobbuf[1], bloblen, OCI_ONE_PIECE, nil, nil, 0, SQLCS_IMPLICIT) = OCI_ERROR then
                            //  HandleError;
                            end;
        else
          DatabaseErrorFmt(SUnsupportedParameter,[DataType],self);
      end;

      end;

end;

procedure TOracleConnection.UnPrepareStatement(cursor: TSQLCursor);
begin
  if OCIStmtRelease(TOracleCursor(cursor).FOciStmt,FOciError,nil,0,OCI_DEFAULT)<> OCI_SUCCESS then
    HandleError();
  cursor.FPrepared:=False;
end;

procedure TOracleConnection.InternalStartDBTransaction(trans : TOracleTrans);
begin
  if OCITransStart(trans.FOciSvcCtx,FOciError,DefaultTimeOut,trans.FOciFlags) <> OCI_SUCCESS then
    HandleError();
end;

function TOracleConnection.GetTransactionHandle(trans: TSQLHandle): pointer;
begin
  Result := trans;
end;

function TOracleConnection.StartDBTransaction(trans: TSQLHandle; AParams: string): boolean;
var
  x_flags : ub4;
  i : Integer;
  s : string;
  locTrans : TOracleTrans;
begin
  locTrans := TOracleTrans(trans);
  if ( Length(AParams) = 0 ) then begin
    x_flags := OCI_TRANS_NEW or OCI_TRANS_READWRITE;
  end else begin
    x_flags := OCI_DEFAULT;
    i := 1;
    s := ExtractSubStr(AParams,i,StdWordDelims);
    while ( s <> '' ) do begin
      if ( s = 'readonly' ) then
        x_flags := x_flags and OCI_TRANS_READONLY
      else if ( s = 'serializable' ) then
        x_flags := x_flags and OCI_TRANS_SERIALIZABLE
      else if ( s = 'readwrite' ) then
        x_flags := x_flags and OCI_TRANS_READWRITE;
      s := ExtractSubStr(AParams,i,StdWordDelims);
    end;
    x_flags := x_flags and OCI_TRANS_NEW;
  end;
  locTrans.FOciFlags := x_flags;
  InternalStartDBTransaction(locTrans);
  Result := True;
end;

function TOracleConnection.Commit(trans: TSQLHandle): boolean;
begin
  if OCITransCommit(TOracleTrans(trans).FOciSvcCtx,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
    HandleError();
  Result := True;
end;

function TOracleConnection.Rollback(trans: TSQLHandle): boolean;
begin
  if OCITransRollback(TOracleTrans(trans).FOciSvcCtx,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
    HandleError();
  Result := True;
end;

procedure TOracleConnection.CommitRetaining(trans: TSQLHandle);
begin
  Commit(trans);
  InternalStartDBTransaction(TOracleTrans(trans));
end;

procedure TOracleConnection.RollbackRetaining(trans: TSQLHandle);
begin
  Rollback(trans);
  InternalStartDBTransaction(TOracleTrans(trans));
end;

procedure TOracleConnection.Execute(cursor: TSQLCursor; ATransaction: TSQLTransaction; AParams: TParams);
begin
  if Assigned(AParams) and (AParams.Count > 0) then SetParameters(cursor, AParams);
  if cursor.FStatementType = stSelect then
    begin
    if OCIStmtExecute(TOracleTrans(ATransaction.Handle).FOciSvcCtx,(cursor as TOracleCursor).FOciStmt,FOciError,0,0,nil,nil,OCI_DEFAULT) = OCI_ERROR then
      HandleError;
    end
  else
    begin
    if OCIStmtExecute(TOracleTrans(ATransaction.Handle).FOciSvcCtx,(cursor as TOracleCursor).FOciStmt,FOciError,1,0,nil,nil,OCI_DEFAULT) = OCI_ERROR then
      HandleError;
    if Assigned(AParams) and (AParams.Count > 0) then GetParameters(cursor, AParams);
    end;
end;

function TOracleConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;
var rowcount: ub4;
begin
  if Assigned(cursor) and (OCIAttrGet((cursor as TOracleCursor).FOciStmt, OCI_HTYPE_STMT, @rowcount, nil, OCI_ATTR_ROW_COUNT, FOciError) = OCI_SUCCESS) then
    Result:=rowcount
  else
    Result:=inherited RowsAffected(cursor);
end;

procedure TOracleConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);

var Param      : POCIParam;
    counter    : ub4;

    FieldType  : TFieldType;
    FieldName  : string;
    FieldSize  : cardinal;

    OFieldType   : ub2;
    OFieldName   : Pchar;
    OFieldSize   : ub4;
    OFNameLength : ub4;
    NumCols      : ub4;
    FOciDefine   : POCIDefine;
    OPrecision   : sb2;
    OScale       : sb1;
    ODescType    : ub4;
    OBuffer      : pointer;

begin
  Param := nil;
  with cursor as TOracleCursor do
    begin
    if OCIAttrGet(FOciStmt,OCI_HTYPE_STMT,@numcols,nil,OCI_ATTR_PARAM_COUNT,FOciError) = OCI_ERROR then
      HandleError;

    // Note: needs to be cleared then allocated in one go.
    Setlength(FieldBuffers,numcols);

    for counter := 1 to numcols do
      begin
      // Clear OFieldSize. Oracle 9i, 10g doc says *ub4 but some clients use *ub2 leaving
      // high 16 bit untouched resulting in huge values and ORA-01062
      // WARNING: this does not work on big endian systems !!!!
      // To be tested if BE systems have this *ub2<->*ub4 problem
      OFieldSize:=0;
      ODescType :=0;

      if OCIParamGet(FOciStmt,OCI_HTYPE_STMT,FOciError,Param,counter) = OCI_ERROR then
        HandleError;

      if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldType,nil,OCI_ATTR_DATA_TYPE,FOciError) = OCI_ERROR then
        HandleError;

      if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldSize,nil,OCI_ATTR_DATA_SIZE,FOciError) = OCI_ERROR then
        HandleError;

      FieldSize := 0;
      
      case OFieldType of
        OCI_TYPECODE_NUMBER   : begin
                                if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oprecision,nil,OCI_ATTR_PRECISION,FOciError) = OCI_ERROR then
                                  HandleError;
                                if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oscale,nil,OCI_ATTR_SCALE,FOciError) = OCI_ERROR then
                                  HandleError;
                                if (Oscale = 0) and (Oprecision < 10) then
                                  begin
                                  if Oprecision=0 then //Number(0,0) = number(32,4)
                                    begin
                                    FieldType := ftFMTBCD;
                                    FieldSize := 4;
                                    OFieldType := SQLT_VNU;
                                    OFieldSize:= 22;
                                    end
                                  else if Oprecision < 5 then
                                    begin
                                    FieldType := ftSmallint;
                                    OFieldType := SQLT_INT;
                                    OFieldSize := sizeof(smallint);
                                    end
                                  else // OPrecision=5..9, OScale=0
                                    begin
                                    FieldType := ftInteger;
                                    OFieldType := SQLT_INT;
                                    OFieldSize:= sizeof(integer);
                                    end;
                                  end
                                else if (Oscale = -127) {and (OPrecision=0)} then
                                  begin
                                  FieldType := ftFloat;
                                  OFieldType := SQLT_FLT;
                                  OFieldSize:=sizeof(double);
                                  end
                                else if (Oscale >=0) and (Oscale <=4) and (OPrecision<=12) then
                                  begin
                                  FieldType := ftBCD;
                                  FieldSize := oscale;
                                  OFieldType := SQLT_VNU;
                                  OFieldSize:= 22;
                                  end
                                else if (OPrecision-Oscale<64) and (Oscale < 64) then // limited to 63 digits before or after decimal point
                                  begin
                                  FieldType := ftFMTBCD;
                                  FieldSize := oscale;
                                  OFieldType := SQLT_VNU;
                                  OFieldSize:= 22;
                                  end
                                else // approximation with double, best we can do
                                  begin
                                  FieldType := ftFloat;
                                  OFieldType := SQLT_FLT;
                                  OFieldSize:=sizeof(double);
                                  end;
                                end;
        SQLT_LNG,
        OCI_TYPECODE_CHAR,
        OCI_TYPECODE_VARCHAR,
        OCI_TYPECODE_VARCHAR2 : begin
                                FieldType := ftString;
                                FieldSize := OFieldSize;
                                inc(OFieldSize);
                                OFieldType:=SQLT_STR;
                                end;
        OCI_TYPECODE_DATE     : FieldType := ftDate;
        OCI_TYPECODE_TIMESTAMP,
        OCI_TYPECODE_TIMESTAMP_LTZ,
        OCI_TYPECODE_TIMESTAMP_TZ :
                                begin
                                FieldType := ftDateTime;
                                OFieldType := SQLT_TIMESTAMP;
                                ODescType := OCI_DTYPE_TIMESTAMP;
                                end;
        OCI_TYPECODE_BFLOAT,
        OCI_TYPECODE_BDOUBLE  : begin
                                FieldType := ftFloat;
                                OFieldType := SQLT_BDOUBLE;
                                OFieldSize := sizeof(double);
                                end;
        SQLT_BLOB             : begin
                                FieldType := ftBlob;
                                ODescType := OCI_DTYPE_LOB;
                                end;
        SQLT_CLOB             : begin
                                FieldType := ftMemo;
                                ODescType := OCI_DTYPE_LOB;
                                end
      else
        FieldType := ftUnknown;
      end;

      FieldBuffers[counter-1].DescType := ODescType;
      if ODescType <> 0 then
        begin
        OBuffer := @FieldBuffers[counter-1].buffer;
        OCIDescriptorAlloc(FOciEnvironment, OBuffer, ODescType, 0, nil);
        OFieldSize := sizeof(pointer);
        end
      else
        begin
        OBuffer := getmem(OFieldSize);
        FieldBuffers[counter-1].buffer := OBuffer;
        end;

      if FieldType <> ftUnknown then
        begin
        FOciDefine := nil;
        if OciDefineByPos(FOciStmt,FOciDefine,FOciError,counter,OBuffer,OFieldSize,OFieldType,@FieldBuffers[counter-1].ind,nil,nil,OCI_DEFAULT) = OCI_ERROR then
          HandleError;
        end;

      if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldName,@OFNameLength,OCI_ATTR_NAME,FOciError) <> OCI_SUCCESS then
        HandleError;

      setlength(Fieldname,OFNameLength);
      move(OFieldName^,Fieldname[1],OFNameLength);

      FieldDefs.Add(FieldDefs.MakeNameUnique(FieldName), FieldType, FieldSize, False, counter);
      end;
  end;
end;

function TOracleConnection.Fetch(cursor: TSQLCursor): boolean;
begin
  case OCIStmtFetch2((cursor as TOracleCursor).FOciStmt,FOciError,1,OCI_FETCH_NEXT,1,OCI_DEFAULT) of
    OCI_ERROR   : begin
                  Result := False;
                  HandleError;
                  end;
    OCI_NO_DATA : Result := False;
    OCI_SUCCESS : Result := True;
    OCI_SUCCESS_WITH_INFO : Begin
                            Result := True;
                            HandleError;
                            end;
  end; {case}
end;

function TOracleConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer; out CreateBlob : boolean): boolean;

var
  b       : pbyte;
  size,i  : byte;
  exp     : shortint;
  cur     : Currency;
  odt     : TODateTime;

begin
  CreateBlob := False;
  with cursor as TOracleCursor do if fieldbuffers[FieldDef.FieldNo-1].ind = -1 then
    Result := False
  else
    begin
    Result := True;
    case FieldDef.DataType of
      ftString :
        move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,FieldDef.Size);
      ftBCD :
        begin
        b := fieldbuffers[FieldDef.FieldNo-1].buffer;
        size := b[0];
        cur := 0;
        if (b[1] and $80)=$80 then // the number is positive
          begin
          exp := (b[1] and $7f)-65;
          for i := 2 to size do
            cur := cur + (b[i]-1) * intpower(100,-(i-2)+exp);
          end
        else
          begin
          exp := (not(b[1]) and $7f)-65;
          for i := 2 to size-1 do
            cur := cur + (101-b[i]) * intpower(100,-(i-2)+exp);
          cur := -cur;
          end;
        move(cur,buffer^,SizeOf(Currency));
        end;
      ftFmtBCD :
        pBCD(buffer)^:= Nvu2FmtBCE(fieldbuffers[FieldDef.FieldNo-1].buffer);
      ftFloat :
        move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(double));
      ftSmallInt :
        move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(smallint));
      ftInteger :
        move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(integer));
      ftDate :
        begin
        b := fieldbuffers[FieldDef.FieldNo-1].buffer;
        PDateTime(buffer)^ := ComposeDateTime(EncodeDate((b[0]-100)*100+(b[1]-100),b[2],b[3]), EncodeTime(b[4]-1, b[5]-1, b[6]-1, 0));
        end;
      ftDateTime :
        begin
        OCIDateTimeGetDate(FOciUserSession, FOciError, FieldBuffers[FieldDef.FieldNo-1].buffer, @odt.year, @odt.month, @odt.day);
        OCIDateTimeGetTime(FOciUserSession, FOciError, FieldBuffers[FieldDef.FieldNo-1].buffer, @odt.hour, @odt.min, @odt.sec, @odt.fsec);
        PDateTime(buffer)^ := ComposeDateTime(EncodeDate(odt.year,odt.month,odt.day), EncodeTime(odt.hour,odt.min,odt.sec,odt.fsec div 1000000));
        end;
      ftBlob,
      ftMemo :
        CreateBlob := True;
    else
      Result := False;
    end;
    end;
end;

procedure TOracleConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
var LobLocator: pointer;
    len: ub4;
begin
  LobLocator := (cursor as TOracleCursor).FieldBuffers[FieldDef.FieldNo-1].Buffer;
  //if OCILobLocatorIsInit(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, LobLocator, @is_init) = OCI_ERROR then
  //  HandleError;
  if OciLobGetLength(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, LobLocator, @len) = OCI_ERROR then
    HandleError;
  // Len - For character LOBs, it is the number of characters, for binary LOBs and BFILEs it is the number of bytes
  ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer, len);
  ABlobBuf^.BlobBuffer^.Size := len;
  if OciLobRead(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, LobLocator, @len, 1, ABlobBuf^.BlobBuffer^.Buffer, len, nil, nil, 0, SQLCS_IMPLICIT) = OCI_ERROR then
    HandleError;
end;

procedure TOracleConnection.FreeFldBuffers(cursor: TSQLCursor);
begin
//  inherited FreeFldBuffers(cursor);
end;

procedure TOracleConnection.UpdateIndexDefs(IndexDefs: TIndexDefs;
  TableName: string);
var qry : TSQLQuery;

begin
  if not assigned(Transaction) then
    DatabaseError(SErrConnTransactionnSet);

  // Get table name into canonical format
  if (length(TableName)>2) and (TableName[1]=ObjectQuote) and (TableName[length(TableName)]=ObjectQuote) then
    TableName := AnsiDequotedStr(TableName, ObjectQuote)
  else
    TableName := UpperCase(TableName); //ANSI SQL: the name of an identifier (such as table names) are implicitly converted to uppercase, unless double quotes are used when referring to the identifier.

  qry := tsqlquery.Create(nil);
  qry.transaction := Transaction;
  qry.database := Self;
  with qry do
    begin
    ReadOnly := True;
    sql.clear;
    sql.add('SELECT '+
              'i.INDEX_NAME,  '+
              'c.COLUMN_NAME, '+
              'p.CONSTRAINT_TYPE '+
            'FROM ALL_INDEXES i, ALL_IND_COLUMNS c,ALL_CONSTRAINTS p  '+
            'WHERE '+
              'i.OWNER=c.INDEX_OWNER AND '+
              'i.INDEX_NAME=c.INDEX_NAME AND '+
              'p.INDEX_NAME(+)=i.INDEX_NAME AND '+
              'c.TABLE_NAME = ''' + TableName + ''' '+
            'ORDER by i.INDEX_NAME,c.COLUMN_POSITION');
    open;
    end;
  while not qry.eof do with IndexDefs.AddIndexDef do
    begin
    Name := trim(qry.fields[0].asstring);
    Fields := trim(qry.Fields[1].asstring);
    If UpperCase(qry.fields[2].asString)='P' then options := options + [ixPrimary];
    If UpperCase(qry.fields[2].asString)='U' then options := options + [ixUnique];
    qry.next;
    while (name = qry.fields[0].asstring) and (not qry.eof) do
      begin
      Fields := Fields + ';' + trim(qry.Fields[2].asstring);
      qry.next;
      end;
    end;
  qry.close;
  qry.free;
end;

function TOracleConnection.GetSchemaInfoSQL(SchemaType: TSchemaType;
  SchemaObjectName, SchemaPattern: string): string;
var s : string;

begin
  case SchemaType of
    stTables     : s := 'SELECT '+
                          '''' + DatabaseName + ''' as catalog_name, '+
                          'sys_context( ''userenv'', ''current_schema'' ) as schema_name, '+
                          'TABLE_NAME '+
                        'FROM USER_CATALOG ' +
                        'WHERE '+
                          'TABLE_TYPE<>''SEQUENCE'' '+
                        'ORDER BY TABLE_NAME';

    stSysTables  : s := 'SELECT '+
                          '''' + DatabaseName + ''' as catalog_name, '+
                          'OWNER as schema_name, '+
                          'TABLE_NAME '+
                        'FROM ALL_CATALOG ' +
                        'WHERE '+
                          'TABLE_TYPE<>''SEQUENCE'' '+
                        'ORDER BY TABLE_NAME';
    stColumns    : s := 'SELECT '+
                          'COLUMN_NAME, '+
                          'DATA_TYPE as column_datatype, '+
                          'CHARACTER_SET_NAME, '+
                          'NULLABLE as column_nullable, '+
                          'DATA_LENGTH as column_length, '+
                          'DATA_PRECISION as column_precision, '+
                          'DATA_SCALE as column_scale '+
                          {DATA_DEFAULT is type LONG; no support for that in oracleconnection so removed this from query}
                        'FROM ALL_TAB_COLUMNS '+
                        'WHERE Upper(TABLE_NAME) = '''+UpperCase(SchemaObjectName)+''' '+
                        'ORDER BY COLUMN_NAME';
    // Columns of tables, views and clusters accessible to user; hidden columns are filtered out.												
    stProcedures : s := 'SELECT '+
                          'case when PROCEDURE_NAME is null then OBJECT_NAME ELSE OBJECT_NAME || ''.'' || PROCEDURE_NAME end AS procedure_name '+
                        'FROM USER_PROCEDURES ';
  else
    DatabaseError(SMetadataUnavailable)
  end; {case}
  result := s;
end;

constructor TOracleConnection.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FConnOptions := FConnOptions + [sqEscapeRepeat];
  FUserMem := nil;
end;

{ TOracleConnectionDef }

class function TOracleConnectionDef.TypeName: String;
begin
  Result:='Oracle';
end;

class function TOracleConnectionDef.ConnectionClass: TSQLConnectionClass;
begin
  Result:=TOracleConnection;
end;

class function TOracleConnectionDef.Description: String;
begin
  Result:='Connect to an Oracle database directly via the client library';
end;

class function TOracleConnectionDef.DefaultLibraryName: String;
begin
  {$IfDef LinkDynamically}
  Result:=ocilib;
  {$else}
  Result:='';
  {$endif}
end;

class function TOracleConnectionDef.LoadFunction: TLibraryLoadFunction;
begin
  {$IfDef LinkDynamically}
  Result:=@InitialiseOCI;
  {$else}
  Result:=Nil;
  {$endif}
end;

class function TOracleConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
begin
  {$IfDef LinkDynamically}
  Result:=@ReleaseOCI;
  {$else}
  Result:=Nil;
  {$endif}
end;

class function TOracleConnectionDef.LoadedLibraryName: string;
begin
  {$IfDef LinkDynamically}
  Result:=OCILoadedLibrary;
  {$else}
  Result:='';
  {$endif}
end;

{ TOracleTrans }

destructor TOracleTrans.Destroy();
begin
  OCIHandleFree(FOciTrans,OCI_HTYPE_TRANS);
  OCIHandleFree(FOciSvcCtx,OCI_HTYPE_SVCCTX);
  inherited Destroy();
end;

initialization
  RegisterConnection(TOracleConnectionDef);
finalization
  UnRegisterConnection(TOracleConnectionDef);
end.