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

unit oracleconnection;
//
// For usage of "returning" like clauses see mantis #18133
//


{$mode objfpc}{$H+}

{$Define LinkDynamically}

interface

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

const
  DefaultTimeOut = 60;

type
  EOraDatabaseError = class(EDatabaseError)
    public
      ORAErrorCode : Longint;
  end;

  TOracleTrans = Class(TSQLHandle)
  protected
    FOciSvcCtx  : POCISvcCtx;
    FOciTrans   : POCITrans;
    FOciFlags   : ub4;
  public
    destructor Destroy(); override;
  end;
  
  TOraFieldBuf = record
    Buffer : pointer;
    Ind    : sb2;
    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 retrieving
    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;
//    function CreateBlobStream(Field:TField; Mode:TBlobStreamMode):TStream; override;
    procedure FreeFldBuffers(cursor:TSQLCursor); override;

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

  TOracleConnectionDef = Class(TConnectionDef)
    Class Function TypeName : String; override;
    Class Function ConnectionClass : TSQLConnectionClass; override;
    Class Function Description : String; override;
  end;

implementation

uses
  math, StrUtils;

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

//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. When multiple rows, only last 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;

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.ORAErrorCode := errcode;
  Raise E;
end;

procedure TOracleConnection.GetParameters(cursor: TSQLCursor; AParams: TParams
  );
var SQLVarNr       : integer;
    i              : integer;
    f              : double;
    year,month,day : word;
    db             : array[0..4] of byte;
    pb             : pbyte;
    s              : string;

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

      case DataType of
        ftInteger         : begin
                            move(parambuffers[SQLVarNr].buffer^,i,sizeof(integer));
                            asInteger := i;
                            end;
        ftFloat           : begin
                            move(parambuffers[SQLVarNr].buffer^,f,sizeof(double));
                            asFloat := f;
                            end;
        ftString          : begin
                            SetLength(s,parambuffers[SQLVarNr].Len);
                            move(parambuffers[SQLVarNr].buffer^,s[1],length(s)+1);
                            asString:=s;
                            end;
        ftDate, ftDateTime: begin
                            pb := parambuffers[SQLVarNr].buffer;
                            year:=(pb[0]-100)*100+pb[1]-100;
                            month:=pb[2];
                            day:=pb[3];
                            asDateTime:=EncodeDate(year,month,day);
                            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);

var tel : word;

begin
  with cursor as TOracleCursor do
    begin
    if Length(FieldBuffers) > 0 then
      for tel := 0 to high(FieldBuffers) do freemem(FieldBuffers[tel].buffer);
    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 tel      : integer;
    FOcibind : POCIDefine;
    
    OFieldType   : ub2;
    OFieldSize   : sb4;

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;
    if assigned(AParams) then
      begin
      setlength(ParamBuffers,AParams.Count);
      for tel := 0 to AParams.Count-1 do
        begin

        case AParams[tel].DataType of
          ftInteger : begin OFieldType := SQLT_INT; OFieldSize := sizeof(integer); end;
          ftFloat : begin OFieldType := SQLT_FLT; OFieldSize := sizeof(double); end;
          ftDate, ftDateTime : begin OFieldType := SQLT_DAT; OFieldSize := 7; end;
          ftString  : begin OFieldType := SQLT_STR; OFieldSize := 4000; end;

        end;
        parambuffers[tel].buffer := getmem(OFieldSize);
        parambuffers[tel].Len := OFieldSize;
        parambuffers[tel].Size := OFieldSize;


        FOciBind := nil;

        if AParams[tel].ParamType=ptInput then
          begin
          if OCIBindByName(FOciStmt,FOcibind,FOciError,pchar(AParams[tel].Name),length(AParams[tel].Name),ParamBuffers[tel].buffer,OFieldSize,OFieldType,@ParamBuffers[tel].ind,nil,nil,0,nil,OCI_DEFAULT )= OCI_ERROR then
            HandleError;
          end
        else if AParams[tel].ParamType=ptOutput then
          begin
          if OCIBindByName(FOciStmt,FOcibind,FOciError,pchar(AParams[tel].Name),length(AParams[tel].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[tel], @cbf_get_data) <> OCI_SUCCESS then
            HandleError;
          end;
        end;
      end;
    FPrepared := True;
    end;
end;

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

var SQLVarNr       : integer;
    i              : integer;
    f              : double;
    year,month,day : word;
    db             : array[0..4] of byte;
    pb             : pbyte;
    s              : string;

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

      case DataType of
        ftInteger         : begin
                            i := asInteger;
                            move(i,parambuffers[SQLVarNr].buffer^,sizeof(integer));
                            end;
        ftFloat           : begin
                            f := asFloat;
                            move(f,parambuffers[SQLVarNr].buffer^,sizeof(double));
                            end;
        ftString          : begin
                            s := asString+#0;
                            move(s[1],parambuffers[SQLVarNr].buffer^,length(s)+1);
                            end;
        ftDate, ftDateTime: begin
                            DecodeDate(asDateTime,year,month,day);
                            pb := parambuffers[SQLVarNr].buffer;
                            pb[0] := (year div 100)+100;
                            pb[1] := (year mod 100)+100;
                            pb[2] := month;
                            pb[3] := day;
                            pb[4] := 1;
                            pb[5] := 1;
                            pb[6] := 1;
                            end;
      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 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;
    tel        : ub4;

    FieldType  : TFieldType;
    FieldName  : string;
    FieldSize  : word;

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

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;

    // Let op, moet gewist worden. En in een keer gealloceerd
    Setlength(FieldBuffers,numcols);

    for tel := 1 to numcols do
      begin
      if OCIParamGet(FOciStmt,OCI_HTYPE_STMT,FOciError,Param,tel) = 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 then
                                  begin
                                  if Oprecision=0 then //Number(0,0) = number(32,4)
                                    begin              //Warning ftBCD is limited to precision 12
                                    FieldType := ftBCD;
                                    FieldSize := 4;
                                    OFieldType := SQLT_VNU;
                                    OFieldSize:= 22;
                                    end
                                  else
                                    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 <=4) and (OPrecision<=12) then
                                  begin
                                  FieldType := ftBCD;
                                  FieldSize := oscale;
                                  OFieldType := SQLT_VNU;
                                  OFieldSize:= 22;
                                  end
                                else FieldType := ftUnknown;
                                end;
        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_ODT;
                                     end;
      else
        FieldType := ftUnknown;
      end;

      FieldBuffers[tel-1].buffer := getmem(OFieldSize);

      FOciDefine := nil;
      if OciDefineByPos(FOciStmt,FOciDefine,FOciError,tel,fieldbuffers[tel-1].buffer,OFieldSize,OFieldType,@(fieldbuffers[tel-1].ind),nil,nil,OCI_DEFAULT) = OCI_ERROR then
        HandleError;

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

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

      TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(FieldName), FieldType, FieldSize, False, tel);
      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 dt        : TDateTime;
    b         : pbyte;
    size,i    :  byte;
    exp       : shortint;
    cur       : Currency;
    odt       : POCIdateTime;

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 // 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;
      ftFloat           : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(double));
      ftInteger         : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(integer));
      ftDate  : begin
                b := fieldbuffers[FieldDef.FieldNo-1].buffer;
                dt := EncodeDate((b[0]-100)*100+(b[1]-100),b[2],b[3]);
                move(dt,buffer^,sizeof(dt));
                end;
      ftDateTime : begin
                   odt := fieldbuffers[FieldDef.FieldNo-1].buffer;
                   dt := ComposeDateTime(EncodeDate(odt^.year,odt^.month,odt^.day), EncodeTime(odt^.hour,odt^.min,odt^.sec,0));
                   move(dt,buffer^,sizeof(dt));
                   end;
    else
      Result := False;

    end;
    end;
end;

{function TOracleConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
begin
//  Result:=inherited CreateBlobStream(Field, Mode);
end;}

procedure TOracleConnection.FreeFldBuffers(cursor: TSQLCursor);
begin
//  inherited FreeFldBuffers(cursor);
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;

{ TOracleTrans }

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

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