
//////////////////////////////////////////////////
//  Oracle Data Access Components
//  Copyright © 1998-2014 Devart. All right reserved.
//  Oracle Classes
//////////////////////////////////////////////////

{$IFNDEF CLR}
{$I Odac.inc}
unit OraClassesUni;
{$ENDIF}

{$J+}
{$DEFINE _LOCAL_ERROR_HANDLE}  // LOCAL_ERROR_HANDLE
{$IFDEF VER6P}
{$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}

interface

uses
{$IFDEF MSWINDOWS}
  Windows, Messages,
{$ENDIF}
  SysUtils, Classes, SyncObjs,
{$IFDEF VER6P}
  Types, FMTBcd,{$IFNDEF FPC}SqlTimSt,{$ENDIF}
{$ENDIF}
{$IFDEF CLR}
  Variants, WinUtils,
{$ELSE}
  CLRClasses,
{$ENDIF}
  CRTypes, MemData, CRAccess, CRParser, CRVio,
{$IFNDEF LITE}
  CRDataTypeMap,
{$ENDIF}
{$IFNDEF UNIDACPRO}
  OraCall, OraNumber, OraDateTime, OraInterval, OraError;
{$ELSE}
  OraCallUni, OraNumberUni, OraDateTimeUni, OraIntervalUni, OraErrorUni;
{$ENDIF}

const
  dtRowId          = 100;
  dtOraBlob        = 102;
  dtOraClob        = 103;
  dtBFILE          = 104;
  dtCFILE          = 105;
  dtLabel          = 106;  // MLSLABEL
  dtFixedChar      = 107;
  dtUndefined      = 108;
  dtTimeStamp      = 109;
  dtTimeStampTZ    = 110;
  dtTimeStampLTZ   = 111;
  dtIntervalYM     = 112;
  dtIntervalDS     = 113;
  dtURowId         = 114;
  dtNumber         = 115;
  //dtXML            = 116; is moved to MemData
  dtFixedWideChar  = 117;
  dtBFloat         = 118;
  dtBDouble        = 119;
  dtNString        = 120;
  dtNWideString    = 121;
  dtNClob          = 122;
  dtWideOraClob    = 123;
  dtFixedNChar     = 124;
  dtFixedNWideChar = 125;

// obsolete
  dtBLOBLocator = dtOraBlob;
  dtCLOBLocator = dtOraClob;

// Props
  prOCIBase           = 1000;

  prNonBlocking       = prOCIBase + 1;  // bool
  prThreadSafety      = prOCIBase + 2;  // bool
  prAutoClose         = prOCIBase + 3;  // bool
  prErrorOffset       = prOCIBase + 4;  // word
  prDateFormat        = prOCIBase + 6;  // string
  prDeferredLobRead   = prOCIBase + 7;  // bool
  prConnectMode       = prOCIBase + 8;  // enum
  prCharLength        = prOCIBase + 9;  // word
  prCacheLobs         = prOCIBase + 10; // bool
  prEnableIntegers    = prOCIBase + 11; // bool
  prInternalName      = prOCIBase + 12; // string
  prScrollableCursor  = prOCIBase + 13; // bool
  prStoreRowId        = prOCIBase + 14; // bool
  prCharset           = prOCIBase + 15; // word
  prDateLanguage      = prOCIBase + 16; // string
  prTimeStampFormat   = prOCIBase + 17; // string
  prTimeStampTZFormat = prOCIBase + 18; // string
  prRawAsString       = prOCIBase + 19; // bool
  prNumberAsString    = prOCIBase + 20; // bool
  prNumericCharacters = prOCIBase + 21; // string
  prEnableNumbers     = prOCIBase + 22; // bool
  prUseUnicode        = prOCIBase + 23; // bool
  prIntegerPrecision  = prOCIBase + 24; // word;
  prFloatPrecision    = prOCIBase + 25; // word;
  prTemporaryLobUpdate= prOCIBase + 26; // bool
  prDisconnectMode    = prOCIBase + 27; // bool
  prInactiveTimeout   = prOCIBase + 28; // integer
  prResumeTimeout     = prOCIBase + 29; // integer
  prTransactionName   = prOCIBase + 30; // string
//  prConnectionTimeOut = prOCIBase + 31; // moved to common level
  prHasObjectFields   = prOCIBase + 32; // bool
  prStatementCache    = prOCIBase + 33; // bool
  prStatementCacheSize= prOCIBase + 34; // integer
  prEnabled           = prOCIBase + 35; // bool
  prTimeout           = prOCIBase + 36; // integer
  prPersistent        = prOCIBase + 37; // bool
  prOperations        = prOCIBase + 38; // set
  prPrefetchRows      = prOCIBase + 39; // integer
  prTransactionResume = prOCIBase + 40; // bool
  prRollbackSegment   = prOCIBase + 41; // string
  prHomeName          = prOCIBase + 42; // string
  prDirect            = prOCIBase + 43; // bool
  prClientIdentifier  = prOCIBase + 44; // string
  prOptimizerMode     = prOCIBase + 45; // TOptimizerMode
  prUseOCI7           = prOCIBase + 46; // bool
  prSchema            = prOCIBase + 47; // string
{$IFNDEF FPC}
  prEnableSQLTimeStamp = prOCIBase + 48; // bool
{$ELSE}
  prTimeStampAsString  = prOCIBase + 48; // bool
{$ENDIF}
  prIntervalAsString  = prOCIBase + 49; // bool
  prSmallintPrecision = prOCIBase + 50; // integer
  prLargeintPrecision = prOCIBase + 51; // integer
  prBCDPrecision      = prOCIBase + 52; // integer
{$IFDEF VER6P}
{$IFNDEF FPC}
  prFmtBCDPrecision   = prOCIBase + 53; // integer
{$ENDIF}
{$ENDIF}
  prCheckParamHasDefault = prOCIBase + 54; // bool
//  prUseResultParams      = prOCIBase + 55; // bool
  prUseDefaultDataTypes  = prOCIBase + 56; // bool
  prEnableLargeint       = prOCIBase + 57; // bool
  prUnicodeEnvironment   = prOCIBase + 58; // bool
  prDirectPath           = prOCIBase + 59; // bool
  prEnableWideOraClob    = prOCIBase + 60; // bool
  prAlerterTimeout       = prOCIBase + 61; // bool
  prAlerterInterval      = prOCIBase + 62; // bool
  prAlerterEventType     = prOCIBase + 63; // bool
  prAlerterSelfEvents    = prOCIBase + 64; // bool
  prUnicodeAsNational    = prOCIBase + 65; // bool
  prQueryResultOnly      = prOCIBase + 66; // bool
  prSubscriptionPort     = prOCIBase + 67; // bool

  RowIdSize = 18;

  MaxBlobSize: longint = 2147483647;

  MaxTransactionIdLength = 64; // Maximum length for TransactionId and BranchQualifier

type
  TOraCursor = class;
  TOraLob = class;
  TOraFile = class;
  TOraTimeStamp = class;
  TOraInterval = class;
  TOraNumber = class;
  TOraParamDesc = class;
  TOCIConnection = class;
  TOCICommand = class;
{$IFNDEF LITE}
  TOCITransaction = class;
{$ENDIF}

{ OraAccess level }

  TTransactionMode = (tmReadOnly, tmReadWrite, tmReadCommitted, tmSerializable);
  TConnectMode = (cmNormal, cmSysOper, cmSysDBA, cmSysASM, cmSysBkp, cmSysDG, cmSysKM);

{ TOraParamDesc }

  TOraParamDesc = class (TParamDesc)
  private
    FOwner: TOCICommand;
    FValue: IntPtr;
    FValueSize: integer;
    FNeedTruncateString: boolean;
    FActualLengthPtr: IntPtr;
    FDefIndicator: IntPtr;
    FIndicator: IntPtr;
    FTable: boolean;
    FLength: integer;  // Table Length
    FHandle: IntPtr;
    FBindBufferSize: integer;
    FBlobPiece: integer;  // number of piece
    FLen: integer;
    FTableIndicator: boolean;
    FHasDefault: boolean;
    FBufferAllocated: boolean;
    FCanBeOutput: boolean;
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
  {$IFDEF LITE}
    FOriginalDataType: word;
  {$ENDIF}

    function GetOCISvcCtx: TOCISvcCtx;
    function GetOCI8: TOCI8API;
    function GetActualLength: integer;
    procedure SetActualLength(Value: integer);
    property ActualLength: integer read GetActualLength write SetActualLength;

  protected
    procedure AllocBuffer;
    procedure FreeBuffer;

    procedure CheckRange(Index: integer);
    procedure ValidateParamValue;

    property Name;
    property DataType;
    property SubDataType;
    property ParamType;
    property Size;

    procedure ClearBindData;

    property OCISvcCtx: TOCISvcCtx read GetOCISvcCtx;
    property OCI8: TOCI8API read GetOCI8;
  public
    constructor Create; overload; override;
    destructor Destroy; override;

    procedure Clear; override;

    procedure SetDataType(Value: word); override;
    procedure SetParamType(Value: TParamDirection); override;
    procedure SetSize(Value: integer); override;
    procedure SetNeedTruncateString(Value: boolean);
    procedure SetTable(Value: boolean);
    procedure SetLength(Value: integer);
    procedure SetHasDefault(Value: boolean);

  // TEMP for describe
    function GetTable: boolean;
    function GetLength: integer;
    function GetHasDefault: boolean;
    function GetCanBeOutput: boolean;
  {$IFDEF LITE}
    function GetOriginalDataType: word;
  {$ENDIF}

    function GetIndicator(Index: integer): smallint;
    procedure SetIndicator(Index: integer; Value: smallint);

    function ValuePtr: IntPtr;
    function GetValueSize: integer;
    procedure SetValuePtr(Buf: IntPtr);
    function IndicatorPtr: IntPtr;
    procedure SyncIndicator(Connection: TOCIConnection);

    function GetItemAsDateTime(Index: integer): TDateTime;
    procedure SetItemAsDateTime(Index: integer; Value: TDateTime);
    function GetItemAsFloat(Index: integer): double;
    procedure SetItemAsFloat(Index: integer; Value: double);
  {$IFDEF VER14P}
    function GetItemAsSingle(Index: integer): double;
    procedure SetItemAsSingle(Index: integer; Value: double);
  {$ENDIF}
    function GetItemAsCurrency(Index: integer): currency;
    procedure SetItemAsCurrency(Index: integer; Value: currency);
    function GetItemAsInteger(Index: integer): integer;
    procedure SetItemAsInteger(Index: integer; Value: integer; DataType: Word = dtInteger);
  {$IFDEF VER6P}
    function GetItemAsLargeInt(Index: integer): Int64;
    procedure SetItemAsLargeInt(Index: integer; Value: Int64);
  {$IFNDEF FPC}
    procedure GetItemAsBcd(Index: integer; var Value: TBCD);
    procedure SetItemAsBcd(Index: integer; const Value: TBCD);
    procedure GetItemAsSQLTimeStamp(Index: integer; var Value: TSQLTimeStamp);
    procedure SetItemAsSQLTimeStamp(Index: integer; const Value: TSQLTimeStamp);
  {$ENDIF}
  {$ENDIF}
    function GetItemAsString(Index: integer): string;
    procedure SetItemAsString(Index: integer; const Value: string);
{$IFDEF NEXTGEN}
  protected
{$ENDIF}
    function GetItemAsAnsiString(Index: integer): AnsiString;
    procedure SetItemAsAnsiString(Index: integer; const Value: AnsiString);
  public
    function GetItemAsWideString(Index: integer): WideString;
    procedure SetItemAsWideString(Index: integer; const Value: WideString);
    function GetItemAsBoolean(Index: integer): boolean;
    procedure SetItemAsBoolean(Index: integer; Value: boolean);
    procedure SetItemAsObject(Index: integer; Value: TSharedObject);
    function GetItemAsObject(Index: integer): TSharedObject;

    function GetItemAsVariant(Index: integer): variant;
    procedure SetItemAsVariant(Index: integer; const Value: variant);

    function GetValue: variant; override;
    procedure SetValue(const Value: variant); override;

    function GetAsBlobRef: TBlob;
    function GetAsCursor: TOraCursor;
    function GetAsOraBlob: TOraLob;
    function GetAsBFile: TOraFile;
    function GetAsTimeStamp: TOraTimeStamp;
    function GetAsInterval: TOraInterval;
    function GetAsNumber: TOraNumber;

    function GetObject: TSharedObject; override;
    procedure SetObject(Value: TSharedObject); override;

    function GetNull: boolean; override;
    procedure SetNull(const Value: boolean); override;
    function GetItemNull(Index: integer): boolean;
    procedure SetItemNull(Index: integer; Value: boolean);
  end;

{ TOCIConnection }

  TRunMethod = procedure of object;
  TEndMethod = procedure(E: Exception) of object;

{$IFNDEF MSWINDOWS}
  THandle = integer;
{$ENDIF}

  TNlsParamType = (nlsDateLanguage, nlsDateFormat, nlsNumericCharacters, nlsTimeStampFormat,
    nlsTimeStampTZFormat);

  TNlsSessionParam = record
    Name: string;
    Value: string;
    IsUserDefined: boolean;
  end;

  TFailoverCallback = procedure (FailoverState: cardinal; FailoverType: cardinal;
    var Retry: boolean) of object;
  TInfoMessageCallback = procedure(Error: EOraError) of object;

  TConnectionType = (ctDefault, ctOCIPooled{$IFDEF MSWINDOWS}{$IFNDEF LITE}, ctMTSPooled{$ENDIF}{$ENDIF});
  TOptimizerMode = (omDefault, omFirstRows1000, omFirstRows100, omFirstRows10, omFirstRows1, omFirstRows, omAllRows, omChoose, omRule);

  TOCIConnection = class (TCRConnection)
  private
    FOCISvcCtx: TOCISvcCtx;
    FOCICallStyle: TOCICallStyle;
    FOCICallStyleCommand: TOCICallStyle;
    FThreadSafety: boolean;
    FMaxStringSize: word;
    FLastError: integer;
    FConnectMode: TConnectMode;
    FEnableIntegers: boolean;
    FEnableLargeint: boolean;
    FEnableNumbers: boolean;
    FEnableWideOraClob: boolean;
    FInternalName: string;
    FCommand: TOCICommand;
    FOracleVersionSt: string;
    FOracleVersionFull: string;
    FOracleVersion: word;
    FProxyConnection : TOCIConnection;
    FDisconnectMode: boolean;
    FConnectionTimeout: integer;
    FOCIPoolName: string;
    FStatementCache: boolean;
    FStatementCacheSize: integer;
    FHomeName: string;
    FUnicodeEnvironment: boolean;
  {$IFDEF NET}
    FDirect: boolean;
  {$ENDIF}
  {$IFNDEF CLR}
    FIPVersion: TIPVersion;
  {$ENDIF}
    FConnectionType: TConnectionType;
  {$IFNDEF LITE}
    FClientIdentifier: string;
    FOptimizerMode: TOptimizerMode;
    FSchema: string;
    FCachedSchema: string;
    FSubscriptionPort: Integer;
  {$ENDIF}
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    FEnableSQLTimeStamp: boolean;
  {$ELSE}
    FTimeStampAsString: boolean;
  {$ENDIF}
    FIntervalAsString: boolean;
  {$ENDIF}
    FUnicodeAsNational: boolean;

    FSmallintPrecision: integer;
    FIntegerPrecision: integer;
    FLargeIntPrecision: integer;
    FFloatPrecision: integer;
    FBCDPrecision, FBCDScale: integer;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    FFmtBCDPrecision, FFmtBCDScale: integer;
  {$ENDIF}
  {$ENDIF}

  { Charset parameters }
    FCharset: string;
    FCharsetId: word;
    FCharLength: word;
    FQueryCharLength: boolean;
    FMaxCharLength: word;
    FMinCharLength: word;
    FUseUnicode: boolean;

  { NLS session parameters }
    FNlsParams: array[TNlsParamType] of TNlsSessionParam;

  { OCI73 }
    LDA: PLDA;
    HDA: PHDA;
  { OCI80 }
    hServer  : pOCIServer;
    hSession : pOCISession;
    hOCIAuthInfo : pOCIAuthInfo;
    //hTrans   : pOCITrans;

  {$IFDEF MSWINDOWS}
    hBusy: THandle;
  {$IFNDEF LITE}
    hMTSSvcCtx: pOCISvcCtx;
  {$ENDIF}
  {$ENDIF}

    procedure GetSessionParameters;
    procedure SetNlsParameter(const Name, Value: string);
    function GetMaxStringSize: word;

    function GetOCI7: TOCI7API;
    function GetOCI8: TOCI8API;
  {$IFDEF MSWINDOWS}
  {$IFNDEF LITE}
    function GetMTS: TMTSAPI;
  {$ENDIF}
  {$ENDIF}
  protected
    FOnFailover: TFailoverCallback;
    FOnInfoMessage: TInfoMessageCallback;

    procedure SetStatementCacheSize(Size: integer);
    procedure SetupConnection;
  {$IFNDEF LITE}
    procedure SetOptimizerMode;
    procedure SetClientIdentifier;
  {$ENDIF}

    procedure RaiseError(const Msg: string); virtual; // for TRIALCALL
    procedure DoError(E: Exception; var Fail: boolean); override;

  {$IFDEF MSWINDOWS}
  {$IFNDEF LITE}
    procedure MTSCheck(status: sword);
    procedure MTSError(var ErrorCode: sword; UseCallback: boolean);

    procedure Enlist(Transaction: TMTSTransaction); override;
    procedure UnEnlist(Transaction: TMTSTransaction); override;
  {$ENDIF}
  {$ENDIF}

    property AutoCommit;
    property EnableBCD;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    property EnableFMTBCD;
  {$ENDIF}
  {$ENDIF}
    property ConvertEOL: boolean read FConvertEOL;

  public
    constructor Create; override;
    destructor Destroy; override;

    function GetCommandClass: TCRCommandClass; override;
    function GetTransactionClass: TCRTransactionClass; override;

    procedure CheckOCI;
    procedure CheckOCI73;
    procedure CheckOCI80;

    procedure Check(Status: sword);
    procedure OraError(FOCICallStyle: TOCICallStyle; ErrorCode: sword; UseCallback: boolean; Component: TObject); virtual;

    procedure SetConnectionType(ConnectionType: TConnectionType);
    procedure Connect(const ConnectString: string); override;
    procedure Disconnect; override;
    procedure Ping; override;

    function CreateCommand: TOCICommand;
    function GetCommand: TOCICommand;

    function GetOracleVersion: word;
    function GetServerVersion: string; override;
    function GetServerVersionFull: string; override;
    function GetClientVersion: string; override;

  {$IFNDEF LITE}
    procedure SetCurrentSchema(SchemaName : string);
    function GetCurrentSchema: string;
    function GetDefaultSchema: string;
    function GetCachedSchema: string;
  {$ENDIF}

    procedure BreakExec;

  { Multi Thread }
    procedure Busy;
    procedure BusyWait;
    procedure Release;
    function RunThread(RunMethod: TRunMethod; EndMethod: TEndMethod): TThread;
    function StopThread(var hThread: TThread{$IFDEF MSWINDOWS}; APeekMessage: boolean = False{$ENDIF}): boolean;

  { OCI73 }
    function GetLDA: PLDA;
    procedure SetLDA(Value: PLDA);

  { OCI80 }
    procedure SetOCISvcCtx(Value: TOCISvcCtx);

    procedure ChangePassword(NewPassword: string);

    procedure Assign(Source: TCRConnection); override;
    procedure AssignConnect(Source: TCRConnection); override;

    procedure SetNonBlocking(Value: boolean); // nonblocking connection
    function GetOCICallStyle: TOCICallStyle;
    procedure SetOCICallStyle(Value: TOCICallStyle);
    function GetOCICallStyleCommand: TOCICallStyle;
    function GetLastError: integer;
    procedure SetLastError(Value: integer);
    procedure GetTableFields(TableName: string; Fields: TStringList);

    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; out Value: variant): boolean; override;

    function CheckIsValid: boolean; override;

  {$IFNDEF LITE}
    procedure ReturnToPool; override;
  {$ENDIF}
  {$IFDEF NET}
    property Direct: boolean read FDirect;
  {$ENDIF}
    property OCISvcCtx: TOCISvcCtx read FOCISvcCtx;
    property OCI7: TOCI7API read GetOCI7;
    property OCI8: TOCI8API read GetOCI8;
  {$IFDEF MSWINDOWS}
  {$IFNDEF LITE}
    property MTS: TMTSAPI read GetMTS;
  {$ENDIF}
  {$ENDIF}
    property UnicodeEnvironment: boolean read FUnicodeEnvironment;
    property ProxyConnection : TOCIConnection read FProxyConnection write FProxyConnection;
    property OCICallStyle: TOCICallStyle read FOCICallStyle;
    property OCICallStyleCommand: TOCICallStyle read FOCICallStyleCommand;

    property OnFailover: TFailoverCallback read FOnFailover write FOnFailover;
    property OnInfoMessage: TInfoMessageCallback read FOnInfoMessage write FOnInfoMessage;
  end;

{ TOraCursor }

  TOraCursor = class (TCRCursor)
  private
    FCDA: PCDA;
    FphOCIStmt: ppOCIStmt;

    FOCISvcCtx: TOCISvcCtx;
    FOCI8: TOCI8API;
    FOCICallStyle: TOCICallStyle;
    FScrollable: boolean;
    FStatementCache: boolean;
    FPrefetchRows: integer;

    procedure SetOCISvcCtx(Value: TOCISvcCtx);
    procedure DisablePrefetching;
    function GetCDA: PCDA;
    function GethOCIStmt: pOCIStmt;
    procedure SethOCIStmt(Value: pOCIStmt);
    function GetOCIStmt: pOCIStmt;
    function GetOCIStmtPtr: ppOCIStmt;
    procedure SetPrefetchRows(Value: integer);

    property hOCIStmt: pOCIStmt read GethOCIStmt write SethOCIStmt;
  protected
    FState: TCursorState;

    procedure Check(Status: sword);
    procedure CheckOCI;
    procedure CheckOCI73;
    procedure CheckOCI80;

    procedure Init(AOCISvcCtx: TOCISvcCtx; AOCICallStyle: TOCICallStyle);
    procedure ReleaseOCISvcCtx;

    property OCI8: TOCI8API read FOCI8;
  public
    constructor Create;
    destructor Destroy; override;

    procedure AllocCursor(AStatementCache: boolean = False);
    procedure FreeCursor;
    procedure Disconnect; override;

    function CanFetch: boolean; override;

    property CDA: PCDA read GetCDA;
    property OCISvcCtx: TOCISvcCtx read FOCISvcCtx;
    property OCICallStyle: TOCICallStyle read FOCICallStyle;
    property OCIStmt: pOCIStmt read GetOCIStmt;
    property OCIStmtPtr: ppOCIStmt read GetOCIStmtPtr;
    property State: TCursorState read FState;
    property PrefetchRows: integer read FPrefetchRows write SetPrefetchRows;
  end;

{$IFDEF MSWINDOWS}
{ TOCIChangeNotification }

  TChangeNotifyEventType = (cneNone, cneStartup, cneShutdown, cneShutdownAny,
    cneDropDB, cneDereg, cneObjChange, cneQueryChange);

  TCustomNotifyChanges = class
  private
    FOCISvcCtx: TOCISvcCtx;

    function GetCount: integer;
  protected
    FItems: array of TObject;
    function CreateItem(ChangeDescriptor: IntPtr): TObject; virtual; abstract;
  public
    constructor Create(AOCISvcCtx: TOCISvcCtx; AOCIColl: pOCIColl);
    destructor Destroy; override;
    property Count: integer read GetCount;
  end;

  TNotifyRowChange = class
  private
    FRowId: string;
    FOperations: TChangeNotifyOperations;
  public
    constructor Create(AOCISvcCtx: TOCISvcCtx; AChangeDescriptor: IntPtr);
    property RowId: string read FRowId;
    property Operations: TChangeNotifyOperations read FOperations;
  end;

  TNotifyRowChanges = class(TCustomNotifyChanges)
  private
    function GetChanges(Index: integer): TNotifyRowChange;
  protected
    function CreateItem(ChangeDescriptor: IntPtr): TObject; override;
  public
    property Changes[Index: integer]: TNotifyRowChange read GetChanges; default;
  end;

  TNotifyTableChange = class
  private
    FTableName: string;
    FOperations: TChangeNotifyOperations;
    FRowChanges: TNotifyRowChanges;
  public
    constructor Create(AOCISvcCtx: TOCISvcCtx; AChangeDescriptor: IntPtr);
    destructor Destroy; override;
    property TableName: string read FTableName;
    property Operations: TChangeNotifyOperations read FOperations;
    property RowChanges: TNotifyRowChanges read FRowChanges;
  end;

  TNotifyTableChanges = class(TCustomNotifyChanges)
  private
    function GetChanges(Index: integer): TNotifyTableChange;
  protected
    function CreateItem(ChangeDescriptor: IntPtr): TObject; override;
  public
    property Changes[Index: integer]: TNotifyTableChange read GetChanges; default;
  end;

  TNotifyChange = class
  private
    FNotifyType: TChangeNotifyEventType;
    FTableChanges: TNotifyTableChanges;
  public
    constructor Create(AOCISvcCtx: TOCISvcCtx; AChangeDescriptor: IntPtr);
    destructor Destroy; override;
    property NotifyType: TChangeNotifyEventType read FNotifyType;
    property TableChanges: TNotifyTableChanges read FTableChanges;
  end;

  TChangeNotifyCallback = procedure(NotifyType: TChangeNotifyEventType;
    TableChanges: TNotifyTableChanges) of object;

  TOCIChangeNotification = class
  private
    FOCISvcCtx: TOCISvcCtx;
    FGCHandle: IntPtr;
    FEnabled: boolean;
    FPersistent: boolean;
    FTimeOut: integer;
    FQueryResultOnly: boolean;
    FOperations: TChangeNotifyDMLOperations;
    FOnChange: TChangeNotifyCallback;
    hOCISubscription: pOCISubscription;

    function GetGCHandle: IntPtr;
    function GetOCI8: TOCI8API;
    procedure SetOCISvcCtx(Value: TOCISvcCtx);
    procedure SetEnabled(Value: boolean);
    function CallbackChangeNotify(pCtx: IntPtr; pSubscrHp: pOCISubscription;
      pPayload: IntPtr; iPayloadLen: ub4; pDescriptor: IntPtr; iMode: ub4): sword;
  protected
    procedure ReleaseOCISvcCtx;

    property GCHandle: IntPtr read GetGCHandle;
    property OCI8: TOCI8API read GetOCI8;
    property OCISvcCtx: TOCISvcCtx read FOCISvcCtx;
  public
    constructor Create;
    destructor Destroy; override;

    function SetProp(Prop: integer; const Value: variant): boolean;
    function GetProp(Prop: integer; var Value: variant): boolean;

    function GetSubscriptionHandle(Connection: TOCIConnection): pOCISubscription;
    procedure Register(Connection: TOCIConnection);
    procedure Unregister(Connection: TOCIConnection);
    function IsActive: boolean;

    property OnChange: TChangeNotifyCallback read FOnChange write FOnChange;
  end;
{$ENDIF}

{ TOCICommand }

  TOCICommand = class (TCRCommand)
  private
    FOCISvcCtx: TOCISvcCtx;
    FOCICallStyle: TOCICallStyle;
    FCursor: TOraCursor;
    FCursorRef: TOraCursor;
    FNonBlocking: boolean;
    FSQLType: word;
    FLastSQLType: word;
    FRowsProcessed: integer;
    FFetchedRows: integer;
    FErrorOffset: word;
    FIterCount: integer;
    FFieldsAsString: boolean;
    FCacheLobs: boolean;
    FStoreRowId: boolean;
    FRowId: string;
    FRawAsString: boolean;
    FNumberAsString: boolean;
    FUseDefaultDataTypes: boolean;

    FSmallintPrecision: integer;
    FIntegerPrecision: integer;
    FLargeIntPrecision: integer;
    FFloatPrecision: integer;
    FBCDPrecision, FBCDScale: integer;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    FFmtBCDPrecision, FFmtBCDScale: integer;
  {$ENDIF}
  {$ENDIF}

    FForceUnprepare: boolean;
    FGCHandle: IntPtr;
    FTemporaryLobUpdate: boolean;
    FStatementCache: boolean;
  {$IFDEF MSWINDOWS}
    FChangeNotification: TOCIChangeNotification;
  {$ENDIF}
    FCheckParamHasDefault: boolean;
    FForceSPInit: boolean;

  {$IFDEF MSWINDOWS}
    hBusy: THandle;
  {$ENDIF}
  {$IFDEF MSWINDOWS}
    hExecThread: TThread;
  {$ENDIF}
  {$IFDEF WIN32_64}
    hExecuted: TEvent;
  {$ENDIF}

    function GetGCHandle: IntPtr;
    function GetOCI7: TOCI7API;
    function GetOCI8: TOCI8API;
    function RemoveCRSymbols(SQLText: string; var ErrorOffset: integer): string;

  protected
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FConnection: TOCIConnection;

    procedure DoExecute;
    procedure EndExecute(E: Exception);

    procedure RaiseError(const Msg: string); virtual; // for TRIALCALL

    procedure AllocOCISvcCtx;
    procedure ReleaseOCISvcCtx;

    procedure CheckOCI;
    procedure CheckOCI73;
    procedure CheckOCI80;

    procedure CheckActive;
    procedure CheckInactive;
    procedure CheckSession;

    procedure Check(Status: sword);

    function GetSmallintPrecision: integer;
    function GetIntegerPrecision: integer;
    function GetLargeintPrecision: integer;
    function GetFloatPrecision: integer;
    function GetBCDPrecision: integer;
    function GetBCDScale: integer;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    function GetFmtBCDPrecision: integer;
    function GetFmtBCDScale: integer;
  {$ENDIF}
  {$ENDIF}

  { OCI73 }
    function GetOraType7(DataType: integer; SubDataType: integer{ = 0}): integer;
    function InternalFetch7(Rows: word): word;
    function InternalFetchPiece7: integer;
    function DescSP(const objnam: string; ovrld: pub2; pos: pub2; level: pub2;
      argnam: IntPtr; arnlen: pub2; dtype: pub2; defsup: pub1; mode: pub1;
      dtsiz: pub4; prec: psb2; scale: psb2; radix: pub1;
      spare: pub4; var arrsiz: ub4): sword;
    procedure InitProcParams7(Name: string; Overload: integer);

  { OCI80 }
    function GetInternalType8(OraType: Integer; IsNational: boolean): Integer;
    function GetOraType8(DataType: integer; SubDataType: integer): integer;
    function InternalFetch8(Rows: word; Orientation: integer; Offset: integer): word;
    function InternalExecuteFetch8(Rows: word): word;
    function InternalFetchPiece8(Orientation: integer; Offset: integer): integer;
    procedure InitProcParams8(Name: string; Overload: integer);

    function CallbackInBind(Bind: pOCIBind; Iter: ub4; Index: ub4; var Buf: IntPtr;
      var BufLen: ub4; var PieceStatus: ub1; var Ind: IntPtr): sb4;
    function CallbackOutBind(Bind: pOCIBind; Iter: ub4; Index: ub4; var Buf: IntPtr;
      var BufLen: pub4; var PieceStatus: ub1; var Ind: IntPtr): sb4;

    procedure SetArrayLength(Value: integer);
    function GetActive: boolean;

    property EnableBCD;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    property EnableFMTBCD;
  {$ENDIF}
  {$ENDIF}
    property Params;
    property Executing;
    property GCHandle: IntPtr read GetGCHandle;
  public
    constructor Create; override;
    destructor Destroy; override;

    class function GetSQLInfoClass: TSQLInfoClass; override;
    class function GetParserClass: TSQLParserClass; override;
  {$IFNDEF LITE}
    class function GetMapRulesClass: TCRMapRulesClass; override;
  {$ENDIF}

    function GetOraType(DataType: integer; SubDataType: integer): integer;

    procedure InternalOpen;
    procedure InternalParse;
    procedure InternalPrepare;

    function ParseSQL(const SQL: string; Params: TParamDescs; ReplaceAll: boolean = True; const RenamePrefix: string = ''): string; override;
    procedure InitProcParams(Name: string; Overload: integer);
    function CreateProcCall(const Name: string; NeedDescribe: boolean; IsQuery: boolean): string; override;
    function ForceCreateSPParams: boolean; override;

    function NeedBindParam(Param: TOraParamDesc): boolean;
    procedure BindParam(Param: TOraParamDesc);
    function InternalExecute(Mode: integer; Rows: Integer = 0): sword;
    procedure Exec;
    procedure DefineData(Field: TFieldDesc; Buf: IntPtr; Ind: psb2; BufSkip: integer; IndSkip: integer);
    procedure DefineDynamic7(Field: TFieldDesc; Buf: IntPtr; Ind: psb2);
    procedure DefineDynamic8(Field: TFieldDesc; Owner: IntPtr; Proc: IntPtr; CharsetId: Integer);

    function InternalFetch(Rows: word; Orientation: integer = OCI_FETCH_NEXT; Offset: integer = 0): word;
    function InternalFetchPiece(Orientation: integer = OCI_FETCH_NEXT; Offset: integer = 0): integer;
    procedure InternalCancel;
    procedure InternalClose;
    procedure Finish;
    procedure Close; override;

    procedure GetPI(var Handle: pOCIHandle; var Piece: byte; var Buf: IntPtr;
      var Iteration: cardinal; var Index: cardinal; var Mode: TParamDirection);
    procedure SetPI(Handle: pOCIHandle; HType: cardinal; Piece: byte; Buf: IntPtr;
      var BufLen: cardinal; Ind: psb2);

    function NativeCursor: boolean;
    function RowsReturn: boolean;
    procedure CheckRowsReturn;

  { Params }
    function AddParam: TParamDesc; override;
    procedure BindParams;
    //procedure DisconnectParams;
    function GetParam(Index: integer): TOraParamDesc;

    procedure BreakExec; override;
    procedure HardBreak;

    procedure Busy;
    procedure Release;

    procedure Prepare; override;
    procedure Unprepare; override;
    function GetPrepared: boolean; override;

    procedure Execute(Iters: integer = 1); override;

    procedure SetConnection(Value: TCRConnection); override;
    function GetCursor: TCRCursor; override;
    procedure SetCursor(Value: TCRCursor); override;
    function GetNextCursor: TOraCursor;
    procedure SetOCICallStyle(Value: TOCICallStyle);
    function GetCursorState: TCursorState; override;
    procedure SetCursorState(Value: TCursorState); override;
    function GetSQLType: integer;
    function GetRowId: string;

    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; out Value: variant): boolean; override;

    property OCICallStyle: TOCICallStyle read FOCICallStyle;
    property OCISvcCtx: TOCISvcCtx read FOCISvcCtx;
    property OCI7: TOCI7API read GetOCI7;
    property OCI8: TOCI8API read GetOCI8;

  {$IFDEF MSWINDOWS}
    property ChangeNotification: TOCIChangeNotification read FChangeNotification write FChangeNotification;
  {$ENDIF}
  end;

{ TOCISQLInfo }

  TOCISQLInfo = class(TSQLInfo)
  protected
    function NextCharQuotesNeed(Ch: Char; IdCase: TIdentCase): boolean; override;
    function HasAsLexem: boolean; override;
    procedure ParseExtTableInfo(Parser: TSQLParser; var CodeLexem: integer; var StLex: string; var Name: string); override;
  public
    function IdentCase: TIdentCase; override;

    function NormalizeName(const Value: string; const LeftQ: Char; const RightQ: Char; QuoteNames: boolean = False; UnQuoteNames: boolean = False): string; overload; override;
    // for normal C++Builder header
    function NormalizeName(const Value: string; QuoteNames: boolean = False; UnQuoteNames: boolean = False): string; overload; override;

    procedure SplitObjectName(const Name: string; var Info: TSQLObjectInfo); override;

    class function ParseSPName(FullName: string; var Name: string; var Overload: integer): boolean;
    class function GetFinalSPName(Name: string; Overload: integer): string;
  end;

  TOCIFieldDesc = class(TCRFieldDesc)
  private
    FIsConverted: boolean;
    FIsBlobSubType: boolean;
  protected
    procedure SetDataType(Value: Word); override;
    procedure SetSubDataType(Value: Word); override;
  public
    property IsBlobSubType: boolean read FIsBlobSubType;
    property IsConverted: boolean read FIsConverted;
  end;

{ TOCIRecordSet }

  TModifyAction = procedure of object;

  TOCIRecordSet = class (TCRRecordSet)
  private
    FAutoClose: boolean;
    FDeferredLobRead: boolean;
    hExecFetchThread: TThread;
    hFetchAllThread: TThread;
    FFetchCursor: TOraCursor;
    FFetchBlock: IntPtr;
    FFetchBlockItemSize: integer;
    FPieceFetch: boolean;
    FFetchItems: IntPtr;  // for callback fetch
    // for backward fetch
    FFetchAbsolute: boolean;
    FFetchStart: integer;
    FFetchEnd: integer;
    FGCHandle: IntPtr;
    FHasConvertedFields: boolean;
  {$IFDEF MSWINDOWS}
    hEvent: TEvent;
  {$ENDIF}
    FFetching: boolean;
    FHasObjectFields: boolean;
    FTempFilterText: string;
    FDisableInitFields: boolean;
    FExpandedFields: TFieldDescs;

    //PreCached FConection properties
    FDisconnectedMode: boolean;
    FUseUnicode: boolean;
    FCharLength: integer;

    function HasCursorParams: boolean;
    procedure InitFetchCursor;

    function FetchArray(FetchBack: boolean = False): boolean;
    function FetchPiece(FetchBack: boolean = False): boolean;

    procedure AllocFetchBlock;
    procedure FreeFetchBlock;

    function GetNonBlocking: boolean;
    function GetGCHandle: IntPtr;
    function GetDisconnectedMode: boolean;
    function GetUseUnicode: boolean;
    function GetCharLength: integer;

    procedure Check(Status: Word);
    function GetOCISvcCtx: TOCISvcCtx;
    function GetOCI7: TOCI7API;
    function GetOCI8: TOCI8API;

    class function IsConvertedFieldType(DataType: word): boolean;
  protected
    FCommand: TOCICommand;
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FConnection: TOCIConnection;  // for perf

    procedure CreateCommand; override;
    procedure SetCommand(Value: TCRCommand); override;

  { Open/Close }
    function NeedInitFieldsOnPrepare: boolean; override;
    procedure InternalPrepare; override;
    procedure InternalUnPrepare; override;
    procedure InternalClose; override;

    procedure CreateFieldDescs; override;
    procedure FillDataFieldDescs(out DataFieldDescs: TFieldDescArray; ForceUseAllKeyFields: boolean); override;
    function InternalCompareFieldValue(ValuePtr: IntPtr; ValueType: Word; FieldBuf: IntPtr; FieldType: Word; FieldLength: Integer; HasParent: boolean; IsFixed: boolean; const Options: TCompareOptions): integer; override;

    function GetFieldDesc(FieldNo: integer; var Field: TCRFieldDesc; LongString: boolean; FlatBuffer: boolean): boolean;
  { OCI70 }
    function GetFieldDesc7(FieldNo: integer; var Field: TCRFieldDesc; LongString: boolean; FlatBuffer: boolean): boolean;
  { OCI80 }
    function GetFieldDesc8(FieldNo: integer; var Field: TCRFieldDesc; LongString: boolean; FlatBuffer: boolean): boolean;
    function GetIndicatorSize: Integer; override;
    function GetEOF: boolean; override;

  { Filter/Find/Locate/Sorting }
    procedure SetFilterText(const Value: string); override;

  { Fetch }
    procedure InitFetchedBlock(Block: PBlockHeader; RowsObtained: Integer; FetchBack: boolean); override;
    function CanFetchBack: boolean; override;
    function InternalFetch(FetchBack: boolean = False): boolean; override;
    function NeedUnPrepareAfterFetch: boolean; override;
    procedure DoBeforeFetch(out Cancel: boolean); override;
    procedure DoAfterFetch; override;
  {$IFNDEF LITE}
    function GetSmartFetchMetaInfoSQL(const BaseSQL: string): string; override;
  {$ENDIF}

  { Items }
    procedure FreeAllItems;

  { Edit }
    procedure DoExecFetch;
    procedure EndExecFetch(E: Exception);
    procedure DoFetchAll;
    procedure DoFetchAllPulse;
    procedure EndFetchAll(E: Exception);

    function CallbackDefine(Define: pOCIDefine; Iter: cardinal; var Buf: IntPtr;
      var BufLen: pub4; var PieceStatus: ub1; var Ind: IntPtr): sb4;

    property GCHandle: IntPtr read GetGCHandle;
    //PreCached FConection properties
    property DisconnectedMode: boolean read GetDisconnectedMode;
    property UseUnicode: boolean read GetUseUnicode;
    property CharLength: integer read GetCharLength;

    property OCISvcCtx: TOCISvcCtx read GetOCISvcCtx;
    property OCI7: TOCI7API read GetOCI7;
    property OCI8: TOCI8API read GetOCI8;
  public
    constructor Create; override;
    destructor Destroy; override;

  { Open/Close }
    function IsFullReopen: boolean; override;
    procedure Reopen; override;
    procedure SetCommandType;
    procedure ExecCommand; override; // Execute command
    procedure Disconnect; override;

  { Fetch }
    procedure ExecFetch(DisableInitFields: boolean); override;
    procedure FetchAll; override;
    function RowsReturn: boolean; override;

  { Fields }
    class function GetBufferSize(DataType: Word; LengthInChars: integer): integer; override;
    procedure DetectIdentityField; override;
    function GetFieldDescType: TFieldDescClass; override;

    procedure SetNull(Field: TFieldDesc; RecBuf: IntPtr; Value: boolean); override;
    function GetNull(Field: TFieldDesc; RecBuf: IntPtr): boolean; override;

    procedure GetDateFromBuf(Buf: IntPtr; Date: IntPtr; HasParent: boolean; Format: TDateFormat); override;
    procedure PutDateToBuf(Buf: IntPtr; Date: IntPtr; HasParent: boolean; Format: TDateFormat); override;

    class function IsBlobDataType(DataType: word): boolean; override;
    class function IsComplexDataType(DataType: word): boolean; override;
    class function IsObjectDataType(DataType: word): boolean; override;

    procedure GetFieldData(Field: TFieldDesc; FieldBuf: IntPtr; Dest: IntPtr; NeedConvert: boolean); override;
    procedure GetDataAsVariant(DataBuf: IntPtr; DataType: Word; SubDataType: Word; FieldLength: Integer; HasParent: boolean; IsFixed: boolean; var Value: variant); override;
    procedure PutDataAsVariant(DataBuf: IntPtr; DataType: Word; DataSize: Integer; Length, Scale: Word; HasParent: boolean; const Value: variant; IsDatabaseValue: boolean); override;

    function FieldListDependsOnParams: boolean; override;

  {$IFNDEF LITE}
  { Encryption}
    function GetDecryptDataType(DataType: Word): Word; override;
    function IsEncryptableDataType(DataType: Word): boolean; override;
  {$ENDIF}

  { Records }
    procedure CreateComplexField(RecBuf: IntPtr; Field: TFieldDesc); override;
    procedure FreeComplexField(RecBuf: IntPtr; Field: TFieldDesc); override;
    procedure CopyComplexField(Source: IntPtr; Dest: IntPtr; Field: TFieldDesc); override;

    procedure SortItems; override;
    procedure FilterUpdated; override;

  { Navigation }
    procedure SetToBegin; override;
    procedure SetToEnd; override;

  { BookMarks }
    procedure GetBookmark(Bookmark: PRecBookmark); override;
    procedure SetToBookmark(Bookmark: PRecBookmark); override;
    function GetBlockFetchPos(Block: PBlockHeader): integer;
    function GetItemFetchPos(Item: PItemHeader): integer;

  { Blobs }
    procedure SetConnection(Value: TCRConnection); override;

    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; out Value: variant): boolean; override;

    property ExpandedFields: TFieldDescs read FExpandedFields;
  end;

{ TOraLob }

  TLobType = (ltBlob, ltClob, ltNClob);

  TOraLob = class (TCompressedBlob)
  private
    FOCISvcCtx: TOCISvcCtx;
    phLobLocator: ppOCILobLocator;
    FNativeHandle: boolean;
    FCached: boolean;
    FCharsetId: integer;
    FCharsetForm: integer;
    FLobType: TLobType;
    FCharLength: byte;

    function GetOCILobLocator: pOCILobLocator;
    function GethOCILobLocator: pOCIStmt;
    procedure SethOCILobLocator(Value: pOCIStmt);
    procedure SetOCILobLocator(Value: pOCILobLocator);
    function GetOCILobLocatorPtr: ppOCILobLocator;
    procedure SetCached(const Value: boolean);
    procedure SetOCISvcCtx(const Value: TOCISvcCtx);
    function GetOCI8: TOCI8API;
  protected
    FNeedReadLob: boolean;

    function CreateClone: TBlob; override;

    procedure Check(Status: sword);
    procedure CheckValue; override;
    function GetSize: Cardinal; override;
    function GetSizeAnsi: Cardinal; override;
    function GetSizeUni: Cardinal; override;
    procedure CheckAlloc;
    procedure CheckSession;
    procedure CheckInit;
    procedure CheckCharSetForm;
    function CharSize: Byte; virtual;
    procedure ReadLob(var SharedPiece: PPieceHeader); overload;

    property OCI8: TOCI8API read GetOCI8;
    property hLobLocator: pOCILobLocator read GethOCILobLocator write SethOCILobLocator;
  public
    constructor Create(AOCISvcCtx: TOCISvcCtx);
    destructor Destroy; override;

    procedure AllocLob; virtual;
    procedure FreeBlob; override;
    procedure FreeLob;
    procedure Disconnect; override;

    procedure Init;
    procedure CreateTemporary(LobType: TLobType);
    procedure FreeTemporary;
    function IsTemporary: LongBool;
    function IsInit: boolean;

    function LengthLob: Cardinal;

    procedure EnableBuffering;
    procedure DisableBuffering;

    procedure ReadLob; overload;
    procedure WriteLob;

    function Read(Position, Count: cardinal; Dest: IntPtr): cardinal; override;
    procedure Write(Position, Count: cardinal; Source: IntPtr); override;
    procedure Clear; override;
    procedure Truncate(NewSize: cardinal); override;

    property OCISvcCtx: TOCISvcCtx read FOCISvcCtx write SetOCISvcCtx;

    property OCILobLocator: pOCILobLocator read GetOCILobLocator write SetOCILobLocator;
    property OCILobLocatorPtr: ppOCILobLocator read GetOCILobLocatorPtr;
    property Cached: boolean read FCached write SetCached;
    property LobType: TLobType read FLobType write FLobType;
  end;

{ TOraFile }

  TOraFile = class (TOraLob)
  private
    FNeedRollback: boolean;
    FRollbackFileDir: string;
    FRollbackFileName: string;

    function GetFileDir: string;
    procedure SetFileDir(const Value: string);
    function GetFileName: string;
    procedure SetFileName(const Value: string);
    procedure SetFileDirAndName(const FileDir, FileName: string);

  protected
    CanRollback: boolean;

    procedure CheckValue; override;
    function CharSize: Byte; override;

    procedure SaveToRollback; override;
  public
    destructor Destroy; override;

    procedure AllocLob; override;
    procedure FreeBlob; override;

    procedure Open;
    procedure Close;
    procedure EnableRollback;

    procedure Commit; override;
    procedure Cancel; override;

    procedure Refresh;

    function IsOpen: boolean;

    function Exists: boolean;

    property FileDir: string read GetFileDir write SetFileDir;
    property FileName: string read GetFileName write SetFileName;
  end;

  THandleType = (htLocal, htNative, htShared);

{ TOraTimeStamp }

  TOraTimeStamp = class (TSharedObject)
  private
    FEnvironment: TOCIEnvironment;
    phOCIDateTime: ppOCIDateTime;
    FLocalDateTime: TOCIDateTime;
    FDescriptorType: Cardinal;
    FPrecision: byte;
    FFormat: string;
    FHandleType: THandleType;
    FIndicator: IntPtr;

    function GetAsString: string;
    procedure SetAsString(const Value: string);
    function GetAsDateTime: TDateTime;
    procedure SetAsDateTime(Value: TDateTime);
    function GetTimeZone: string;
    function GethOCIDateTime: pOCIDateTime;
    procedure SethOCIDateTime(Value: pOCIDateTime);
    function GetOCIDateTime: pOCIDateTime;
    procedure SetOCIDateTime(const Value: pOCIDateTime);
    procedure SetDescriptorType(const Value: cardinal);
    function GetOCIDateTimePtr: ppOCIDateTime;
  {$IFNDEF FPC}
  {$IFDEF VER6P}
    procedure SetAsSQLTimeStamp(const Value: TSQLTimeStamp);
    function  GetAsSQLTimeStamp: TSQLTimeStamp;
  {$ENDIF}
  {$ENDIF}
    function GetLocalDateTime: TOCIDateTime;
    procedure CheckValid;
  protected
    procedure Check(Res: sword);

    procedure Init(ADataType: word);
    procedure AllocDateTime;
    procedure FreeDateTime;
    function ToLocalDateTime: TOCIDateTime;
    procedure FromLocalDateTime(Value: TOCIDateTime);

    procedure SetFormat(const AFormat: string);

    property hOCIDateTime: pOCIDateTime read GethOCIDateTime write SethOCIDateTime;
    property LocalDateTime: TOCIDateTime read GetLocalDateTime;
  public
    constructor Create(ADataType: word); overload;
    constructor Create(AOCIEnvironment: TOCIEnvironment; ADataType: word); overload;
    constructor Create(AOCISvcCtx: TOCISvcCtx; ADataType: word); overload;
    destructor Destroy; override;

    procedure SetEnvironment(AEnvironment: TOCIEnvironment);
    procedure Disconnect; override;

    procedure Assign(Source: TOraTimeStamp);
    procedure AssignTo(Dest: TOraTimeStamp);
    function Compare(Dest: TOraTimeStamp): integer;

    function GetIsNull: boolean;
    procedure SetIsNull(Value: boolean);

    procedure Construct(Year: smallint; Month, Day, Hour, Min, Sec: byte;
      FSec: cardinal; TimeZone: string);

    procedure GetDate(var Year: smallint; var Month, Day: byte);
    procedure SetDate(Year: smallint; Month, Day: byte);

    procedure GetTime(var Hour, Min, Sec: byte; var FSec: cardinal);
    procedure SetTime(Hour, Min, Sec: byte; FSec: cardinal);

    procedure GetTimeZoneOffset(var Hour, Min: shortint);
    procedure SetTimeZoneOffset(TZHour, TZMin: shortint);

    property DescriptorType: cardinal read FDescriptorType write SetDescriptorType;
    property OCIDateTime: pOCIDateTime read GetOCIDateTime write SetOCIDateTime;
    property OCIDateTimePtr: ppOCIDateTime read GetOCIDateTimePtr;
    property Format: string read FFormat write SetFormat;
    property Precision: byte read FPrecision write FPrecision;
    property TimeZone: string read GetTimeZone;
    property AsString: string read GetAsString write SetAsString;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
  {$IFNDEF FPC}
  {$IFDEF VER6P}
    property AsTimeStamp: TSQLTimeStamp read GetAsSQLTimeStamp write SetAsSQLTimeStamp;
  {$ENDIF}
  {$ENDIF}
    property IsNull: boolean read GetIsNull write SetIsNull;
  end;

  TOraInterval = class (TSharedObject)
  private
    FEnvironment: TOCIEnvironment;
    phOCIInterval: ppOCIInterval;
    FLocalInterval: TOCIInterval;
    FDescriptorType: cardinal;
    FHandleType: THandleType;
    FFracPrecision: byte;
    FLeadPrecision: byte;
    FIndicator: IntPtr;

    procedure InitInterval;
    procedure CheckValid;
    function GetAsString: string;
    function GethOCIInterval: pOCIInterval;
    procedure SethOCIInterval(Value: pOCIInterval);
    function GetOCIInterval: pOCIInterval;
    function GetOCIIntervalPtr: ppOCIInterval;
    procedure SetAsString(const Value: string);
    procedure SetDescriptorType(const Value: cardinal);
    procedure SetOCIInterval(const Value: pOCIInterval);
    function GetLocalInterval: TOCIInterval;
  protected
    procedure Check(Res: sword);

    procedure Init(ADataType: word);
    procedure AllocInterval;
    procedure FreeInterval;
    function ToLocalInterval: TOCIInterval;
    procedure FromLocalInterval(Value: TOCIInterval);

    property hOCIInterval: pOCIInterval read GethOCIInterval write SethOCIInterval;
    property LocalInterval: TOCIInterval read GetLocalInterval;
  public
    constructor Create(ADataType: word); overload;
    constructor Create(AOCIEnvironment: TOCIEnvironment; ADataType: word); overload;
    constructor Create(AOCISvcCtx: TOCISvcCtx; ADataType: word); overload;
    destructor Destroy; override;

    procedure SetEnvironment(AEnvironment: TOCIEnvironment);
    procedure Disconnect; override;

    procedure Assign(Source: TOraInterval);
    procedure AssignTo(Dest: TOraInterval);
    function Compare(Dest: TOraInterval): integer;

    function GetIsNull: boolean;
    procedure SetIsNull(Value: boolean);

    procedure GetYearMonth(var Year, Month: integer);
    procedure SetYearMonth(Year, Month: integer);

    procedure GetDaySecond(var Day, Hour, Min, Sec, FSec: integer);
    procedure SetDaySecond(Day, Hour, Min, Sec, FSec: integer);

    property DescriptorType: cardinal read FDescriptorType write SetDescriptorType;
    property OCIInterval: pOCIInterval read GetOCIInterval write SetOCIInterval;
    property OCIIntervalPtr: ppOCIInterval read GetOCIIntervalPtr;
    property LeadPrecision: byte read FLeadPrecision write FLeadPrecision;
    property FracPrecision: byte read FFracPrecision write FFracPrecision;
    property AsString: string read GetAsString write SetAsString;
    property IsNull: boolean read GetIsNull write SetIsNull;
  end;

  TOraNumber = class (TSharedObject)
  private
    FEnvironment: TOCIEnvironment;
    phOCINumber: pOCINumber;
    FIndicator: IntPtr;
    FHandleType: THandleType;

    function GetOCINumberPtr: pOCINumber;
    procedure SetOCINumberPtr(Value: pOCINumber);
    function GetOCINumber: OCINumber;
    procedure SetOCINumber(Value: OCINumber);
    function GetAsString: string;
    procedure SetAsString(const Value: string);
    function GetAsInteger: integer;
    procedure SetAsInteger(const Value: integer);
    function GetAsLargeInt: int64;
    procedure SetAsLargeInt(const Value: int64);
    function GetAsFloat: double;
    procedure SetAsFloat(const Value: double);
    function GetIsNull: boolean;
    procedure SetIsNull(Value: boolean);
  {$IFDEF VER6P}
    function GetAsBCD: TBCD;
    procedure SetAsBCD(const Value: TBCD);
  {$ENDIF}
  protected
    procedure Init;
    procedure Check(Res: sword);
  public
    constructor Create; overload;
    constructor Create(AOCIEnvironment: TOCIEnvironment); overload;
    constructor Create(AOCISvcCtx: TOCISvcCtx); overload;
    destructor Destroy; override;

    procedure SetEnvironment(AEnvironment: TOCIEnvironment);
    procedure Disconnect; override;

    procedure Assign(Source: TOraNumber);
    procedure AssignTo(Dest: TOraNumber);
    function Compare(Dest: TOraNumber): integer;

    property OCINumber: OCINumber read GetOCINumber write SetOCINumber;
    property OCINumberPtr: pOCINumber read GetOCINumberPtr write SetOCINumberPtr;
    property AsString: string read GetAsString write SetAsString;
    property AsInteger: integer read GetAsInteger write SetAsInteger;
    property AsLargeInt: Int64 read GetAsLargeInt write SetAsLargeInt;
    property AsFloat: double read GetAsFloat write SetAsFloat;
    property IsNull: boolean read GetIsNull write SetIsNull;
  {$IFDEF VER6P}
    property AsBCD: TBCD read GetAsBCD write SetAsBCD;
  {$ENDIF}
  end;

{ TOCITransaction }

  TOraTransactionState = (tsInactive, tsActive, tsPrepared, tsFinished);

{$IFNDEF LITE}
  TTransactionLink = record
    BranchQualifier: TBytes;
    State: TOraTransactionState;
    OCITrans: pOCITrans;
  end;
{$ENDIF}

  TOCITransaction = class (TCRTransaction)
  private
    FLocalTransactionId: string;
  {$IFNDEF LITE}
    FTransactionName: string;
    FRollbackSegment: string;
    FTransactionLinks: array of TTransactionLink;
    FInactiveTimeOut: integer;
    FResumeTimeOut: integer;
    FXID: IntPtr;
    FTransactionId: TBytes;
    FResume: boolean;
  {$ENDIF}

  protected
  {$IFNDEF LITE}
    procedure WriteTransactionId;
    procedure WriteBranchQualifier(TransactionLink: TTransactionLink);
    procedure FreeTransaction;
  {$ENDIF}

    function LocalTransactionId(CreateTransaction: boolean = False): string;
    procedure StartTransactionLocal;
    procedure CommitLocal;
    procedure RollbackLocal;

  public
    constructor Create; override;
    destructor Destroy; override;

    procedure Check(Status: sword; Connection: TOCIConnection);
    procedure OraError(OCISvcCtx: TOCISvcCtx; var ErrorCode: sword; UseCallback: boolean);

  {$IFNDEF LITE}
    procedure SetTransactionId(TransactionId: TBytes);
    procedure SetBranchQualifier(Index: integer; BranchQualifier: TBytes);
  {$ENDIF}

    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; var Value: variant): boolean; override;

    function DetectInTransaction(CanActivate: boolean): boolean; override;
    procedure AssignConnect(Source: TCRTransaction); override;

    procedure StartTransaction; override;
    procedure Commit; override;
    procedure Rollback; override;
    procedure Savepoint(const Name: string); override;
    procedure RollbackToSavepoint(const Name: string); override;
  {$IFNDEF LITE}
    procedure Detach;
  {$ENDIF}
  end;

{$IFNDEF LITE}

{ TOCIMetaData }

  TOCIMetaData = class (TCRMetaData)
  protected
    procedure AddOrderBy(var OrderByClause: string; const Value: string);

    function GetTypesForSQL(const ObjectTypes: string; AllTypes: array of string): string;
    function CreateRecordSet: TCRRecordSet; override;

    function InternalGetMetaData(const MetaDataKind: string; Restrictions: TStrings): TData; override;
    procedure InternalGetMetaDataKindsList(List: TStringList); override;
    procedure InternalGetRestrictionsList(List: TStringList; const MetaDataKind: string); override;
    function GetTables(Restrictions: TStrings): TData; override;
    function GetColumns(Restrictions: TStrings): TData; override;
    function GetProcedures(Restrictions: TStrings): TData; override;
    function GetProcedureParameters(Restrictions: TStrings): TData; override;
    function GetIndexes(Restrictions: TStrings): TData; override;
    function GetIndexColumns(Restrictions: TStrings): TData; override;
    function GetConstraints(Restrictions: TStrings): TData; override;

//    function GetDataTypes(Restrictions: TStrings): TData; override;
    function GetUsers(Restrictions: TStrings): TData; override;
    function GetUDTs(Restrictions: TStrings): TData; override;
    function GetPackages(Restrictions: TStrings): TData; override;
    function GetSequences(Restrictions: TStrings): TData;
  end;

{ TOCILoader }

  TOCILoaderColumn = class (TCRLoaderColumn)
  private
    FColumnType: integer;
    FDateFormat: string;
    FIsNational: boolean;
    FIsLob: boolean;
    FOffset: integer;
  protected
    procedure VerifySize;
  public
    constructor Create; override;

    procedure UpdateDataType(Value: word); override;

    property ColumnType: integer read FColumnType write FColumnType;
    property DateFormat: string read FDateFormat write FDateFormat;
    property IsNational: boolean read FIsNational write FIsNational;
    property IsLob: boolean read FIsLob write FIsLob;
    property Offset: integer read FOffset write FOffset;
  end;

  _TDPErrorAction = (_dpAbort, _dpFail, _dpIgnore);
  _TDPErrorEvent = procedure(E: Exception; Col, Row: integer; var Action: _TDPErrorAction) of object;

  TOCILoader = class(TCRLoader)
  private
    FConnection: TOCIConnection;
    FIsDirectMode: boolean;
    FOnError: _TDPErrorEvent;
    FDML: TOCICommand;

    hDirPathCtx: pOCIDirPathCtx;
    hColumnArray: pOCIDirPathColArray;
    hStream: pOCIDirPathStream;

    FBufNumRows: integer;  // count of Rows in ColumnArray
    FBufNumCols: word;     // count of Cols in ColumnArray
    FRowSize: word;      // size of Row in buffer
    FBuffer: IntPtr;
    FLobBuffer: TList;

    function GetOCISvcCtx: TOCISvcCtx;
    function GetOCI7: TOCI7API;
    function GetOCI8: TOCI8API;
    procedure Check(Status: Word);
  protected
    class function GetRecordSetClass: TCRRecordSetClass; override;

    procedure SetConnection(Value: TCRConnection); override;
    procedure FillColumn(Column: TCRLoaderColumn; FieldDesc: TFieldDesc); override;
    function ConverToUnicode(Column: TOCILoaderColumn): boolean;
    procedure CheckLobBuffer;
    procedure ClearLobBuffer;
    procedure FreeLobBuffer;

    property OCISvcCtx: TOCISvcCtx read GetOCISvcCtx;
    property OCI7: TOCI7API read GetOCI7;
    property OCI8: TOCI8API read GetOCI8;
  public
    constructor Create; override;
    destructor Destroy; override;

    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; var Value: variant): boolean; override;

    class function GetColumnClass: TCRLoaderColumnClass; override;
    procedure Prepare; override;
    procedure Reset; override;
    procedure PutColumnData(Col, Row: integer; const Value: variant); override;
    procedure DoLoad; override;
    procedure Finish; override;

    property OnError: _TDPErrorEvent read FOnError write FOnError;
  end;

{ TOCIAlerter }

  _TEventType = (_etAlert, _etPipe);
  TMessageType = (mtNone, mtNumber, mtString, mtDate);

  TAlertEvent = class
  public
    Name: string;
    Message: string;
  end;

  TOCIAlerterTimeoutCallback = procedure(var Continue: boolean) of object;

  TOCIAlerterListenThread = class;

  TOCIAlerter = class(TCRAlerter)
  private
    FGCHandle: IntPtr;
    FListenConnection: TOCIConnection;
    FWaitCommand: TOCICommand;
    FListenThread: TOCIAlerterListenThread;
    FTimeOut: integer;
    FOnTimeOut: TOCIAlerterTimeoutCallback;
    FInterval: integer;
    FEventType: _TEventType;
    FSelfMessage: string;
    FRegistered: boolean;
    FAutoCommit: boolean;
    FSelfEvents: boolean;
  {$IFDEF MSWINDOWS}
    FResponseEvent: TEvent;
    FIntervalEvent: TEvent;
  {$ELSE}
    FLastEvent: TAlertEvent;
  {$ENDIF}

    function GetGCHandle: IntPtr;
    function GetOCISvcCtx: TOCISvcCtx;
    procedure RegisterEvents;
    procedure RemoveEvents;
    procedure SendAlertMessage(const EventName, Message: string);
    function ProcessWaitResult: boolean;
    procedure ProcessMessage;
    function ProcessError(Status: integer): boolean;
  {$IFDEF MSWINDOWS}
    procedure DoOnEvent(const EnentName, Message: string);
  {$ELSE}
    procedure DoOnEvent;
    procedure CallEvent(Event: TAlertEvent);
  {$ENDIF}
    procedure DoOnTimeout(var Continue: boolean);
  {$IFDEF MSWINDOWS}
    procedure DoOnError(E: Exception);
  {$ENDIF}

  protected
    property GCHandle: IntPtr read GetGCHandle;
    property OCISvcCtx: TOCISvcCtx read GetOCISvcCtx;

  public
    constructor Create; override;
    destructor Destroy; override;

    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; var Value: variant): boolean; override;

    procedure SendEvent(const EventName, Message: string); override;
    procedure Start; override;
    procedure Stop; override;

    // pipe methods
    procedure PackMessage(const Item: variant);
    procedure UnpackMessage(var Item: variant);
    function NextItemType: TMessageType;
    procedure SendPipeMessage(const Name: string);
    procedure PurgePipe;

    property OnTimeOut: TOCIAlerterTimeoutCallback read FOnTimeOut write FOnTimeOut;
  end;

  TOCIAlerterListenThread = class(TThread)
  private
    FAlerter: TOCIAlerter;

  protected
    procedure Execute; override;

  public
    constructor Create(Alerter: TOCIAlerter);
    procedure Terminate;
  end;

{$ENDIF}

{ TOraClassesUtils }

  TOraClassesUtils = class
  public
    class procedure InternalUnPrepare(Obj: TOCIRecordSet);
  end;

const
  DefValConnectMode = cmNormal;

var
  SmallintPrecision: integer = 0;
  IntegerPrecision: integer = 9;
  LargeIntPrecision: integer = 0;
  FloatPrecision: integer   = 15;
  BCDPrecision: string      = '14,4';
{$IFNDEF FPC}
  FmtBCDPrecision: string   = '38,38';
{$ENDIF}
  EnableWideOraClob: boolean = True;
  RemoveCRInStringLiterals: boolean = False;
  UseMaxDataSize: boolean = True;
  NumberAsInteger: boolean = False;
  UseOCI7ProcDesc: boolean = False;
  OCISQLInfo: TOCISQLInfo;

  function OraDateToDateTime(Buf: IntPtr): TDateTime;
  function OraDateToMSecs(Buf: IntPtr): double;
  procedure DateTimeToOraDate(DateTime: TDateTime; Buf: IntPtr);
  procedure MSecsToOraDate(MSecs: double; Buf: IntPtr);
{$IFDEF VER6P}
{$IFNDEF FPC}
  procedure OraTimeStampToSQLTimeStamp(OraTimeStamp: TOraTimeStamp; var SQLTimeStamp: TSQLTimeStamp);
  procedure SQLTimeStampToOraTimeStamp(OraTimeStamp: TOraTimeStamp; const SQLTimeStamp: TSQLTimeStamp);
{$ENDIF}
{$ENDIF}

  procedure ParseConnectString(const ConnectString: string;
    var Username, Password, Server: string; var ConnectMode: TConnectMode);

{$IFDEF MSWINDOWS}
  procedure AllocODACWnd;
{$ENDIF}

implementation

uses
  Math,
  {$IFDEF PROF}OraProf, {$ENDIF}
{$IFDEF CLR}
  System.Runtime.InteropServices, System.Text, System.Threading,
{$ELSE}
  {$IFDEF VER6P}Variants,{$ENDIF}
{$ENDIF}
{$IFDEF MSWINDOWS}
{$IFNDEF LITE}
  ComObj,
{$ENDIF}
{$ENDIF}
{$IFDEF NET}
  {$IFNDEF UNIDACPRO}OraNet,{$ELSE}OraNetUni,{$ENDIF}
{$ENDIF}
  CRFunctions, MemUtils, DAConsts,
{$IFNDEF UNIDACPRO}
  OraConsts, {$IFNDEF LITE}OraDataTypeMap,{$ENDIF} OraObjects, OraParser;
{$ELSE}
  OraConstsUni, OraDataTypeMapUni, OraObjectsUni, OraParserUni;
{$ENDIF}

const
  WM_ENDTHREAD       = $400;
  WM_AFTERFETCH      = $404;
  WM_CHANGENOTIFY    = $405;
  WM_ALERTER_EVENT   = $406;
  WM_ALERTER_TIMEOUT = $407;
  WM_ALERTER_STOPED  = $408;

  msTerminate = '__ODAC_Terminate_Event__';
  msBlank = '__ODAC_Blank_Message__';

type
  TArr = array [0..100] of byte;  // DEBUG TEMP
  PArr = ^TArr;
  TArrC = array [0..100] of char;  // DEBUG TEMP
  PArrC = ^TArrC;

{$IFDEF MSWINDOWS}
type
  TExecThread =  class(TThread)
  protected
    FRunMethod : TRunMethod;
    FEndMethod : TEndMethod;
    FhWindow :HWND;
    FException: Exception;
    FGCHandle: IntPtr;
  public
    constructor Create(RunMethod: TRunMethod; EndMethod: TEndMethod; hODACWindow: HWND; CreateSuspended: Boolean);
    destructor Destroy; override;
    procedure Execute; override;
  end;
{$ENDIF}

{ TSessionList }
  TConnectionList = class (TThreadList)
  private
    function GetCount: integer;
    function GetConnection(i: integer): TOCIConnection;
  public
    procedure DisconnectAll;

    property Count: integer read GetCount;
    property Items[i: integer]: TOCIConnection read GetConnection; default;
  end;

var
  OCIConnections: TConnectionList;
{$IFNDEF MSWINDOWS}
  hLockConnect: TCriticalSection;
{$ENDIF}
{$IFDEF MSWINDOWS}
  hODACWindow: HWND = 0;
{$ENDIF}

  OCICallbackDefinePtr: IntPtr;
  OCICallbackInBindPtr: IntPtr;
  OCICallbackOutBindPtr: IntPtr;
  OCICallbackFailoverPtr: IntPtr;
{$IFDEF MSWINDOWS}
  OCICallbackChangeNotifyPtr: IntPtr;
{$ENDIF}

{$IFDEF CLR}
  HOCICallbackDefine: GCHandle;
  HOCICallbackInBind: GCHandle;
  HOCICallbackOutBind: GCHandle;
  HOCICallbackFailover: GCHandle;
  HOCICallbackChangeNotify: GCHandle;
  HWndProc: GCHandle;
{$ENDIF}

function Shift(Value: cardinal): cardinal;
begin
  Result := Value;
  if Result <> 0 then
    if (Result and $FF) = 0 then  // while do
      Result := Result shr 8;
end;

function Reverse2(Value: word): TBytes;
begin
  SetLength(Result, 2);
  Result[0] := byte(Value shr 8);
  Result[1] := byte(Value);
end;

function Reverse4(Value: cardinal): TBytes;
begin
  SetLength(Result, 4);
  Result[0] := byte(Value shr 24);
  Result[1] := byte(Value shr 16);
  Result[2] := byte(Value shr 8);
  Result[3] := byte(Value);
end;

// Converts Count bytes from memory pointed by Bytes to 64 base string. Starting
// digit (6-bit chunk) may be shifted by -4, -2, 0 or 2 bits. Missing bits
// assumed to be zero.
// Bytes are converted in the following way (example for Shift = 0):
// 0 byte   1 byte   hi    lo
// 00000100|00000000|01000001|01000011|...
// ------++ ++++---- --++++++ ------++ +++
//  B(1)   A(0)   B(1)  B(1)   Q(16)
function BytesTo64BaseString(Bytes: TBytes; Count: integer; Shift: integer): string;
const
  Map = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
var
  i, RestBits: cardinal;
  CurByte, Digit, NextDigit: byte;
begin
  Result :='';
  RestBits := 2 - Shift;
  NextDigit := $FF;

  for i := 0 to Count - 1 do begin
    CurByte := Bytes[i];

    Digit := CurByte shr RestBits;
    if NextDigit <> $FF then
      Digit := Digit or NextDigit;

    Result := Result + Map[Digit + 1];

    NextDigit := (CurByte and ($FF shr (8 - RestBits))) shl (6 - RestBits);

    if RestBits = 6 then begin
      Result := Result + Map[NextDigit + 1];
      NextDigit := $FF;
      RestBits := 2;
    end
    else
      RestBits := RestBits + 2;
  end;

  if NextDigit <> $FF then
    Result := Result + Map[NextDigit + 1];
end;

function RowId7ToString(RowId: PRowId7): string;
var
  Buf: TBytes;
begin
  Buf := nil;
  if (RowId.rd.rcs4 = 0) then begin // obj num
  // restricted (Oracle 7)
    Result :=
      IntToHex(Shift(RowId.rcs7), 8) + '.' +
      IntToHex(Shift(RowId.rcs8), 4) + '.' +  // use 2 byte
      IntToHex(RowId.rd.rcs5, 4)
  end
  else begin
  // extended (Oracle 8 and higher)
    Buf := Reverse4(RowId.rd.rcs4);
    Result := BytesTo64BaseString(Buf, 4, -4);

    Buf := Reverse2(RowId.rd.rcs5);
    Result := Result + BytesTo64BaseString(Buf, 2, -2);

    Buf := Reverse4(Shift(RowId.rcs7));
    Result := Result + BytesTo64BaseString(Buf, 4, -4);

    Buf := Reverse2(Shift(RowId.rcs8)); // use 3 byte
    Result := Result + BytesTo64BaseString(Buf, 2, -2);
  end;
end;

function RowId8ToString(RowId: PRowId8): string;
var
  Buf: TBytes;
begin
  Buf := nil;
  if (RowId.ridobjnum = 0) then
  // restricted (Oracle 7)
    Result :=
      IntToHex(Shift(RowId.ridblocknum), 8) + '.' +
      IntToHex(Shift(RowId.ridslotnum), 4) + '.' +
      IntToHex(RowId.ridfilenum, 4)
  else begin
  // extended (Oracle 8 and higher)
    Buf := Reverse4(RowId.ridobjnum);
    Result := BytesTo64BaseString(Buf, 4, -4);

    Buf := Reverse2(RowId.ridfilenum);
    Result := Result + BytesTo64BaseString(Buf, 2, -2);

    Buf := Reverse4(RowId.ridblocknum);
    Result := Result + BytesTo64BaseString(Buf, 4, -4);

    Buf := Reverse2(RowId.ridslotnum);
    Result := Result + BytesTo64BaseString(Buf, 2, -2);
  end;
end;

function RowId81ToString(RowIdPtr: PRowId81): string;
var
  Bytes: TBytes;
begin
  if RowIdPtr.ridobjnum = 0 then begin
  // restricted (Oracle 7)
    Result :=
      IntToHex(BitConverter.ToInt32(Reverse4(RowIdPtr.ridblocknum), 0), 8) + '.' +
      IntToHex(BitConverter.ToInt16(Reverse2(RowIdPtr.ridslotnum), 0), 4) + '.' +
      IntToHex(BitConverter.ToInt16(Reverse2(RowIdPtr.ridfilenum), 0), 4)
  end
  else begin
  // extended (Oracle 8 and higher)
    SetLength(Bytes, 4);
    Marshal.Copy(PtrOffset(RowIdPtr, 1{TRowId81.ridobjnum}), Bytes, 0, 4);
    Result := BytesTo64BaseString(Bytes, 4, -4);
    Marshal.Copy(PtrOffset(RowIdPtr, 5{TRowId81.ridfilenum}), Bytes, 0, 2);
    Result := Result + BytesTo64BaseString(Bytes, 2, -2);
    Marshal.Copy(PtrOffset(RowIdPtr, 7{TRowId81.ridblocknum}), Bytes, 0, 4);
    Result := Result + BytesTo64BaseString(Bytes, 4, -4);
    Marshal.Copy(PtrOffset(RowIdPtr, 11{TRowId81.ridslotnum}), Bytes, 0, 2);
    Result := Result + BytesTo64BaseString(Bytes, 2, -2);
  end;
end;

function URowIdToString(RowIdPtr: PRowId81; Length: integer): string;
var
  Bytes: TBytes;
begin
  SetLength(Bytes, Length - 1);
  Marshal.Copy(PtrOffset(RowIdPtr, 1), Bytes, 0, Length - 1);
  Result := '*' + BytesTo64BaseString(Bytes, Length - 1, 0);
end;

{ Data convertion }

function OraDateToDateTime(Buf: IntPtr): TDateTime;
var
  Time: TDateTime;
  OraDate: TBytes;
begin
  SetLength(OraDate, 7);
  Marshal.Copy(Buf, OraDate, 0, 7);
  Result := EncodeDate(Abs((OraDate[0] - 100) * 100 + OraDate[1] - 100),
    OraDate[2], OraDate[3]);
  Time := EncodeTime(OraDate[4] - 1, OraDate[5] - 1, OraDate[6] - 1, 0);
  if Result < 0 then
    Result := Result - Time
  else
    Result := Result + Time;
end;

function OraDateToMSecs(Buf: IntPtr): double;
begin
  Result := TimeStampToMSecs(DateTimeToTimeStamp(OraDateToDateTime(Buf)));//{$IFNDEF CLR}BitConverter.DoubleToInt64Bits{$ENDIF}
end;

procedure DateTimeToOraDate(DateTime: TDateTime; Buf: IntPtr);
var
  Year, Month, Day, Hour, Min, Sec, MSec: word;
  OraDate: TBytes;
begin
  SetLength(OraDate, 8);
  DecodeDate(DateTime, Year, Month, Day);
  DecodeTime(DateTime, Hour, Min, Sec, MSec);
  OraDate[0] := Year div 100 + 100;
  OraDate[1] := Year mod 100 + 100;
  OraDate[2] := Month;
  OraDate[3] := Day;
  OraDate[4] := Hour + 1;
  OraDate[5] := Min + 1;
  OraDate[6] := Sec + 1;
  Marshal.Copy(OraDate, 0, Buf, 7);
end;

procedure MSecsToOraDate(MSecs: double; Buf: IntPtr);
begin
  DateTimeToOraDate(MemUtils.TimeStampToDateTime(MSecsToTimeStamp(Trunc(MSecs))), Buf);
end;

{$IFDEF VER6P}
{$IFNDEF FPC}
procedure OraTimeStampToSQLTimeStamp(OraTimeStamp: TOraTimeStamp; var SQLTimeStamp: TSQLTimeStamp);
var
  Year: SmallInt;
  Month, Day, Hour, Min, Sec: byte;
  FSec: cardinal;
begin
  if OraTimeStamp.IsNull then
    SQLTimeStamp := NullSqlTimeStamp
  else begin
    OraTimeStamp.GetDate(Year, Month, Day);
    SQLTimeStamp.Year := Year;
    SQLTimeStamp.Month := Month;
    SQLTimeStamp.Day := Day;

    OraTimeStamp.GetTime(Hour, Min, Sec, FSec);
    SQLTimeStamp.Hour := Hour;
    SQLTimeStamp.Minute := Min;
    SQLTimeStamp.Second := Sec;
    SQLTimeStamp.Fractions := FSec div 1000000;
  end;
end;

procedure SQLTimeStampToOraTimeStamp(OraTimeStamp: TOraTimeStamp; const SQLTimeStamp: TSQLTimeStamp);
begin
  if (SQLTimeStamp.Year = 0) and (SQLTimeStamp.Month = 0) and (SQLTimeStamp.Day = 0)
    and (SQLTimeStamp.Hour = 0) and (SQLTimeStamp.Minute = 0) and (SQLTimeStamp.Second = 0)
    and (SQLTimeStamp.Fractions = 0)
  then
    OraTimeStamp.IsNull := True
  else
    OraTimeStamp.Construct(SQLTimeStamp.Year, SQLTimeStamp.Month, SQLTimeStamp.Day,
      SQLTimeStamp.Hour, SQLTimeStamp.Minute, SQLTimeStamp.Second, SQLTimeStamp.Fractions * 1000000, '');
end;
{$ENDIF}
{$ENDIF}

procedure GetPrecAndScale(const Value: string; var Precision, Scale: integer);
var
  P: integer;
begin
  P := Pos(',', Value);
  if P > 0 then begin
    Precision := StrToInt(Trim(Copy(Value, 1, P - 1)));
    Scale := StrToInt(Trim(Copy(Value, P + 1, Integer(Length(Value) - P))));
  end
  else begin
    Precision := StrToInt(Trim(Value));
    Scale := 0;
  end;
end;

{ TConnectionList }

function TConnectionList.GetCount: integer;
var
  List: TList;
begin
  List := LockList;
  try
    Result := List.Count;
  finally
    UnlockList;
  end;
end;

function TConnectionList.GetConnection(i: integer): TOCIConnection;
var
  List: TList;
begin
  List := LockList;
  try
    Result := TOCIConnection(List[i]);
  finally
    UnlockList;
  end;
end;

procedure TConnectionList.DisconnectAll;
var
  i: integer;
begin
  LockList;
  try
    for i := 0 to Count - 1 do
    try
      Items[i].Disconnect;
    except
    end;
  finally
    UnlockList;
  end;
end;

{ TOCIConnection }

constructor TOCIConnection.Create;
begin
  inherited Create;

{$IFNDEF CLR}
  FIPVersion := ivIPv4;
{$ENDIF}
  FAutoCommit := True;
  FThreadSafety := True;
  FOCICallStyle := None;
  FEnableIntegers := True;
  FEnableWideOraClob := EnableWideOraClob;
  FCharLength := 0;
  FQueryCharLength := FCharLength = 0;
  FInternalName := '';

  FSmallintPrecision := SmallintPrecision;
  FIntegerPrecision := IntegerPrecision;
  FLargeIntPrecision := LargeIntPrecision;
  FFloatPrecision := FloatPrecision;
  GetPrecAndScale(BCDPrecision, FBCDPrecision, FBCDScale);
{$IFDEF VER6P}
{$IFNDEF FPC}
  GetPrecAndScale(FmtBCDPrecision, FFmtBCDPrecision, FFmtBCDScale);
{$ENDIF}
{$ENDIF}
  FUnicodeAsNational := OCIUnicodeAsNational;

  FNlsParams[nlsDateLanguage].Name := 'NLS_DATE_LANGUAGE';
  FNlsParams[nlsDateFormat].Name := 'NLS_DATE_FORMAT';
  FNlsParams[nlsTimeStampFormat].Name := 'NLS_TIMESTAMP_FORMAT';
  FNlsParams[nlsTimeStampTZFormat].Name := 'NLS_TIMESTAMP_TZ_FORMAT';
  FNlsParams[nlsNumericCharacters].Name := 'NLS_NUMERIC_CHARACTERS';

{$IFDEF MSWINDOWS}
  hBusy := CreateMutex(nil, False, '');
{$ENDIF}

  OCIConnections.Add(Self);
end;

destructor TOCIConnection.Destroy;
begin
  Disconnect;

  OCIConnections.Remove(Self);

  FCommand.Free;

{$IFDEF MSWINDOWS}
  CloseHandle(hBusy);
{$ENDIF}

  inherited;
end;

function TOCIConnection.GetCommandClass: TCRCommandClass;
begin
  Result := TOCICommand;
end;

function TOCIConnection.GetTransactionClass: TCRTransactionClass;
begin
  Result := TOCITransaction;
end;

procedure TOCIConnection.RaiseError(const Msg: string);
begin
  raise Exception.Create(Msg);
end;

procedure TOCIConnection.DoError(E: Exception; var Fail: boolean);
begin
  inherited; //for D8
end;

procedure TOCIConnection.CheckOCI;
begin
  if not ((FOCICallStyle = OCI73) or (FOCICallStyle = OCI80)) then
    RaiseError(SCheckOCI);
end;

procedure TOCIConnection.CheckOCI73;
begin
  if not (FOCICallStyle = OCI73) then
    RaiseError(SCheckOCI73);
end;

procedure TOCIConnection.CheckOCI80;
begin
  if not (FOCICallStyle = OCI80) then
    RaiseError(SCheckOCI80);
end;

procedure TOCIConnection.Check(Status: sword);
begin
  if Status <> OCI_SUCCESS then
    OraError(FOCICallStyle, Status, True, Component);
end;

procedure TOCIConnection.OraError(FOCICallStyle: TOCICallStyle;
  ErrorCode: sword; UseCallback: boolean; Component: TObject);
const
  MsgLen = 512;
var
  MsgBuf: IntPtr;
  Msg: string;
  Code: integer;
  Fail, NeedFreeError: boolean;
  Error: EOraError;
begin
  Code := 0;
  if FOCICallStyle = OCI73 then begin
    Code := ErrorCode;
    if Code = -9 then
      Code := -1;
    MsgBuf := Marshal.AllocHGlobal(MsgLen + 1);
    try
      OCI7.oerhms(LDA, Code, MsgBuf, MsgLen);
      Msg := string(Marshal.PtrToStringAnsi(MsgBuf));
    finally
      Marshal.FreeHGlobal(MsgBuf);
    end;
    Code := Abs(Code);
  end
  else
  if FOCICallStyle = OCI80 then begin
    Code := OCI8.GetOraError(ErrorCode, OCISvcCtx, Msg);
  end
  else
    CheckOCI;

  FLastError := Code;

  NeedFreeError := True;
  Error := EOraError.Create(Code, Msg);
  try
  {$IFNDEF LITE}
    Error.Component := Component;
  {$ENDIF}

    if (FOCICallStyle = OCI80) and (ErrorCode = OCI_SUCCESS_WITH_INFO)
      and (Code <> 24344) // except compilation error
    then begin
      if Assigned(FOnInfoMessage) then
        FOnInfoMessage(Error);
      exit;
    end;

    Fail := True;
    if UseCallback then
      DoError(Error, Fail);
    if Fail then
      NeedFreeError := False;
  finally
    if NeedFreeError then
      Error.Free;
  end;

  if Fail then
    raise Error
  else
    Abort;
end;

function OCICallbackFailover(svchp: IntPtr; envhp: IntPtr; fo_ctx: IntPtr; fo_type: ub4; fo_event: ub4): sb4;{$IFNDEF CLR} cdecl; {$ENDIF}
var
  OCIConnection: TOCIConnection;
  Retry: boolean;
  i: TNlsParamType;
begin
  OCIConnection := TOCIConnection(GetGCHandleTarget(fo_ctx));
  Assert(OCIConnection <> nil);
  Result := 0;
  if fo_event = OCI_FO_END then begin
      // apply user NLS settings
    with OCIConnection do begin
      for i := Low(FNlsParams) to High(FNlsParams) do
        if FNlsParams[i].IsUserDefined then
          SetNlsParameter(FNlsParams[i].Name, FNlsParams[i].Value);
    end;
  end;

  if Assigned(OCIConnection.FOnFailover) then begin
    Retry := False;
    OCIConnection.FOnFailover(fo_event, fo_type, Retry);
    if Retry then
      Result := OCI_FO_RETRY;
  end;
end;

procedure TOCIConnection.SetConnectionType(ConnectionType: TConnectionType);
begin
  Assert(not FConnected);
  FConnectionType := ConnectionType;
end;

procedure TOCIConnection.SetStatementCacheSize(Size: integer);
begin
  if (FStatementCache) and (OCI73 in OCISvcCtx.Home.PossibleOCICallStyles) and
     (FOCICallStyle = OCI80) and (OCISvcCtx.Home.OCIVersion > 9200)
  then begin
    CheckOCI80;
    Check(OCI8.OCIAttrSet2(OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX, Size, 4, OCI_ATTR_STMTCACHESIZE, OCISvcCtx.hOCIError));
  end; //TODO: else Raise Error Statemet caching supported sice version 9.2
end;

{$IFDEF MSWINDOWS}
{$IFNDEF LITE}
procedure TOCIConnection.MTSCheck(Status: sword);
begin
  if Status <> ORAMTSERR_NOERROR then
    MTSError(Status, True);
end;

procedure TOCIConnection.MTSError(var ErrorCode: sword; UseCallback: boolean);
var
  Msg: string;
  Fail: boolean;
begin
  ErrorCode := OCI8.GetOraError(ErrorCode, FOCISvcCtx, Msg);

  try
    raise EOraError.Create(ErrorCode, Msg);
  except
    on E: EOraError do begin
      Fail := True;
      if UseCallback then
        DoError(E, Fail);
      if Fail then
        raise
      else
        Abort;
    end;
  end;
end;

procedure TOCIConnection.Enlist(Transaction: TMTSTransaction);
var
  Value: variant;
begin
  Transaction.GetProp(prTransactionReadOnly, Value);
  if Value then
    raise Exception.Create(SReadOnlyNotSupportedWithMTS);

  Transaction.GetProp(prIsolationLevel, Value);
  if TCRIsolationLevel(Value) <> ilReadCommitted then
    raise Exception.Create(SIsolationLevelNotSupportedWithMTS);

  Assert(hMTSSvcCtx = nil);

  if FConnectionType = ctMTSPooled then begin
    hMTSSvcCtx := OCISvcCtx.hOCISvcCtx;
    MTSCheck(MTS.OraMTSSvcEnlist(hMTSSvcCtx, OCISvcCtx.hOCIError, Transaction.MTSTransaction, ORAMTS_ENFLG_DEFAULT));
  end
  else begin
    MTSCheck(MTS.OraMTSEnlCtxGet(PAnsiChar(AnsiString(FUserName)), PAnsiChar(AnsiString(FPassword)),
      PAnsiChar(AnsiString(FServer)), OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, OCI_DEFAULT, hMTSSvcCtx));
    MTSCheck(MTS.OraMTSJoinTxn(hMTSSvcCtx, Transaction.MTSTransaction));
  end;
end;

procedure TOCIConnection.UnEnlist(Transaction: TMTSTransaction);
begin
  if hMTSSvcCtx = nil then
    exit;

  if FConnectionType = ctMTSPooled then
    MTSCheck(MTS.OraMTSSvcEnlist(hMTSSvcCtx, OCISvcCtx.hOCIError, nil, ORAMTS_ENFLG_DEFAULT))
  else begin
    MTSCheck(MTS.OraMTSJoinTxn(hMTSSvcCtx, nil));
    MTSCheck(MTS.OraMTSEnlCtxRel(hMTSSvcCtx));
  end;

  hMTSSvcCtx := nil;
end;
{$ENDIF}
{$ENDIF}

procedure TOCIConnection.SetupConnection;
begin
  FOracleVersionFull := '';
  FOracleVersionSt := '';
  FOracleVersion := 0;

  if (FOCICallStyle = None) or not (FOCICallStyle in OCISvcCtx.Home.PossibleOCICallStyles) then
    FOCICallStyle := OCISvcCtx.Home.OCICallStyle;

  FOCICallStyle := OCISvcCtx.Home.OCICallStyle;

  if FProxyConnection <> nil then
    CheckOCI80;

  FOCICallStyleCommand := FOCICallStyle;
end;

procedure TOCIConnection.Connect(const ConnectString: string);
var
  Credt: ub4;
  Mode: ub4;
  i: TNlsParamType;
  Failover: TOCIFoCbkStruct;
  Handle: IntPtr;
  CharsetId: Integer; //ub2
  Res, Size: Integer;
{$IFNDEF CLR}
{$IFDEF NET}
  IPVersion: integer;
{$ENDIF}
{$ENDIF}
  p: IntPtr;


  function GetOraConnectMode(MTS: boolean): integer;
  begin
  {$IFDEF MSWINDOWS}
  {$IFNDEF LITE}
    if MTS then
      case FConnectMode of
        cmSYSOPER:
          Result := ORAMTS_CFLG_SYSOPRLOGN;
        cmSYSDBA:
          Result := ORAMTS_CFLG_SYSDBALOGN;
      else
        Result := OCI_DEFAULT;
      end
    else
  {$ENDIF}
  {$ENDIF}
      case FConnectMode of
        cmSYSOPER:
          Result := OCI_SYSOPER;
        cmSYSDBA:
          Result := OCI_SYSDBA;
        cmSysASM:
          Result := OCI_SYSASM;
        cmSysBkp:
          Result := OCI_SYSBKP;
        cmSysDG:
          Result := OCI_SYSDGD;
        cmSysKM:
          Result := OCI_SYSKMT;
      else
        Result := OCI_DEFAULT;
      end;
  end;


  procedure ConnectDefaultOCI80;
  begin
    if OCISvcCtx.UnicodeEnv and not FUseUnicode then
      RaiseError(SUseUnicodeRequired);

    OCISvcCtx.AllocSvcCtxHandle;

    //For child proxy session we don't need Server handle
    if (FProxyConnection = nil) and (hServer = nil) then
      Check(OCI8.OCIHandleAlloc(OCISvcCtx.hOCIEnv, hServer, OCI_HTYPE_SERVER, 0, nil));
    if hSession = nil then
      Check(OCI8.OCIHandleAlloc(OCISvcCtx.hOCIEnv, hSession, OCI_HTYPE_SESSION, 0, nil));

  {$IFNDEF LITE}
    if (FClientIdentifier <> '') and (OCISvcCtx.Home.OCIVersion >= 9000) then begin
      p := StringToHGlobalOCI(FClientIdentifier, Size, OCISvcCtx.UnicodeEnv);
      Res := OCI8.OCIAttrSet1(hSession, OCI_HTYPE_SESSION, p, Size,
        OCI_ATTR_CLIENT_IDENTIFIER, OCISvcCtx.hOCIError);
      FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
      Check(Res);
    end;
  {$ENDIF}

    try
      if FProxyConnection = nil then begin
      {$IFNDEF MSWINDOWS}
        hLockConnect.Enter;
        try
      {$ENDIF}
          p := StringToHGlobalOCI(FServer, Size, OCISvcCtx.UnicodeEnv);
          Res := OCI8.OCIServerAttach(hServer, OCISvcCtx.hOCIError, p, Size, OCI_DEFAULT);
          FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
          Check(Res);
      {$IFNDEF MSWINDOWS}
        finally
          hLockConnect.Leave;
        end;
      {$ENDIF}
      end;

      if (OCI73 in OCISvcCtx.Home.PossibleOCICallStyles) and (FProxyConnection = nil) then begin
        p := StringToHGlobalOCI(FInternalName, Size, OCISvcCtx.UnicodeEnv);
        Res := OCI8.OCIAttrSet1(hServer, OCI_HTYPE_SERVER, p, 0, OCI_ATTR_INTERNAL_NAME, OCISvcCtx.hOCIError);
        FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
        Check(Res);
      end;
      try
      // Set the server context in the service context
        if FProxyConnection = nil then
          Check(OCI8.OCIAttrSet1(OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX, hServer, 0, OCI_ATTR_SERVER, OCISvcCtx.hOCIError))
        else
          Check(OCI8.OCIAttrSet1(OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX, FProxyConnection.hServer, 0, OCI_ATTR_SERVER, OCISvcCtx.hOCIError));

        if FProxyConnection <> nil then begin
          p := StringToHGlobalOCI(FUsername, Size, OCISvcCtx.UnicodeEnv);
          Res := OCI8.OCIAttrSet1(hSession, OCI_HTYPE_SESSION, p, Size, OCI_ATTR_USERNAME, OCISvcCtx.hOCIError);
          FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
          Check(Res);

          if FPassword <> '' then begin
            p := StringToHGlobalOCI(FPassword, Size, OCISvcCtx.UnicodeEnv);
            Res := OCI8.OCIAttrSet1(hSession, OCI_HTYPE_SESSION, p, Size, OCI_ATTR_PASSWORD, OCISvcCtx.hOCIError);
            FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
            Check(Res);
          end;

          Check(OCI8.OCIAttrSet1(hSession, OCI_HTYPE_SESSION, FProxyConnection.hSession, 0, OCI_ATTR_PROXY_CREDENTIALS, OCISvcCtx.hOCIError));
          Credt := OCI_CRED_PROXY;
        end
        else
          if FUsername <> '' then begin
          // Set username and password attribute in user session handle
            p := StringToHGlobalOCI(FUsername, Size, OCISvcCtx.UnicodeEnv);
            Res := OCI8.OCIAttrSet1(hSession, OCI_HTYPE_SESSION, p, Size, OCI_ATTR_USERNAME, OCISvcCtx.hOCIError);
            FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
            Check(Res);

            p := StringToHGlobalOCI(FPassword, Size, OCISvcCtx.UnicodeEnv);
            Res := OCI8.OCIAttrSet1(hSession, OCI_HTYPE_SESSION, p, Size, OCI_ATTR_PASSWORD, OCISvcCtx.hOCIError);
            FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
            Check(Res);

            Credt := OCI_CRED_RDBMS;
          end
          else
            Credt := OCI_CRED_EXT;

        Mode := GetOraConnectMode(False);

        ///Version > 9200
        if (FStatementCache) and (OCI73 in OCISvcCtx.Home.PossibleOCICallStyles) and
         (FOCICallStyle = OCI80) and (OCISvcCtx.Home.OCIVersion > 9200)
        then
          Mode := Mode or OCI_STMT_CACHE;

        if OCISvcCtx.Home.PossibleOCICallStyles = [OCI80] then begin
          Check(OCI8.OCIAttrSet2(OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX, FConnectionTimeout, 0, OCI_ATTR_CONNECTION_TIMEOUT, OCISvcCtx.hOCIError));
          if FUseUnicode then begin
            CharsetId := Integer(OCI_UTF16ID);
            Check(OCI8.OCIAttrSet2(OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX, CharsetId, 0, OCI_ATTR_CHARSET_ID, OCISvcCtx.hOCIError));
          end
          else
            if FCharset <> '' then begin
              p := StringToHGlobalOCI(FCharset, Size, OCISvcCtx.UnicodeEnv);
              Res := OCI8.OCIAttrSet1(OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX, p, 0, OCI_ATTR_CHARSET, OCISvcCtx.hOCIError);
              FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
              Check(Res);
            end;
        end;

      {$IFNDEF CLR}
      {$IFDEF NET}
        // IPVersion for Direct mode
        if FDirect then begin
          IPVersion := Integer(FIPVersion);
          Res := OCI8.OCIAttrSet2(OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX, IPVersion, 0, OCI_ATTR_IP_VERSION, OCISvcCtx.hOCIError);
          Check(Res);
        end;
      {$ENDIF}
      {$ENDIF}

      {$IFNDEF MSWINDOWS}
        hLockConnect.Enter;
        try
      {$ENDIF}
          Check(OCI8.OCISessionBegin(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hSession, Credt, Mode));
      {$IFNDEF MSWINDOWS}
        finally
          hLockConnect.Leave;
        end;
      {$ENDIF}

      // Set the user session in the service context
        Check(OCI8.OCIAttrSet1(OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX, hSession, 0, OCI_ATTR_SESSION, OCISvcCtx.hOCIError));

        if OCI73 in OCISvcCtx.Home.PossibleOCICallStyles then
          if GetOracleVersion < 8000 then
            FOCICallStyleCommand := OCI73;
      except
        if hServer <> nil then
          Check(OCI8.OCIServerDetach(hServer, OCISvcCtx.hOCIError, OCI_DEFAULT));
        raise;
      end;
    except
      on EFailOver do begin
        // do not free handles
      end
      else begin
        if hSession <> nil then
          OCI8.OCIHandleFree(hSession, OCI_HTYPE_SESSION);
        if hServer <> nil then
          OCI8.OCIHandleFree(hServer, OCI_HTYPE_SERVER);
        OCISvcCtx.FreeSvcCtxHandle;
        hSession := nil;
        hServer := nil;
      end;

      raise;
    end;
  end;

  procedure ConnectOCIPooled;
  begin
    CheckOCI80;
    FOCIPoolName := ConnectString;

    if OCISvcCtx.UnicodeEnv and not FUseUnicode then
      RaiseError(SUseUnicodeRequired);

    if hOCIAuthInfo = nil then
      Check(OCI8.OCIHandleAlloc(OCISvcCtx.hOCIEnv, hOCIAuthInfo, OCI_HTYPE_AUTHINFO, 0, nil));

    try
      p := StringToHGlobalOCI(FUserName, Size, OCISvcCtx.UnicodeEnv);
      Res := OCI8.OCIAttrSet1(hOCIAuthInfo, OCI_HTYPE_AUTHINFO, p, Size, OCI_ATTR_USERNAME, OCISvcCtx.hOCIError);
      FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
      Check(Res);

      p := StringToHGlobalOCI(FPassword, Size, OCISvcCtx.UnicodeEnv);
      Res := OCI8.OCIAttrSet1(hOCIAuthInfo, OCI_HTYPE_AUTHINFO, p, Size, OCI_ATTR_PASSWORD, OCISvcCtx.hOCIError);
      FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
      Check(Res);

      Mode := OCI_SESSGET_SPOOL;
      if (FStatementCache) and (OCI73 in OCISvcCtx.Home.PossibleOCICallStyles) and
        (FOCICallStyle = OCI80) and (OCISvcCtx.Home.OCIVersion > 9200)
      then
        Mode := Mode or OCI_SESSGET_STMTCACHE;

      OCISvcCtx.AllocPooledSvcCtxHandle(FOCIPoolName, hOCIAuthInfo);
    except
      if hOCIAuthInfo <> nil then
        Check(OCI8.OCIHandleFree(hOCIAuthInfo, OCI_HTYPE_AUTHINFO));

      raise;
    end;
  end;

{$IFDEF MSWINDOWS}
{$IFNDEF LITE}
  procedure ConnectMTSPooled;
  begin
    OCISvcCtx.AllocMTSPooledSvcCtxHandle(FServer, FUserName, FPassword);

    if OCISvcCtx.UnicodeEnv and not FUseUnicode then begin
      Disconnect;
      RaiseError(SUseUnicodeRequired);
    end;
  end;
{$ENDIF}
{$ENDIF}

var
  Environment: TOCIEnvironment;
begin
  if not FConnected then begin
  {$IFDEF NET}
    if FDirect then
      Environment := OracleHomes.Direct.AllocEnvironment(FUnicodeEnvironment, 0)
    else
  {$ENDIF}
      Environment := OracleHomes.GetHome(FHomeName).AllocEnvironment(FUnicodeEnvironment, {$IFNDEF LITE}FSubscriptionPort{$ELSE}0{$ENDIF});

    FOCISvcCtx := TOCISvcCtx.Create(Environment, FUseUnicode);
  {$IFNDEF AUTOREFCOUNT}
    FOCISvcCtx.AddRef;
  {$ENDIF}

    try
      SetupConnection;

      if FOCICallStyle = OCI73 then begin
      // Allocate LDA, HDA
      {$IFDEF CLR}
        if IntPtr(LDA) = nil then
          LDA := Marshal.AllocHGlobal(CDA_SIZE);
        if HDA = nil then
          HDA := Marshal.AllocHGlobal(HDA_SIZE);
      {$ELSE}
        if LDA = nil then
          New(LDA);
        if HDA = nil then
          New(HDA);
      {$ENDIF}
        FillChar(HDA, HDA_SIZE, 0);

        try
          Check(OCI7.olog(LDA, HDA, PAnsiChar(AnsiString(FUsername)), -1,
            PAnsiChar(AnsiString(FPassword)), -1,
            PAnsiChar(AnsiString(FServer)), -1, OCI_LM_DEF));

          if FThreadSafety and not OCI7.GetThreadSafety then
            OCI7.SetThreadSafety(True);
        except
        {$IFNDEF CLR}
          Dispose(HDA);
          Dispose(LDA);
        {$ELSE}
          Marshal.FreeHGlobal(HDA);
          Marshal.FreeHGlobal(LDA);
        {$ENDIF}
          LDA := nil;
          HDA := nil;
          raise;
        end;
      end
      else
      if FOCICallStyle = OCI80 then begin
        case FConnectionType of
          ctDefault:
            ConnectDefaultOCI80;
          ctOCIPooled:
            ConnectOCIPooled;
        {$IFDEF MSWINDOWS}
        {$IFNDEF LITE}
          ctMTSPooled:
            ConnectMTSPooled;
        {$ENDIF}
        {$ENDIF}
        end;
      end
      else
        CheckOCI;

      FConnected := True;

      SetStatementCacheSize(FStatementCacheSize);

      // FailOver callback for child ProxyConnection
      // implemented using base ProxyConnection failover events
      if (FProxyConnection = nil) and (OCI73 in OCISvcCtx.Home.PossibleOCICallStyles) and
        (FOCICallStyle = OCI80) and (FConnectionType = ctDefault) and
        (GetOracleVersion >= 8000)
      then begin
        Failover.fo_ctx := AllocGCHandle(Self, False);
        Failover.callback_function := OCICallbackFailoverPtr;
        Handle := AllocGCHandle({$IFNDEF CLR}@{$ENDIF}Failover, True);
        try
          Check(OCI8.OCIAttrSet1(hServer, OCI_HTYPE_SERVER, GetAddrOfPinnedObject(Handle), 0, OCI_ATTR_FOCBK, OCISvcCtx.hOCIError));
        finally
          FreeGCHandle(Handle);
        end;
      end;

      // apply user NLS settings
      for i := Low(FNlsParams) to High(FNlsParams) do
        if FNlsParams[i].IsUserDefined then
          SetNlsParameter(FNlsParams[i].Name, FNlsParams[i].Value);

      // get session parameters if necessary
      if (FCharset <> '') or (FCharLength = 0) then
        GetSessionParameters;

    {$IFNDEF LITE}
      SetOptimizerMode;
      if (FClientIdentifier <> '') and (OCISvcCtx.Home.OCIVersion < 9000) then
        SetClientIdentifier;
      if FSchema <> '' then
        SetCurrentSchema(FSchema);
    {$ENDIF}

      inherited;
    except
    {$IFNDEF AUTOREFCOUNT}
      FOCISvcCtx.ReleaseRef;
    {$ENDIF}
      FOCISvcCtx := nil;
      raise;
    end;
  end;
end;

procedure TOCIConnection.Disconnect;
var
  i: TNlsParamType;
begin
  if FConnected then begin
    try
      if FOCICallStyle = OCI73 then begin
        FConnected := False;
        try
          if FNativeConnection then
            Check(OCI7.ologof(LDA));
        finally
        // Free LDA, HDA
        {$IFDEF CLR}
          if HDA <> nil then
            Marshal.FreeHGlobal(HDA);
          if (IntPtr(LDA) <> nil) and FNativeConnection then
            Marshal.FreeHGlobal(LDA);
        {$ELSE}
          if HDA <> nil then
            Dispose(HDA);
          if (IntPtr(LDA) <> nil) and FNativeConnection then
            Dispose(LDA);
        {$ENDIF}
          HDA := nil;
          LDA := nil;
        end;
      end
      else
      if FOCICallStyle = OCI80 then begin
        FConnected := False;
        try
          case FConnectionType of
            ctDefault: begin
              if FNativeConnection then begin
              //We should leave ObjectTypes in DisconnectMode to access Objects
              //Types will be destroyed only when there are no more references on them
                if ObjectTypes <> nil then
                  ObjectTypes.ClearTypes(OCISvcCtx, FDisconnectMode);
                if OCISvcCtx.hOCIError <> nil then
                  Check(OCI8.OCISessionEnd(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hSession, OCI_DEFAULT));
                if hServer <> nil then
                  Check(OCI8.OCIServerDetach(hServer, OCISvcCtx.hOCIError, OCI_DEFAULT));
                OCISvcCtx.FreeSvcCtxHandle;                  
              end;
            end;
            ctOCIPooled: begin
              Check(OCI8.OCISessionRelease(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, nil, 0, OCI_DEFAULT));
              OCISvcCtx.FreeSvcCtxHandle;
            end;
          {$IFDEF MSWINDOWS}
          {$IFNDEF LITE}
            ctMTSPooled: begin
              MTSCheck(MTS.OraMTSSvcRel(OCISvcCtx.hOCISvcCtx));
              OCISvcCtx.FreeSvcCtxHandle;              
            end;
          {$ENDIF}
          {$ENDIF}
          end;
        finally
        // Free handles
          if hOCIAuthInfo <> nil then
            OCI8.OCIHandleFree(hOCIAuthInfo, OCI_HTYPE_AUTHINFO);
          if hSession <> nil then
            OCI8.OCIHandleFree(hSession, OCI_HTYPE_SESSION);
          if hServer <> nil then
            OCI8.OCIHandleFree(hServer, OCI_HTYPE_SERVER);
          if FOCISvcCtx <> nil then begin
          {$IFNDEF AUTOREFCOUNT}
            FOCISvcCtx.ReleaseRef;
          {$ENDIF}
            FOCISvcCtx := nil;
          end;
        {$IFDEF LOCAL_ERROR_HANDLE}
          if hOCIError <> nil then
            OCI8.OCIHandleFree(hOCIError, OCI_HTYPE_ERROR);
        {$ENDIF}
          hOCIAuthInfo := nil;
          hSession := nil;
          hServer := nil;

          if (IntPtr(LDA) <> nil) and FNativeConnection then begin  // For convert to LDA
          {$IFDEF CLR}
            Marshal.FreeHGlobal(LDA);
          {$ELSE}
            Dispose(LDA);
          {$ENDIF}
            LDA := nil;
          end;
        end;
      end
      else
        CheckOCI;

    finally
      FNativeConnection := True;
      FOracleVersionFull := '';
      FOracleVersionSt := '';
      FOracleVersion := 0;
    {$IFNDEF LITE}
      FCachedSchema := '';
    {$ENDIF}

      // reset session parameters
      FMaxStringSize := 0;
      FCharsetId := 0;
      if FQueryCharLength then
        FCharLength := 0;
      for i := Low(FNlsParams) to High(FNlsParams) do
        if not FNlsParams[i].IsUserDefined then
          FNlsParams[i].Value := '';
    end;
  end;
end;

procedure TOCIConnection.Ping;
var
  Command: TOCICommand;
begin
  if (OCISvcCtx.Home.PossibleOCICallStyles <> [OCI80]) and
     (OCISvcCtx.Home.OCIVersion >= 10200) and (GetOracleVersion >= 10200)
  then
    Check(OCI8.OCIPing(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, OCI_DEFAULT))
  else begin
    Command := GetCommand;
    Command.SetSQL('Begin Null; End;');
    Command.Execute;
  end;
end;

function TOCIConnection.CreateCommand: TOCICommand;
begin
  Result := TOCICommand.Create;
  Result.SetConnection(Self);
  Result.SetProp(prAutoCommit, False); // stataments that are executed with this command don't need to be commited
end;

function TOCIConnection.GetCommand: TOCICommand;
begin
  if FCommand = nil then
    FCommand := CreateCommand;

  Result := FCommand;
end;

function TOCIConnection.GetOracleVersion: word;
begin
  if FOracleVersion = 0 then
    FOracleVersion := VersionStrToWord(GetServerVersion);
  Result := FOracleVersion;
end;

function TOCIConnection.GetServerVersion: string;

  // Extracts Oracle version number from string returned by OCIServerVersion.
  function GetVersionNumber(RawVersion: string): string;
  var
    Ind, Start: integer;
  begin
    Result := '';
    Ind := Pos('.', RawVersion);
    if Ind > 1 then begin
      Start := Ind - 1;
      if (Start > 1) and (RawVersion[Start - 1] >= '0') and (RawVersion[Start - 1] <= '9') then //10.0
        Start := Start - 1;
      Ind := Pos(' ', Copy(RawVersion, Start, Length(RawVersion) - (Start - 1)) );
      if Ind > 0 then
        Result := Copy(RawVersion, Start, Ind - 1);
    end;
  end;

begin
  if FOracleVersionSt = '' then begin
    if FOracleVersionFull = '' then
      GetServerVersionFull;
    if FOracleVersionSt = '' then
      FOracleVersionSt := GetVersionNumber(FOracleVersionFull);
  end;

  Result := FOracleVersionSt;
end;

function TOCIConnection.GetServerVersionFull: string;
var
  VersionFull: IntPtr;
  BufSize: integer;
  Command: TOCICommand;
begin
  if FOracleVersionFull = '' then begin
    if not {$IFNDEF UNIDACPRO}OraCall{$ELSE}OraCallUni{$ENDIF}.OCILite then begin
      try
        if (FOCICallStyle = OCI73) or not (OCI73 in OCISvcCtx.Home.PossibleOCICallStyles) then begin
          Command := GetCommand;

          Command.SetSQL(
            'begin SELECT Product, Version INTO :Product, :Version ' +
            'FROM SYS.PRODUCT_COMPONENT_VERSION ' +
            'WHERE Upper(Product) LIKE ''%ORACLE%''; end;');

          with Command.Params[0] do begin
            SetDataType(dtString);
            SetParamType(pdOutput);
            SetSize(65);
          end;

          with Command.Params[1] do begin
            SetDataType(dtString);
            SetParamType(pdOutput);
            SetSize(65);
          end;

          Command.Execute;

          FOracleVersionSt := Command.Params[1].GetValue;
          FOracleVersionFull := Command.Params[0].GetValue + FOracleVersionSt;
        end
        else begin
          BufSize := 255 * SizeOfCharOCI(OCISvcCtx.UnicodeEnv);
          VersionFull := Marshal.AllocHGlobal(BufSize);
          try
            Check(OCI8.OCIServerVersion(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, VersionFull,
              BufSize, OCI_HTYPE_SVCCTX)); // ORA-0 on Lite
            FOracleVersionFull := PtrToStringOCI(VersionFull, OCISvcCtx.UnicodeEnv);
          finally
            Marshal.FreeHGlobal(VersionFull);
          end;
        end;
      except
        on E: EOraError do
          if E.ErrorCode <> 6550 then
            raise;
      end;
    end
    else
      FOracleVersionFull := OCISvcCtx.Home.OCIVersionSt + ' Lite';
  end;

  Result := FOracleVersionFull;
end;

function TOCIConnection.GetClientVersion: string;
begin
  Result := OCISvcCtx.Home.OCIVersionSt;
end;

{$IFNDEF LITE}
procedure TOCIConnection.SetCurrentSchema(SchemaName: string);
var
  Command: TOCICommand;
begin
  if {$IFNDEF UNIDACPRO}OraCall{$ELSE}OraCallUni{$ENDIF}.OCILite then
    raise Exception.Create(SOLiteSchemaNotSupported);
  if not FConnected then
    raise Exception.Create(SConnectionIsClosed);
  if SchemaName = '' then
    SchemaName := GetDefaultSchema;

  Command := GetCommand;
  Command.SetSQL('ALTER SESSION SET CURRENT_SCHEMA = ' + SchemaName);
  try
    Command.Execute;
  except
    on E: EOraError do
      if E.ErrorCode = 1435 then
        raise EOraError.Create(E.ErrorCode,'Schema does not exist'+#$A, Self)
      else
        raise;
  end;
  FSchema := SchemaName;
  FCachedSchema := '';
end;

function TOCIConnection.GetCurrentSchema: string;
var
  Command: TOCICommand;
begin
  if not FConnected then
    raise Exception.Create(SConnectionIsClosed);

  if (GetOracleVersion < 8100) or ({$IFNDEF UNIDACPRO}OraCall{$ELSE}OraCallUni{$ENDIF}.OCILite) then
    if FSchema = '' then
      Result := GetDefaultSchema
    else
      Result := FSchema
  else begin
    Command := GetCommand;
    Command.SetSQL(
      'begin' +
      '  :Result := SYS_CONTEXT (''USERENV'', ''CURRENT_SCHEMA'');' +
      'end;');
    with Command.Params[0] do begin
      SetDataType(dtString);
      SetParamType(pdOutput);
      SetSize(50);
    end;
    Command.Execute;
    Result := OCISQLInfo.QuoteIfNeed(Command.Params[0].GetValue);
  end;
end;

function TOCIConnection.GetDefaultSchema: string;
begin
  if (FConnectMode in [cmSysOper, cmSysDBA, cmSysBkp, cmSysDG, cmSysKM]) then
    Result := 'SYS'
  else
    Result := OCISQLInfo.NormalizeName(FUserName, False, True);
end;

function TOCIConnection.GetCachedSchema: string;
begin
  if FCachedSchema = '' then
    if FSchema <> '' then
      FCachedSchema := OCISQLInfo.NormalizeName(FSchema, False, True)
    else
      FCachedSchema := GetCurrentSchema;

  Result := FCachedSchema;
end;
{$ENDIF}

procedure TOCIConnection.GetTableFields(TableName: string; Fields: TStringList);
var
  Handle: IntPtr;
  hDescribe: pOCIDescribe;
  b1: Integer; //byte
  hParam, hColList, hCol: pOCIParam;
  NumCols: ub2;
  i, Len, BufSize: Integer;
  ValueInt: Integer;
  Ptr, ValuePtr, StrPtr: IntPtr;
  ObjType: byte;
  pName, DbLink: string;
begin
  Fields.Clear;
  if FOCICallStyleCommand = OCI73 then
    Exit
  else
  if FOCICallStyleCommand = OCI80 then begin
    if not (OCI73 in OCISvcCtx.Home.PossibleOCICallStyles)
      or (GetOracleVersion = 8050)
    then
      Exit;
  end
  else
    CheckOCI;

  Check(OCI8.OCIHandleAlloc(OCISvcCtx.hOCIEnv, hDescribe, OCI_HTYPE_DESCRIBE, 0, nil));
  try
    b1 := 1;
    Check(OCI8.OCIAttrSet2(hDescribe, OCI_HTYPE_DESCRIBE, b1, 0, OCI_ATTR_DESC_PUBLIC, OCISvcCtx.hOCIError));
    Ptr := Marshal.AllocHGlobal(sizeof(integer));
    try
      DbLink := '';
      while True do begin
        Handle := StringToHGlobalOCI(TableName, BufSize, OCISvcCtx.UnicodeEnv);
        try
          try
            Check(OCI8.OCIDescribeAny(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, Handle, BufSize,
              OCI_OTYPE_NAME, 0, OCI_PTYPE_UNK, hDescribe));
          except
            on EOraError do // OCIDescribeAny fails on Oracle 8 if TableName contains db link
              Exit;
          end;
        finally
          FreeStringOCI(Handle, OCISvcCtx.UnicodeEnv);
        end;

        ValuePtr := OrdinalToPtr(hParam);
        try
          Check(OCI8.OCIAttrGet1(hDescribe, OCI_HTYPE_DESCRIBE, ValuePtr, nil, OCI_ATTR_PARAM, OCISvcCtx.hOCIError));
        finally
          PtrToOrdinal(ValuePtr, hParam);
        end;

        Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_PTYPE, OCISvcCtx.hOCIError));
        ObjType := Byte(ValueInt);

        case ObjType of
          OCI_PTYPE_TABLE, OCI_PTYPE_VIEW: begin
          end;
          OCI_PTYPE_SYN: begin
          // Describe synonyms
            {if d2 > 0 then
              TableName := '.' + Copy(TableName, d2 + 1, Length(TableName))
            else}
              TableName := '';

            StrPtr := nil;
            ValuePtr := OrdinalToPtr(StrPtr);
            try
              Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, Ptr,  OCI_ATTR_NAME, OCISvcCtx.hOCIError));
            finally
              PtrToOrdinal(ValuePtr, StrPtr);
            end;
            Len := Cardinal(Marshal.ReadInt32(Ptr));
            pName := OCISQLInfo.QuoteIfNeed(PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv));
            TableName := pName + TableName;

            StrPtr := nil;
            ValuePtr := OrdinalToPtr(StrPtr);
            try
              Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, Ptr, OCI_ATTR_SCHEMA_NAME, OCISvcCtx.hOCIError));
            finally
              PtrToOrdinal(ValuePtr, StrPtr);
            end;
            Len := Cardinal(Marshal.ReadInt32(Ptr));
            pName := OCISQLInfo.QuoteIfNeed(PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv));
            if pName <> '' then  // can be NULL for synonyms with db link
              TableName := pName + '.' + TableName;

            StrPtr := nil;
            ValuePtr := OrdinalToPtr(StrPtr);
            try
              Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, Ptr, OCI_ATTR_LINK, OCISvcCtx.hOCIError));
            finally
              PtrToOrdinal(ValuePtr, StrPtr);
            end;
            Len := Cardinal(Marshal.ReadInt32(Ptr));
            pName := OCISQLInfo.QuoteIfNeed(PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv));
            if pName <> '' then begin
              if DbLink <> '' then
                Exit; // Cannot use two db links
              DbLink := '@' + pName;
            end;
            TableName := TableName + DbLink;

            Continue;
          end;
        else
          RaiseOraError(4043, Format(SObjectNotExist, [TableName]));
        end;

        Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_NUM_COLS, OCISvcCtx.hOCIError));
        NumCols := ub2(ValueInt);

        ValuePtr := OrdinalToPtr(hColList);
        try
          Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, nil, OCI_ATTR_LIST_COLUMNS, OCISvcCtx.hOCIError));
        finally
          PtrToOrdinal(ValuePtr, hColList);
        end;

        for i := 1 to NumCols do begin
          Check(OCI8.OCIParamGet(hColList, OCI_DTYPE_PARAM, OCISvcCtx.hOCIError, hCol, i));  // hProc

          try
            StrPtr := nil;
            ValuePtr := OrdinalToPtr(StrPtr);
            try
              Check(OCI8.OCIAttrGet1(hCol, OCI_DTYPE_PARAM, ValuePtr, Ptr, OCI_ATTR_NAME, OCISvcCtx.hOCIError));
            finally
              PtrToOrdinal(ValuePtr, StrPtr);
            end;
            Len := Marshal.ReadInt32(Ptr);
            Fields.Add(PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv));
          finally
            // Free memory after OCIParamGet
            OCI8.OCIDescriptorFree(hCol, OCI_DTYPE_PARAM);
          end;
        end;

        break;
      end;
    finally
      Marshal.FreeHGlobal(Ptr);
    end;
  finally
    Check(OCI8.OCIHandleFree(hDescribe, OCI_HTYPE_DESCRIBE));
  end;
end;

procedure TOCIConnection.GetSessionParameters;
var
  Command: TOCICommand;
  SQLText: string;
  Param: TOraParamDesc;
  i: integer;
  CharsetIdNeeded: boolean;
  Value: variant;
begin
  if FConnected and not OCILite then begin
    Command := GetCommand;

    FCharsetId := 0;
    CharsetIdNeeded := (FCharset <> '') and (GetOracleVersion >= 8000);

    SQLText :=
      'declare' +
      '  cursor NlsParamsCursor is' +
      '    SELECT * FROM nls_session_parameters;' +
      'begin' +
         // AL32UTF8 can has one char length = 4 bytes
      '  SELECT Nvl(Lengthb(Chr(16777216)), Nvl(Lengthb(Chr(65536)), Nvl(Lengthb(Chr(256)), 1))), Nvl(Lengthb(Chr(1)), 1)' +
      '    INTO :MaxCharLength, :MinCharLength FROM dual;' +
      '  for NlsRecord in NlsParamsCursor loop' +
      '    if NlsRecord.parameter = ''NLS_DATE_LANGUAGE'' then' +
      '      :NlsDateLanguage := NlsRecord.value;' +
      '    elsif NlsRecord.parameter = ''NLS_DATE_FORMAT'' then' +
      '      :NlsDateFormat := NlsRecord.value;'+
      '    elsif NlsRecord.parameter = ''NLS_NUMERIC_CHARACTERS'' then' +
      '      :NlsNumericCharacters := NlsRecord.value;';
    if GetOracleVersion >= 8000 then
      SQLText := SQLText +
        '    elsif NlsRecord.parameter = ''NLS_TIMESTAMP_FORMAT'' then' +
        '      :NlsTimeStampFormat := NlsRecord.value;' +
        '    elsif NlsRecord.parameter = ''NLS_TIMESTAMP_TZ_FORMAT'' then' +
        '      :NlsTimeStampTZFormat := NlsRecord.value;';
    SQLText := SQLText +
      '    end if;' +
      '  end loop;';
    if CharsetIdNeeded then
      SQLText := SQLText +  '  SELECT NLS_CHARSET_ID(''' + FCharset + ''') INTO :CharsetId FROM dual;';
    SQLText := SQLText + 'end;';

    Command.SetSQL(SQLText);

    // setup params
    for i := 0 to Command.Params.Count - 1 do begin
      Param := TOraParamDesc(FCommand.Params[i]);
      Param.SetDataType(dtString);
      Param.SetParamType(pdOutput);
      Param.SetSize(40);
    end;
    Command.GetParam(0).SetDataType(dtInteger);
    Command.GetParam(1).SetDataType(dtInteger);

    if CharsetIdNeeded then
      Command.GetParam(7).SetDataType(dtInteger);

    try
      // execute
      Command.Execute;

      Value := FCommand.GetParam(0).GetValue;
      if VarIsNull(Value) then
        FMaxCharLength := 1
      else
        FMaxCharLength := Value;
      Value := FCommand.GetParam(1).GetValue;
      if VarIsNull(Value) then
        FMinCharLength := 1
      else
        FMinCharLength := Value;
      // get param values
      if FQueryCharLength then
        FCharLength := FMaxCharLength;

      FNlsParams[nlsDateLanguage].Value := VarToStr(Command.GetParam(2).GetValue);
      FNlsParams[nlsDateFormat].Value := VarToStr(Command.GetParam(3).GetValue);
      FNlsParams[nlsNumericCharacters].Value := VarToStr(Command.GetParam(4).GetValue);

      if GetOracleVersion >= 8000 then begin
        FNlsParams[nlsTimeStampFormat].Value := VarToStr(Command.GetParam(5).GetValue);
        FNlsParams[nlsTimeStampTZFormat].Value := VarToStr(Command.GetParam(6).GetValue);
      end;

      if CharsetIdNeeded then begin
        Value := Command.GetParam(7).GetValue;
        if VarIsNull(Value) then
          RaiseError('Cannot find charset ' + FCharset);
        FCharsetId := Value;
      end;
    except
      // hide exceptions
    end;
  end;
end;

procedure TOCIConnection.SetNlsParameter(const Name, Value: string);
var
  Command: TOCICommand;
begin
  if FConnected then begin
    Command := GetCommand;

    Command.SetSQL('ALTER SESSION SET '+ Name + '=' + '''' + Value + '''');
    Command.Execute;
  end;
end;

function TOCIConnection.GetMaxStringSize: word;
var
  Version: string;
  OracleVersionSt: IntPtr;
begin
  if (FMaxStringSize = 0) and FConnected then begin
    FMaxStringSize := 2000;

    if FOCICallStyle <> OCI73 then begin
      if OCI73 in OCISvcCtx.Home.PossibleOCICallStyles then begin
        if GetOracleVersion div 1000 <> 7 then
          FMaxStringSize := 4000;
      end
      else begin
        OracleVersionSt := Marshal.AllocHGlobal(8);
        try
          OCI8.OCIServerVersion(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, OracleVersionSt, 8, OCI_HTYPE_SVCCTX);  // ORA-0 on Lite
          Version := string(Marshal.PtrToStringAnsi(OracleVersionSt));
        finally
          Marshal.FreeHGlobal(OracleVersionSt);
        end;
        // OCIServerVersion does not query server for it's version under NET
        if Pos('7', Version) <> 7 then
          FMaxStringSize := 4000;
      end;
    end;
  end;

  Result := FMaxStringSize;
end;

function TOCIConnection.GetOCI7: TOCI7API;
begin
  Result := OCISvcCtx.OCI7;
end;

function TOCIConnection.GetOCI8: TOCI8API;
begin
  Result := OCISvcCtx.OCI8;
end;

{$IFDEF MSWINDOWS}
{$IFNDEF LITE}
function TOCIConnection.GetMTS: TMTSAPI;
begin
  Result := OCISvcCtx.MTS;
end;
{$ENDIF}
{$ENDIF}

procedure TOCIConnection.BreakExec;
begin
  if FConnected then
    if FOCICallStyle = OCI73 then begin
      Check(OCI7.obreak(LDA));
    //  if Res <> BREAKED then
    end
    else
    if FOCICallStyle = OCI80 then begin
      Check(OCI8.OCIBreak(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError));
    end
    else
      CheckOCI;
end;

procedure TOCIConnection.ChangePassword(NewPassword: string);
var
  Environment: TOCIEnvironment;
  OCISvcCtx: TOCISvcCtx;
  hServer: pOCIServer;
  hSession: pOCISession;
  CharsetId: Integer;
  Res, BufSize, Size, Size2, Size3: integer;
  p, p2, p3: IntPtr;
begin
  if FConnected then begin
    OCISvcCtx := FOCISvcCtx;
    hServer := Self.hServer;
    hSession := Self.hSession;
  end
  else begin
    {$IFDEF NET}
    if FDirect then
      Environment := OracleHomes.Direct.AllocEnvironment(FUnicodeEnvironment, 0)
    else
    {$ENDIF}
      Environment := OracleHomes.GetHome(FHomeName).AllocEnvironment(FUnicodeEnvironment, {$IFNDEF LITE}FSubscriptionPort{$ELSE}0{$ENDIF});
    
    OCISvcCtx := TOCISvcCtx.Create(Environment, FUseUnicode);
  {$IFNDEF AUTOREFCOUNT}
    OCISvcCtx.AddRef;
  {$ENDIF}
  end;

  try
    if not FConnected then begin
      OCISvcCtx.AllocSvcCtxHandle;
      OCISvcCtx.OCI8.Check(OCISvcCtx.OCI8.OCIHandleAlloc(OCISvcCtx.hOCIEnv, hServer, OCI_HTYPE_SERVER, 0, nil), OCISvcCtx);
      OCISvcCtx.OCI8.Check(OCISvcCtx.OCI8.OCIHandleAlloc(OCISvcCtx.hOCIEnv, hSession, OCI_HTYPE_SESSION, 0, nil), OCISvcCtx);

      p := StringToHGlobalOCI(FServer, BufSize, OCISvcCtx.UnicodeEnv);
      Res := OCISvcCtx.OCI8.OCIServerAttach(hServer, OCISvcCtx.hOCIError, p, BufSize, OCI_DEFAULT);
      FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
      OCISvcCtx.OCI8.Check(Res, OCISvcCtx);
    end;

    try
      if not FConnected then begin
        OCISvcCtx.OCI8.Check(OCISvcCtx.OCI8.OCIAttrSet1(OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX, hServer, 0, OCI_ATTR_SERVER, OCISvcCtx.hOCIError), OCISvcCtx);
        OCISvcCtx.OCI8.Check(OCISvcCtx.OCI8.OCIAttrSet1(OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX, hSession, 0, OCI_ATTR_SESSION, OCISvcCtx.hOCIError), OCISvcCtx);

        if OCISvcCtx.Home.PossibleOCICallStyles = [OCI80] then begin
          OCISvcCtx.OCI8.Check(OCISvcCtx.OCI8.OCIAttrSet2(OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX, FConnectionTimeout, 0, OCI_ATTR_CONNECTION_TIMEOUT, OCISvcCtx.hOCIError), OCISvcCtx);
          if FUseUnicode then begin
            CharsetId := Integer(OCI_UTF16ID);
            OCISvcCtx.OCI8.Check(OCISvcCtx.OCI8.OCIAttrSet2(OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX, CharsetId, 0, OCI_ATTR_CHARSET_ID, OCISvcCtx.hOCIError), OCISvcCtx);
          end
          else
            if FCharset <> '' then begin
              p := StringToHGlobalOCI(FCharset, Size, OCISvcCtx.UnicodeEnv);
              Res := OCISvcCtx.OCI8.OCIAttrSet1(OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX, p, 0, OCI_ATTR_CHARSET, OCISvcCtx.hOCIError);
              FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
              OCISvcCtx.OCI8.Check(Res, OCISvcCtx);
            end;
        end;
      end;

      p := StringToHGlobalOCI(FUsername, BufSize, OCISvcCtx.UnicodeEnv);
      p2 := StringToHGlobalOCI(FPassword, Size2, OCISvcCtx.UnicodeEnv);
      p3 := StringToHGlobalOCI(NewPassword, Size3, OCISvcCtx.UnicodeEnv);
      Res := OCISvcCtx.OCI8.OCIPasswordChange(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, p, BufSize, p2, Size2, p3, Size3, OCI_AUTH);
      FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
      FreeStringOCI(p2, OCISvcCtx.UnicodeEnv);
      FreeStringOCI(p3, OCISvcCtx.UnicodeEnv);
      OCISvcCtx.OCI8.Check(Res, OCISvcCtx);

      if not FConnected then
        OCISvcCtx.OCI8.Check(OCISvcCtx.OCI8.OCISessionEnd(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hSession, OCI_DEFAULT), OCISvcCtx);
    finally
      if not FConnected then
        OCISvcCtx.OCI8.Check(OCISvcCtx.OCI8.OCIServerDetach(hServer, OCISvcCtx.hOCIError, OCI_DEFAULT), OCISvcCtx);
    end;
  finally
    if not FConnected then begin
      OCISvcCtx.OCI8.OCIHandleFree(hSession, OCI_HTYPE_SESSION);
      OCISvcCtx.OCI8.OCIHandleFree(hServer, OCI_HTYPE_SERVER);
    {$IFNDEF AUTOREFCOUNT}
      OCISvcCtx.ReleaseRef;
    {$ENDIF}
    end;
  end;
end;

function TOCIConnection.GetLDA: PLDA;
begin
  if FOCICallStyle = OCI73 then
    Result := LDA
  else if FOCICallStyle = OCI80 then begin
    if IntPtr(LDA) = nil then
    {$IFDEF CLR}
      LDA := Marshal.AllocHGlobal(CDA_SIZE);
    {$ELSE}
      New(LDA);
    {$ENDIF}

 // BUG with OCI 8.1.5 raise access violation on first time when uses OCI 8.0.x initialization
    OCISvcCtx.GetLDA(LDA);
    Result := LDA;
  end
  else begin
    CheckOCI;
    Result := nil;
  end;
//  Check(OCIAttrGet(hSvcCtx, OCI_HTYPE_SVCCTX, @Value, nil, OCI_ATTR_IN_V8_MODE, hOCIError));
end;

procedure TOCIConnection.SetLDA(Value: PLDA);
begin
  if IntPtr(Value) <> IntPtr(LDA) then begin
    Disconnect;

    LDA := Value;

    FNativeConnection := IntPtr(LDA) = nil;
    FConnected := IntPtr(LDA) <> nil;

    FOCICallStyleCommand := FOCICallStyle;

    if FOCICallStyle = OCI80 then
      OCISvcCtx.SetLDA(LDA);
  end;
end;

procedure TOCIConnection.SetOCISvcCtx(Value: TOCISvcCtx);
begin
  if Value <> OCISvcCtx then begin
    Disconnect;

    FOCISvcCtx := Value;
  {$IFNDEF AUTOREFCOUNT}
    FOCISvcCtx.AddRef;
  {$ENDIF}

    FNativeConnection := FOCISvcCtx = nil;
    FConnected := FOCISvcCtx.hOCISvcCtx <> nil;

    FOCICallStyleCommand := FOCICallStyle;
  end;
end;

procedure TOCIConnection.Assign(Source: TCRConnection);
var
  Src: TOCIConnection;
begin
  inherited;

  Src := TOCIConnection(Source);
  FThreadSafety := Src.FThreadSafety;
  FConnectMode := Src.FConnectMode;
  FEnableIntegers := Src.FEnableIntegers;
  FEnableLargeint := Src.FEnableLargeint;
  FEnableNumbers := Src.FEnableNumbers;
  FEnableWideOraClob := Src.FEnableWideOraClob;
  FInternalName := Src.FInternalName;
  FConnectionTimeout := Src.FConnectionTimeout;
  FStatementCache := Src.FStatementCache;
  FStatementCacheSize := Src.FStatementCacheSize;
  FHomeName := Src.FHomeName;
{$IFDEF NET}
  FDirect := Src.FDirect;
{$ENDIF}
{$IFNDEF CLR}
  FIPVersion := Src.FIPVersion;
{$ENDIF}
  FConnectionType := Src.FConnectionType;
{$IFNDEF LITE}
  FClientIdentifier := Src.FClientIdentifier;
  FOptimizerMode := Src.FOptimizerMode;
  FSchema := Src.FSchema;
{$ENDIF}
{$IFDEF VER6P}
{$IFNDEF FPC}
  FEnableSQLTimeStamp := Src.FEnableSQLTimeStamp;
{$ELSE}
  FTimeStampAsString := Src.FTimeStampAsString;
{$ENDIF}
  FIntervalAsString := Src.FIntervalAsString;
{$ENDIF}
  FSmallintPrecision := Src.FSmallintPrecision;
  FIntegerPrecision := Src.FIntegerPrecision;
  FLargeIntPrecision := Src.FLargeIntPrecision;
  FFloatPrecision := Src.FFloatPrecision;
  FBCDPrecision := Src.FBCDPrecision;
  FBCDScale := Src.FBCDScale;
{$IFDEF VER6P}
{$IFNDEF FPC}
  FFmtBCDPrecision := Src.FFmtBCDPrecision;
  FFmtBCDScale := Src.FFmtBCDScale;
{$ENDIF}
{$ENDIF}
  FCharset := Src.FCharset;
  FCharLength := Src.FCharLength;
  FQueryCharLength := Src.FQueryCharLength;
  FUseUnicode := Src.FUseUnicode;
  FNlsParams := Src.FNlsParams;
  FUnicodeAsNational := Src.FUnicodeAsNational;
end;

procedure TOCIConnection.AssignConnect(Source: TCRConnection);
var
  Src: TOCIConnection;
begin
  if Source <> Self then begin
    Disconnect;


    if Source <> nil then begin
      Src := TOCIConnection(Source);

      FOCICallStyle := Src.FOCICallStyle;
      if FOCICallStyle = OCI73 then begin
        SetOCISvcCtx(TOCIConnection(Source).OCISvcCtx);
        SetLDA(Src.GetLDA);
      end
      else if FOCICallStyle = OCI80 then
        SetOCISvcCtx(TOCIConnection(Source).OCISvcCtx)
      else
        CheckOCI;

      Assign(Src);

    {$IFNDEF LITE}
      FCachedSchema := Src.FCachedSchema;
    {$ENDIF}
      FCharsetId := Src.FCharsetId;
      FMaxStringSize := Src.FMaxStringSize;

      FInternalTransaction.AssignConnect(Src.FInternalTransaction);
    end
    else begin
      SetLDA(nil);
      SetOCISvcCtx(nil);
    end;
  end;
end;

{ Multi Thread }

procedure TOCIConnection.Busy;
begin
{$IFDEF MSWINDOWS}
  if FThreadSafety then begin
    case WaitForSingleObject(hBusy, 0) of
      WAIT_OBJECT_0:
        Exit;
      WAIT_TIMEOUT:
        raise EOraError.Create(OCI_CONNECTION_BUSY,
          'ORA-03127a');
    else
      Assert(False);
    end;
  end;
{$ENDIF}
end;

procedure TOCIConnection.BusyWait;
begin
{$IFDEF MSWINDOWS}
  if FThreadSafety then begin
    case WaitForSingleObject(hBusy, INFINITE) of
      WAIT_OBJECT_0:
        Exit;
      WAIT_TIMEOUT:
        raise EOraError.Create(OCI_CONNECTION_BUSY,
          'ORA-03127a');
      WAIT_ABANDONED: begin
        Exit;
        Abort;
      end;
    else
      Assert(False);
    end;
  end;
{$ENDIF}
end;

procedure TOCIConnection.Release;
begin
{$IFDEF MSWINDOWS}
  if FThreadSafety then
    ReleaseMutex(hBusy);
{$ENDIF}
end;

{$IFDEF MSWINDOWS}
function WndProc(hWindow: HWND; Msg: UINT; wParam: WPARAM;
  lParam: LPARAM): LRESULT; {$IFNDEF CLR} stdcall; {$ENDIF}
var
  ExecThread: TExecThread;
  Recordset: TOCIRecordSet;
  ChangeNotification: TOCIChangeNotification;
  NotifyChange: TNotifyChange;
{$IFNDEF LITE}
  Alerter: TOCIAlerter;
  Event: TAlertEvent;
{$IFDEF CLR}
  Continue: boolean;
{$ENDIF}
  E: Exception;
{$ENDIF}
begin
  Result := 0;
  try
    case Msg of
      WM_CREATE:
        Result := 0;
      WM_ENDTHREAD: begin
        ExecThread := TExecThread(GetGCHandleTarget(IntPtr(wParam)));
        try
          if Assigned(ExecThread.FEndMethod) then
            ExecThread.FEndMethod(ExecThread.FException);
          if ExecThread.FException <> nil then
            if ExecThread.FException is EOraError then
              raise EOraError.Create(EOraError(ExecThread.FException).ErrorCode, ExecThread.FException.Message)
            else
              raise Exception.Create(ExecThread.FException.Message);
        finally
          ExecThread.Terminate;
          ExecThread.WaitFor;
          ExecThread.Free;
        end;
      end;
      WM_AFTERFETCH: begin
        RecordSet := TOCIRecordSet(GetGCHandleTarget(IntPtr(wParam)));
        Recordset.OnAfterFetch();
      end;
      WM_CHANGENOTIFY: begin
        ChangeNotification := TOCIChangeNotification(GetGCHandleTarget(IntPtr(wParam)));
        NotifyChange := TNotifyChange(GetGCHandleTarget(IntPtr(lParam)));
        FreeGCHandle(IntPtr(lParam));
        try
          ChangeNotification.FOnChange(NotifyChange.NotifyType, NotifyChange.TableChanges);
        finally
          NotifyChange.Free;
        end;
      end;
    {$IFNDEF LITE}
      WM_ALERTER_EVENT: begin
        Alerter := TOCIAlerter(GetGCHandleTarget(IntPtr(wParam)));
        Event := TAlertEvent(GetGCHandleTarget(IntPtr(lParam)));
        FreeGCHandle(IntPtr(lParam));
        try
          Alerter.DoOnEvent(Event.Name, Event.Message);
        finally
          Event.Free;
          Alerter.FResponseEvent.SetEvent;
        end;
      end;
      WM_ALERTER_TIMEOUT: begin
        Alerter := TOCIAlerter(GetGCHandleTarget(IntPtr(wParam)));
        try
        {$IFNDEF CLR}
          Alerter.DoOnTimeOut(Boolean(Pointer(lParam)^));
        {$ELSE}
          Continue := False;
          Alerter.DoOnTimeOut(Continue);
        {$ENDIF}
        finally
          Alerter.FResponseEvent.SetEvent;
        end;
      end;
      WM_ALERTER_STOPED: begin
        Alerter := TOCIAlerter(GetGCHandleTarget(IntPtr(wParam)));
        Alerter.Stop;

        if lParam <> 0 then begin
          E := Exception(GetGCHandleTarget(IntPtr(lParam)));
          FreeGCHandle(IntPtr(lParam));
          try
            Alerter.DoOnError(E);
          finally
            E.Free;
          end;
        end;
      end;
    {$ENDIF}
    else
      Result := DefWindowProc(hWindow, Msg, wParam, lParam);
    end;
  except
  {$IFDEF LITE}
    on E: Exception do
      MessageBox(HInstance, PChar(E.Message), 'Error', MB_OK);
  {$ELSE}
    if Assigned(ApplicationHandleException) then
      ApplicationHandleException(nil);
  {$ENDIF}
  end;
end;

var
  WndClass: TWndClass = (
    style: 0;
    lpfnWndProc: @WndProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: '';
    lpszClassName: 'ODACUtilWnd'
  );

procedure AllocODACWnd;
var
  TempClass: {$IFDEF CLR}TWndClassInfo{$ELSE}TWndClass{$ENDIF};
  ClassRegistered: boolean;
{$IFDEF CLR}
  WndClassPtr: IntPtr;
{$ENDIF}
  WndProcPtr: IntPtr;
begin
  if hODACWindow = 0 then begin
    WndClass.hInstance := HInstance;
    ClassRegistered := Windows.GetClassInfo(HInstance, WndClass.lpszClassName,
      TempClass);
  {$IFDEF CLR}
    WndClassPtr := Marshal.AllocHGlobal(SizeOf(TWndClass));
    try
      Marshal.StructureToPtr(WndClass, WndClassPtr, False);
      WndProcPtr :=  Marshal.ReadIntPtr(WndClassPtr, 4);
    finally
      Marshal.FreeHGlobal(WndClassPtr);
    end;
  {$ELSE}
    WndProcPtr := @{$IFNDEF UNIDACPRO}OraClasses{$ELSE}OraClassesUni{$ENDIF}.WndProc;
  {$ENDIF}

    if not ClassRegistered or ({$IFDEF FPC}@{$ENDIF}TempClass.lpfnWndProc <> WndProcPtr) then begin
      if ClassRegistered then
        Windows.UnregisterClass(WndClass.lpszClassName, HInstance);

      hODACWindow := Windows.RegisterClass(WndClass);
    end;

    hODACWindow := Windows.CreateWindowEx(WS_EX_TOOLWINDOW, 'ODACUtilWnd',
      '', WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil);
    Assert(hODACWindow > 0);
    Windows.SetWindowLong(hODACWindow, GWL_WNDPROC, Longint(WndProcPtr));
  end;
end;

constructor TExecThread.Create(RunMethod: TRunMethod; EndMethod: TEndMethod; hODACWindow: HWND; CreateSuspended: Boolean);
begin
  inherited Create(True);

  FRunMethod := RunMethod;
  FEndMethod := EndMethod;
  FhWindow := hODACWindow;

  if not CreateSuspended then
    Resume;
end;

destructor TExecThread.Destroy;
begin
  if FGCHandle <> nil then
    FreeGCHandle(FGCHandle);
{$IFDEF VER6P}
{$IFNDEF CLR}
  FException.Free;
{$ENDIF}
{$ENDIF}

  inherited;
end;

procedure TExecThread.Execute;
begin
  FGCHandle := AllocGCHandle(Self, False);
  try
    TRunMethod(FRunMethod);
    FException := nil;
    PostMessage(FhWindow, WM_ENDTHREAD, WPARAM(FGCHandle), 0);
  except
    on E: Exception do begin
  {$IFDEF CLR}
      if E.ClassName <> 'ThreadAbortException' then
  {$ENDIF}
      begin
        FException := E;
        PostMessage(FhWindow, WM_ENDTHREAD, WPARAM(FGCHandle), 0);
      {$IFDEF VER6P}
      {$IFNDEF CLR}
        AcquireExceptionObject;
      {$ENDIF}
      {$ELSE}
        while not Terminated do; // don't free exception until processed
      {$ENDIF}
      end;
    end;
  end;
end;

{$ENDIF}

function TOCIConnection.RunThread(RunMethod: TRunMethod; EndMethod: TEndMethod): TThread;
begin
{$IFDEF MSWINDOWS}
  if hODACWindow = 0 then
    AllocODACWnd;

  Result := TExecThread.Create(RunMethod, EndMethod, hODACWindow, False);
{$ELSE}
  Result := nil;
{$ENDIF}
end;

function TOCIConnection.StopThread(var hThread: TThread{$IFDEF MSWINDOWS}; APeekMessage: boolean = False{$ENDIF}): boolean;
{$IFDEF WIN32_64}
var
  AMsg: TMSG;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}

{$IFDEF CLR}
  hThread := nil;
{$ELSE}
  Result := TerminateThread(hThread.Handle, 0);
  if Result = True then
    hThread.Free;
  // PeekMessage is needed to avoid AV when TOCICommand or TOCIRecordSet is
  // destroying and thread is active.
  if APeekMessage then
    PeekMessage(AMsg, hODACWindow, WM_ENDTHREAD, WM_ENDTHREAD, PM_REMOVE);
{$ENDIF}
{$ENDIF}
  Result := True;
end;

procedure TOCIConnection.SetNonBlocking(Value: boolean);
begin
  if FConnected then begin
    if (FOCICallStyle = OCI73) or (FOCICallStyle = OCI80) then begin
      if Value then
        Check(OCI7.onbset(GetLDA))
      else
        Check(OCI7.onbclr(GetLDA));
    end
   {else
    if FOCICallStyle = OCI80 then begin
      Check(OCIAttrSet(hSvcCtx, OCI_HTYPE_SVCCTX, @Temp, 0, OCI_ATTR_NONBLOCKING_MODE, hOCIError));
      Check(OCIAttrGet(hSvcCtx, OCI_HTYPE_SVCCTX, @Temp, nil, OCI_ATTR_NONBLOCKING_MODE, hOCIError));
    end}
    else
      CheckOCI;
  end;
end;

function TOCIConnection.GetOCICallStyle: TOCICallStyle;
begin
  Result := FOCICallStyle;
end;

procedure TOCIConnection.SetOCICallStyle(Value: TOCICallStyle);
begin
  if Value <> FOCICallStyle then begin
    Disconnect;
    FOCICallStyle := Value;
  end;
end;

function TOCIConnection.GetOCICallStyleCommand: TOCICallStyle;
begin
  Result := FOCICallStyleCommand;
end;

function TOCIConnection.GetLastError: integer;
begin
  Result := FLastError;
end;

procedure TOCIConnection.SetLastError(Value: integer);
begin
  FLastError := Value;
end;

{ OCI73 }

{procedure TOCIConnection.SetAutoCommit(Value: boolean);
begin
  CheckOCI73;

  if Connected then
    if Value then
      Check(ocon(LDA))
    else
      Check(ocof(LDA));
end;}

function TOCIConnection.SetProp(Prop: integer; const Value: variant): boolean;
var
  S: string;
  OldCharset: string;
  OldCharsetId: word;

  procedure SetNlsParam(ParamType: TNlsParamType);
  begin
    S := Value;
    if FNlsParams[ParamType].Value <> S then begin
      FNlsParams[ParamType].Value := S;
      FNlsParams[ParamType].IsUserDefined := S <> '';
      if FNlsParams[ParamType].IsUserDefined then
        SetNlsParameter(FNlsParams[ParamType].Name, FNlsParams[ParamType].Value);
    end;
  end;

begin
  Result := True;
  case Prop of
    prThreadSafety: begin
      FThreadSafety := Boolean(Value);
    {$IFNDEF CLR}
    {$IFNDEF FPC}
      IsMultiThread := FThreadSafety;  // switch multithread memory managemant
    {$ENDIF}
    {$ENDIF}
    end;
    prConnectMode:
      FConnectMode := TConnectMode(Value);
    prEnableIntegers:
      FEnableIntegers := Boolean(Value);
    prEnableLargeint:
      FEnableLargeint := Boolean(Value);
    prEnableNumbers:
      FEnableNumbers := Boolean(Value);
    prEnableWideOraClob:
      FEnableWideOraClob := Boolean(Value);
    prInternalName:
      FInternalName := Value;
    prCharLength:
      if (FQueryCharLength and (Word(Value) <> 0))
        or (FCharLength <> Word(Value))
      then begin
        FQueryCharLength := Word(Value) = 0;
        FCharLength := Word(Value);
        FMaxStringSize := 0;
        if FCharLength = 0 then
          if FConnected then
            GetSessionParameters;
      end;
    prCharset: begin
      S := Value;
      if FCharset <> S then begin
        OldCharset := FCharset;
        OldCharsetId := FCharsetId;
        FCharset := S;
        try
          if FConnected then
            GetSessionParameters;
        except
          FCharset := OldCharset;
          FCharsetId := OldCharsetId;
          raise;
        end;
      end;
    end;
    prUseUnicode:
      FUseUnicode := Boolean(Value);
    prDateLanguage:
      SetNlsParam(nlsDateLanguage);
    prDateFormat:
      SetNlsParam(nlsDateFormat);
    prTimeStampFormat:
      SetNlsParam(nlsTimeStampFormat);
    prTimeStampTZFormat:
      SetNlsParam(nlsTimeStampTZFormat);
    prNumericCharacters:
      SetNlsParam(nlsNumericCharacters);
    prDisconnectMode:
      FDisconnectMode := Boolean(Value);
    prConnectionTimeOut:
      FConnectionTimeout := Value;
    prStatementCache:
      FStatementCache := Boolean(Value);
    prStatementCacheSize: begin
      FStatementCacheSize := Value;
      if GetConnected then
        SetStatementCacheSize(FStatementCacheSize);
    end;
    prDirect: begin
    {$IFDEF NET}
      FDirect := Value;
      if FDirect then
        SetOCICallStyle(OCI80);
    {$ELSE}
      if Value = True then
        raise Exception.Create('Direct Mode is not supported');
    {$ENDIF}
    end;
  {$IFNDEF CLR}
    prIPVersion:
      FIPVersion := Value;
  {$ENDIF}
    prHomeName: begin
      if FHomeName <> Value then begin
        Disconnect;
        FHomeName := Value;
      end;
    end;
    prUnicodeEnvironment: begin
      if FUnicodeEnvironment <> Value then begin
        Disconnect;
        FUnicodeEnvironment := Value;
      end;
    end;
  {$IFNDEF LITE}
    prClientIdentifier: begin
      if Value <> FClientIdentifier then begin
        FClientIdentifier := Value;
        if GetConnected then
          SetClientIdentifier;
      end;
    end;
    prOptimizerMode: begin
      if TOptimizerMode(Value) <> FOptimizerMode then begin
        FOptimizerMode := TOptimizerMode(Value);
        if GetConnected then
          SetOptimizerMode;
      end;
    end;
    prSchema: begin
      if Value <> FSchema then begin
        FSchema := Value;
        if GetConnected then
          SetCurrentSchema(FSchema);
      end;
    end;
    prSubscriptionPort: begin
      if FSubscriptionPort <> Value then begin
        Disconnect;
        FSubscriptionPort := Value;
      end;
    end;
  {$ENDIF}
    prUseOCI7:
    {$IFDEF NET}
      if FDirect then
        SetOCICallStyle(OCI80)
      else
    {$ENDIF}
      begin
        if Boolean(Value) then
          SetOCICallStyle(OCI73)
        else if OCISvcCtx <> nil then
          SetOCICallStyle(OCISvcCtx.Home.OCICallStyle)
        else
          SetOCICallStyle(None);
      end;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    prEnableSQLTimeStamp:
      FEnableSQLTimeStamp := Value;
  {$ELSE}
    prTimeStampAsString:
      FTimeStampAsString := Value;
  {$ENDIF}
    prIntervalAsString:
      FIntervalAsString := Value;
  {$ENDIF}
    prSmallintPrecision:
      FSmallintPrecision := Value;
    prIntegerPrecision:
      FIntegerPrecision := Value;
    prFloatPrecision:
      FFloatPrecision := Value;
    prLargeintPrecision:
      FLargeIntPrecision := Value;
    prBCDPrecision:
      GetPrecAndScale(Value, FBCDPrecision, FBCDScale);
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    prFmtBCDPrecision:
      GetPrecAndScale(Value, FFmtBCDPrecision, FFmtBCDScale);
  {$ENDIF}
  {$ENDIF}
    prUnicodeAsNational:
      FUnicodeAsNational := Value;
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TOCIConnection.GetProp(Prop: integer; out Value: variant): boolean;

  procedure GetNlsParam(ParamType: TNlsParamType);
  begin
    if FNlsParams[ParamType].Value = '' then
      GetSessionParameters;
    Value := FNlsParams[ParamType].Value;
  end;

begin
  Result := True;
  case Prop of
    prMaxStringSize:
      Value := GetMaxStringSize;
    prCharLength:
      if FQueryCharLength then
        Value := 0
      else
        Value := FCharLength;
    prCharset:
      Value := FCharset;
    prUseUnicode:
      Value := FUseUnicode;
    prDateFormat:
      GetNlsParam(nlsDateFormat);
    prDateLanguage:
      GetNlsParam(nlsDateLanguage);
    prTimeStampFormat:
      GetNlsParam(nlsTimeStampFormat);
    prTimeStampTZFormat:
      GetNlsParam(nlsTimeStampTZFormat);
    prNumericCharacters:
      GetNlsParam(nlsNumericCharacters);
    prConnectionTimeout:
      Value := FConnectionTimeout;
  else
    Result := inherited GetProp(Prop, Value);
  end;
end;

function TOCIConnection.CheckIsValid: boolean;
begin
  if not FIsValid then
    Result := False
  else begin
    FIsValid := True;
    try
      if (OCISvcCtx.Home.PossibleOCICallStyles <> [OCI80]) and
        (OCISvcCtx.Home.OCIVersion >= 10200) and (FOracleVersion >= 10200)
      then
        Check(OCI8.OCIPing(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, OCI_DEFAULT))
      else
        FInternalTransaction.Commit;
    except
      FIsValid := False;
    end;
    Result := FIsValid;
  end;
end;

{$IFNDEF LITE}
procedure TOCIConnection.ReturnToPool;
begin
  Assert(FPool <> nil);
  FOnFailover := nil;
  inherited;
end;
{$ENDIF}

{$IFNDEF LITE}
procedure TOCIConnection.SetOptimizerMode;
var
  s: string;
  Mode: TOptimizerMode;
  Command: TOCICommand;
begin
  if (FOptimizerMode <> omDefault) then begin
    Mode := FOptimizerMode;
    if (GetOracleVersion < 9000) and (Mode in [omFirstRows1000..omFirstRows1]) then
      Mode := omFirstRows;
    case Mode of
      omFirstRows1000:    s := 'FIRST_ROWS_1000';
      omFirstRows100:     s := 'FIRST_ROWS_100';
      omFirstRows10:      s := 'FIRST_ROWS_10';
      omFirstRows1:       s := 'FIRST_ROWS_1';
      omFirstRows:        s := 'FIRST_ROWS';
      omAllRows:          s := 'ALL_ROWS';
      omChoose:           s := 'CHOOSE';
      omRule:             s := 'RULE';
    end;

    Command := GetCommand;
    Command.SetSQL('ALTER SESSION SET OPTIMIZER_MODE = ' + s);
    Command.Execute;
  end;
end;

// used to set ClientIdentifier on active connection
procedure TOCIConnection.SetClientIdentifier;
var
  s: string;
  Command: TOCICommand;
begin
  s := TrimLeft(FClientIdentifier);
  if (Length(s) > 0) and (s[1] = ':') then
    RaiseError(SClientIdentifierFirstCharShouldNotBeColon);

  if GetOracleVersion < 9000 then
    Exit;

  Command := GetCommand;
  Command.SetSQL('BEGIN DBMS_SESSION.SET_IDENTIFIER(:a); END;');
  Command.Params[0].SetDataType(dtString);
  Command.Params[0].SetParamType(pdInput);
  Command.Params[0].SetSize(Length(FClientIdentifier));
  Command.Params[0].Value := FClientIdentifier;
  try
    Command.Execute;
  except
    on E: EOraError do begin
      if EOraError(E).ErrorCode = 6550 then
        raise EOraError.Create( EOraError(E).ErrorCode,
          'Please execute GRANT EXECUTE ON DBMS_SESSION TO ' +
          FUsername + ' as SYS' + DALineSeparator + DALineSeparator + EOraError(E).Message);
      raise;
    end;
  end;
end;
{$ENDIF}

{ TOraCursor }

constructor TOraCursor.Create;
begin
  inherited Create;

  FState := csInactive;
  FphOCIStmt := Marshal.AllocHGlobal(sizeof(IntPtr));
  Marshal.WriteIntPtr(FphOCIStmt, nil);
end;

destructor TOraCursor.Destroy;
begin
  FreeCursor;
  Marshal.FreeHGlobal(FphOCIStmt);

  inherited;
end;

procedure TOraCursor.SetOCISvcCtx(Value: TOCISvcCtx);
begin
  if FOCISvcCtx <> Value then begin
    ReleaseOCISvcCtx;

    FOCISvcCtx := Value;
    if FOCISvcCtx <> nil then begin
    {$IFNDEF AUTOREFCOUNT}
      FOCISvcCtx.AddRef;
    {$ENDIF}
      FOCI8 := FOCISvcCtx.OCI8
    end;
  end;
end;

procedure TOraCursor.Check(Status: sword);
begin
  if Status <> OCI_SUCCESS then
    OCI8.DoOraError(Status, OCISvcCtx);
end;

procedure TOraCursor.CheckOCI;
begin
  if not ((FOCICallStyle = OCI73) or (FOCICallStyle = OCI80)) then
    RaiseError(SCheckOCI);
end;

procedure TOraCursor.CheckOCI73;
begin
  if not (FOCICallStyle = OCI73) then
    RaiseError(SCheckOCI73);
end;

procedure TOraCursor.CheckOCI80;
begin
  if not (FOCICallStyle = OCI80) then
    RaiseError(SCheckOCI80);
end;

procedure TOraCursor.Init(AOCISvcCtx: TOCISvcCtx; AOCICallStyle: TOCICallStyle);
begin
  if (FOCISvcCtx <> AOCISvcCtx) or (FOCICallStyle <> AOCICallStyle) then begin
    FreeCursor;

    SetOCISvcCtx(AOCISvcCtx);
    FOCICallStyle := AOCICallStyle;
  end;
end;

procedure TOraCursor.ReleaseOCISvcCtx;
begin
  if FOCISvcCtx <> nil then begin
  {$IFNDEF AUTOREFCOUNT}
    FOCISvcCtx.ReleaseRef;
  {$ENDIF}
    FOCISvcCtx := nil;
    FOCI8 := nil;
  end;
end;

procedure TOraCursor.AllocCursor(AStatementCache: boolean = False);
var
  OCIStmt: pOCIStmt;
begin
  if FOCICallStyle = None then
    FOCICallStyle := OCISvcCtx.Home.OCICallStyle;

  if FOCICallStyle = OCI73 then begin
    if IntPtr(FCDA) = nil then begin
  {$IFDEF CLR}
    FCDA := Marshal.AllocHGlobal(CDA_SIZE);
  {$ELSE}
      GetMem(FCDA, CDA_SIZE);
  {$ENDIF}
    FillChar(FCDA, CDA_SIZE, 0);
    end;
  end
  else
  if FOCICallStyle = OCI80 then begin
    if hOCIStmt = nil then begin
      FStatementCache := AStatementCache;
      if not FStatementCache then begin
        Check(OCI8.OCIHandleAlloc(OCISvcCtx.hOCIEnv, OCIStmt, OCI_HTYPE_STMT, 0, nil));
        hOCIStmt := OCIStmt;
      end;
    end;
  end
  else
    CheckOCI;
end;

procedure TOraCursor.FreeCursor;
begin
  if IntPtr(FCDA) <> nil then begin
    CheckOCI73;
  {$IFDEF CLR}
    Marshal.FreeHGlobal(FCDA);
  {$ELSE}
    FreeMem(FCDA);
  {$ENDIF}
    FCDA := nil;
  end;

  if hOCIStmt <> nil then begin
    CheckOCI80;
    if FStatementCache then
      Check(OCI8.OCIStmtRelease(hOCIStmt, OCISvcCtx.hOCIError, nil, 0, OCI_DEFAULT))
    else
    if (OCISvcCtx.hOCISvcCtx <> nil) {$IFDEF NET}or OCISvcCtx.Home.Direct{$ENDIF} then
      Check(OCI8.OCIHandleFree(hOCIStmt, OCI_HTYPE_STMT));
    hOCIStmt := nil;
  end;

  ReleaseOCISvcCtx;
end;

procedure TOraCursor.Disconnect;
begin
  FreeCursor;
end;

function TOraCursor.CanFetch: boolean;
begin
  Result := (State >= csExecuted) and (State < csFetched);
end;

procedure TOraCursor.DisablePrefetching;
begin
  // Turn off prefetching
  SetPrefetchRows(0);
end;

function TOraCursor.GetCDA: PCDA;
begin
  CheckOCI73;

  if IntPtr(FCDA) = nil then
    AllocCursor;

  Result := FCDA;
end;

function TOraCursor.GethOCIStmt: pOCIStmt;
begin
  Result := Marshal.ReadIntPtr(FphOCIStmt);
end;

procedure TOraCursor.SethOCIStmt(Value: pOCIStmt);
begin
  Marshal.WriteIntPtr(FphOCIStmt, Value);

  if (FPrefetchRows = 0) or (OCISvcCtx.Home.OCIVersion < 9000) then //disable prefetching for Oracle < 9
    DisablePrefetching
  else
    SetPrefetchRows(FPrefetchRows);
end;

function TOraCursor.GetOCIStmt: pOCIStmt;
begin
  CheckOCI80;

  if hOCIStmt = nil then
    AllocCursor;

  Result := hOCIStmt;
end;

function TOraCursor.GetOCIStmtPtr: ppOCIStmt;
begin
  CheckOCI80;

  if hOCIStmt = nil then
    AllocCursor;

  Result := FphOCIStmt;
end;

procedure TOraCursor.SetPrefetchRows(Value: integer);
var
  Buf: Integer;
begin
  if OCICallStyle = OCI80 then
    if hOCIStmt <> nil then
      if OCISvcCtx.Home.OCIVersion div 10 <> 816 then begin
        Buf := Value;
        Check(OCI8.OCIAttrSet2(hOCIStmt, OCI_HTYPE_STMT, Buf, 0, OCI_ATTR_PREFETCH_ROWS, OCISvcCtx.hOCIError));
        if Buf = 0 then
          Check(OCI8.OCIAttrSet2(hOCIStmt, OCI_HTYPE_STMT, Buf, 0, OCI_ATTR_PREFETCH_MEMORY, OCISvcCtx.hOCIError)); // Disable prefetching
      end;
end;

{ TOraParam }

constructor TOraParamDesc.Create;
begin
  inherited Create;

  FActualLengthPtr := Marshal.AllocHGlobal(sizeof(integer));
  Marshal.WriteInt32(FActualLengthPtr, 0);
  FDefIndicator := Marshal.AllocHGlobal(2);
  Marshal.WriteInt16(FDefIndicator, -1);
  FIndicator := FDefIndicator;
  FValue := nil;
  FLength := 1;
  FCanBeOutput := True;
end;

destructor TOraParamDesc.Destroy;
begin
  FreeBuffer;
  Marshal.FreeHGlobal(FDefIndicator);
  Marshal.FreeHGlobal(FActualLengthPtr);

  inherited;
end;

{ Memory management }

function TOraParamDesc.GetOCISvcCtx: TOCISvcCtx;
begin
  Result := FOwner.OCISvcCtx;
  if Result = nil then
    Result := FOwner.FConnection.OCISvcCtx;
end;

function TOraParamDesc.GetOCI8: TOCI8API;
begin
  Result := OCISvcCtx.OCI8;
end;

function TOraParamDesc.GetActualLength: integer;
begin
  Result := Marshal.ReadInt32(FActualLengthPtr);
end;

procedure TOraParamDesc.SetActualLength(Value: integer);
begin
  Marshal.WriteInt32(FActualLengthPtr, Value);
end;

procedure TOraParamDesc.AllocBuffer;

  function CreateLob(LobDataType: integer): TOraLob;
  begin
    Result := TOraLob.Create(OCISvcCtx);
    if LobDataType in [dtBlob, dtOraBlob] then
      Result.LobType := ltBlob
    else if LobDataType in [dtOraClob] then
      Result.LobType := ltClob
    else if LobDataType in [dtWideOraClob, dtNClob] then
      Result.LobType := ltNClob;
  end;

var
  Obj: TSharedObject;
  i: integer;
begin
  if FBufferAllocated or (FDataType = dtUnknown) then
    exit;

  case FDataType of
    dtString, dtFixedChar:
      if FSize >= 1 then
        FValueSize := FSize + 1
      else
        FValueSize := 2;
    dtWideString, dtFixedWideChar:
      if FSize >= 1 then
        FValueSize := (FSize + 1) * SizeOf(WideChar)
      else
        FValueSize := 4;
    dtInt8, dtUInt8:
      FValueSize := sizeof(Byte);
    dtSmallint, dtWord:
      FValueSize := sizeof(SmallInt);
    dtInteger, dtUint32:
      FValueSize := sizeof(Integer);
  {$IFDEF VER14P}
    dtSingle:
      FValueSize := sizeof(Single);
  {$ENDIF}
    dtFloat, dtCurrency:
      FValueSize := sizeof(Double);
    dtDateTime, dtDate, dtTime:
      FValueSize := 7;
    dtBoolean:
      FValueSize := 4; // as int
    dtCursor:
      FValueSize := 0;
    dtBlob, dtMemo, dtWideMemo, dtOraBlob, dtOraClob, dtWideOraClob, dtBFile, dtCFile:
      if FLength > 1 then
        FValueSize := SizeOf(pOCILobLocator)
      else
        FValueSize := 0;
    dtObject, dtXML, dtArray, dtTable:
      FValueSize := 0;
    dtReference:
      FValueSize := 0;
    dtLabel:
      FValueSize := 0;
    dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ {$IFDEF VER6P}{$IFNDEF FPC}, dtSQLTimeStamp{$ENDIF}{$ENDIF}:
      if FLength > 1 then
        FValueSize := SizeOf(pOCIDateTime)
      else
        FValueSize := 0;
    dtIntervalYM, dtIntervalDS:
      if FLength > 1 then
        FValueSize := SizeOf(pOCIInterval)
      else
        FValueSize := 0;
    dtBytes, dtVarBytes:
      FValueSize := FSize + SizeOf(Word);
    dtNumber, dtBCD{$IFDEF VER6P}, dtInt64, dtUInt64{$IFNDEF FPC}, dtFMTBCD{$ENDIF}{$ENDIF}:
      if FLength > 1 then
        FValueSize := OCI_NUMBER_SIZE
      else
        FValueSize := 0;
  else
    Assert(False, SUnknownDataType);
  end;

  if FValueSize > 0 then begin
    FValue := Marshal.AllocHGlobal(FValueSize * FLength);
    FillChar(FValue, FValueSize * FLength, $00);
  end;

  if (FLength > 1) and (FDataType in [dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ,
    dtIntervalYM, dtIntervalDS, dtNumber, dtBCD,
    {$IFDEF VER6P}dtLargeint, {$IFNDEF FPC}dtFMTBCD, dtSQLTimeStamp, {$ENDIF}{$ENDIF}
    dtBlob, dtOraBlob, dtOraClob, dtWideOraClob, dtNClob])
  then
    FData := VarArrayCreate([1, FLength], varVariant);

  if FLength > 1 then begin
    FIndicator := Marshal.AllocHGlobal(sizeof(sb2) * FLength);
    FillChar(FIndicator, sizeof(sb2) * FLength, $FF);
    FTableIndicator := True;
  end
  else
    Marshal.WriteInt16(FDefIndicator, -1);

  FBufferAllocated := True;

  if FDataType in [dtBlob, dtOraBlob, dtOraClob, dtWideOraClob, dtNClob] then  begin
    if FLength > 1 then
      for i := 1 to FLength do begin
        Obj := CreateLob(FDataType);
        try
          SetItemAsObject(i, Obj);
        finally
          Obj.Release;
        end;
      end
    else begin
      Obj := CreateLob(FDataType);
      try
        SetObject(Obj);
      finally
        Obj.Release;
      end;
    end;
  end
  else
  if FDataType in [dtBCD{$IFDEF VER6P}, dtLargeint{$IFNDEF FPC}, dtFMTBCD, dtSQLTimeStamp{$ENDIF}{$ENDIF}] then begin
    if FLength > 1 then
      for i := 1 to FLength do begin
      {$IFDEF VER6P}
      {$IFNDEF FPC}
        if FDataType = dtSQLTimeStamp then
          Obj := TOraTimeStamp.Create(OCISvcCtx, FDataType)
        else
      {$ENDIF}
      {$ENDIF}
          Obj := TOraNumber.Create(OCISvcCtx);
        try
          SetItemAsObject(i, Obj);
        finally
          Obj.Release;
        end;
      end
    else begin
    {$IFDEF VER6P}
    {$IFNDEF FPC}
      if FDataType = dtSQLTimeStamp then
        Obj := TOraTimeStamp.Create(OCISvcCtx, FDataType)
      else
    {$ENDIF}
    {$ENDIF}
        Obj := TOraNumber.Create(OCISvcCtx);
      try
        SetObject(Obj);
      finally
        Obj.Release;
      end;
    end;
  end;
end;

procedure TOraParamDesc.FreeBuffer;

  procedure FreeItems;
  var
    i: integer;
    Obj: TSharedObject;
  begin
    for i := 1 to VarArrayHighBound(FData, 1) do begin
    {$IFDEF VER6P}
      if VarType(FData[i]) = varSharedObject then
        Obj := TSharedObject.FromVariant(FData[i])
      else
        Obj := nil;
    {$ELSE}
      Obj := TObject(Integer(FData[i])) as TSharedObject;
    {$ENDIF}
      Obj.Free;
    end;
    FData := Unassigned;
  end;

begin
  if FLength > 1 then
    if DataType in [dtBCD{$IFDEF VER6P}, dtLargeint{$IFNDEF FPC}, dtFMTBCD, dtSQLTimeStamp{$ENDIF}{$ENDIF},
                    dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ, dtIntervalYM, dtIntervalDS, dtNumber,
                    dtBlob, dtOraBlob, dtOraClob, dtWideOraClob, dtNClob]
    then
      FreeItems;

  if (FValueSize > 0) and (FValue <> nil) then begin
    Marshal.FreeHGlobal(FValue);
    FValue := nil;
  end;

  if FTableIndicator then begin
    Marshal.FreeHGlobal(FIndicator);
    FTableIndicator := False;
  end;
  FIndicator := FDefIndicator;

  if GetObject <> nil then begin
    GetObject.Free;
  {$IFNDEF FPC}
    FData := Unassigned;
  {$ELSE}
    FillByte(FData, SizeOf(TVarRec), 0);
  {$ENDIF}
  end;

  ClearBindData;

  FBufferAllocated := False;
end;

procedure TOraParamDesc.ClearBindData;
begin
  FHandle := nil;
  FBindBufferSize := 0;
end;

function TOraParamDesc.ValuePtr: IntPtr;
begin
  Result := FValue;
end;

function TOraParamDesc.GetValueSize: integer;
begin
  Result := FValueSize;
end;

procedure TOraParamDesc.SetValuePtr(Buf: IntPtr);
begin
  if GetDataType in [dtOraBlob, dtOraClob, dtCursor, dtBFile, dtCFile,
    dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ,
    dtIntervalYM, dtIntervalDS, dtNumber, dtBCD
    {$IFDEF VER6P}, dtLargeint{$IFNDEF FPC}, dtFMTBCD, dtSQLTimeStamp{$ENDIF}{$ENDIF}]
  then
    RaiseError(SParamIsNotStorable);

  case GetDataType of
    dtString, dtFixedChar, dtMemo: begin
      StrLCopy(PAChar(FValue), Buf, FValueSize - 1);
      FLen := StrLen(PAChar(Buf));
      if FLen > FValueSize - 1 then
        FLen := FValueSize - 1;
    end;
    dtWideString, dtFixedWideChar, dtWideMemo: begin
      StrLCopyW(FValue, Buf, (FValueSize - 2) div 2);
      FLen := StrLenW(Buf);
      if FLen * 2  > FValueSize - 2 then
        FLen := (FValueSize - 2) div 2;
    end;
  else
    CopyBuffer(Buf, FValue, FValueSize);
  end;
end;

function TOraParamDesc.IndicatorPtr: IntPtr;
begin
  Result := FIndicator;
end;

procedure TOraParamDesc.Clear;
begin
  if FLength > 1 then
    SetLength(1);

  inherited;
end;

procedure TOraParamDesc.SetDataType(Value: word);
begin
  if Value <> FDataType then begin
    FreeBuffer;

    if (Value in [dtString, dtFixedChar, dtMemo]) and
      (FOwner <> nil) and (FOwner.FConnection <> nil) and (OCISvcCtx.UnicodeEnv)
    then begin
    {$IFDEF LITE}
      FOriginalDataType := Value;
    {$ENDIF}
      case Value of
        dtString:
          FDataType := dtWideString;
        dtFixedChar:
          FDataType := dtFixedWideChar;
        dtMemo:
          FDataType := dtWideMemo;
      end;
    end
    else
      FDataType := Value;
  end;
end;

procedure TOraParamDesc.SetParamType(Value: TParamDirection);
var
  i: integer;
begin
  case Value of
    pdResult: begin
      for i := 0 to FOwner.Params.Count - 1 do
        if FOwner.Params[i].GetParamType = pdResult then
          FOwner.Params[i].SetParamType(pdOutput);
      inherited;
    end;
    pdOutput: begin
      if FParamType = pdResult then
        Exit
      else
        inherited;
    end;
    else
      inherited;
  end;
end;

procedure TOraParamDesc.SetSize(Value: integer);
begin
  if Value <> FSize then begin
    case FDataType of
      dtString, dtFixedChar, dtWideString, dtFixedWideChar, dtBytes, dtVarBytes:
        FreeBuffer;
    end;

    FSize := Value;
  end;
end;

procedure TOraParamDesc.SetNeedTruncateString(Value: boolean);
begin
  FNeedTruncateString := Value;
end;

procedure TOraParamDesc.CheckRange(Index: integer);
begin
  if (1 > Index) or (Index > FLength) then
    raise ERangeError.Create(SInvalidIndex);
end;

procedure TOraParamDesc.ValidateParamValue;
var
  StrTemp: AnsiString;
begin
  // Oracle 8.0.5 and lower doesn't support AL16UTF16 encoding
  if OCISvcCtx.Home.OCIVersion <= 8170 then
    if FDataType in [dtWideString, dtFixedWideChar] then begin
      StrTemp := AnsiString(GetItemAsWideString(1));
      FreeBuffer;
      SetItemAsAnsiString(1, StrTemp);
    end;
end;

procedure TOraParamDesc.SyncIndicator(Connection: TOCIConnection);
var
  Ind: sb2;
  Index: integer;
  ts: TOraTimeStamp;
  int: TOraInterval;
  num: TOraNumber;
  lob: TOraLob;
begin
  if FLength > 1 then begin
    case FDataType of
      dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ{$IFDEF VER6P}{$IFNDEF FPC}, dtSQLTimeStamp{$ENDIF}{$ENDIF},
      dtIntervalYM, dtIntervalDS,
      dtNumber, dtBCD, {$IFDEF VER6P}dtLargeint, {$IFNDEF FPC}dtFMTBCD, {$ENDIF}{$ENDIF}
      dtBlob, dtOraBlob, dtOraClob, dtWideOraClob, dtNClob:
        for Index := 1 to FLength do
          case FDataType of
            dtBlob, dtOraBlob, dtOraClob, dtWideOraClob, dtNClob: begin
              lob := TOraLob(GetItemAsObject(Index));
              if lob <> nil then begin
                lob.OCISvcCtx := Connection.OCISvcCtx;
                CopyBuffer(lob.OCILobLocatorPtr, PtrOffset(FValue, (Index - 1) * FValueSize), FValueSize);
                if lob.Size <> 0 then
                  SetIndicator(Index, 0)
                else
                  SetIndicator(Index, -1);
              end
              else
                SetIndicator(Index, -1);
            end;
            dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ{$IFDEF VER6P}{$IFNDEF FPC}, dtSQLTimeStamp{$ENDIF}{$ENDIF}: begin
              ts := TOraTimeStamp(GetItemAsObject(Index));
              if ts <> nil then begin
                ts.SetEnvironment(Connection.OCISvcCtx.Environment);
                Marshal.WriteInt32(FValue, (Index - 1) * FValueSize, Integer(ts.OCIDateTime));
//              {$IFDEF VER6P}
//              {$IFNDEF FPC}
//                if FDataType = dtSQLTimeStamp then
//                  ts.OCIDateTime := PtrOffset(FValue, (Index - 1) * FValueSize);
//              {$ENDIF}
//              {$ENDIF}
                SetIndicator(Index, sb2(Marshal.ReadInt16(ts.FIndicator)));
              end
              else
                SetIndicator(Index, -1);
            end;
            dtIntervalYM, dtIntervalDS: begin
              int := TOraInterval(GetItemAsObject(Index));
              if int <> nil then begin
                int.SetEnvironment(Connection.OCISvcCtx.Environment);
                Marshal.WriteInt32(FValue, (Index - 1) * FValueSize, Integer(int.OCIInterval));
                SetIndicator(Index, sb2(Marshal.ReadInt16(int.FIndicator)));
              end
              else
                SetIndicator(Index, -1);
            end;
            dtNumber, dtBCD{$IFDEF VER6P}, dtLargeint{$IFNDEF FPC}, dtFMTBCD{$ENDIF}{$ENDIF}: begin
              num := TOraNumber(GetItemAsObject(Index));
              if num <> nil then begin
                num.SetEnvironment(Connection.OCISvcCtx.Environment);
                CopyBuffer(num.OCINumberPtr, PtrOffset(FValue, (Index - 1) * FValueSize), FValueSize);
                if FDataType <> dtNumber then
                // FValue is freed on FreeBuffer.
                // For dtNumber param OCINumber buffer must exists after FreeBuffer
                // because OraNumber is used in TOraParam.ParamObject.
                  num.OCINumberPtr := PtrOffset(FValue, (Index - 1) * FValueSize);
                SetIndicator(Index, sb2(Marshal.ReadInt16(num.FIndicator)));
              end
              else
                SetIndicator(Index, -1);
            end;
          end;
    end;
  end
  else begin
    case FDataType of
      dtBlob,dtMemo,dtWideMemo,
      dtOraBlob,dtOraClob,
      dtBFile,dtCFile,
      dtObject,dtXML,dtReference,dtArray,dtTable,dtCursor,
      dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ, dtIntervalYM, dtIntervalDS,
      dtNumber, dtBCD{$IFDEF VER6P}, dtLargeint{$IFNDEF FPC}, dtFMTBCD, dtSQLTimeStamp{$ENDIF}{$ENDIF}: begin
        if VarIsArray(FData) then
          Exit;
        if {$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF} = nil then
          Ind := -1
        else
          case FDataType of
            dtBlob,dtMemo,dtWideMemo,dtOraBlob,dtOraClob:
              if TBlob({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF}).Size = 0 then
                Ind := -1
              else
                Ind := 0;
            dtBFile,dtCFile:
              if (TOraFile({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF}).FileDir = '') and (TOraFile({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF}).FileName = '') then
                Ind := -1
              else
                Ind := 0;
            dtObject,dtXML,dtReference,dtArray,dtTable:
              if TOraObject({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF}).Instance = nil then
                Ind := -1
              else
                Ind := 0;
            dtCursor:
              Ind := 0;
          else
          {{$IFNDEF MSWINDOWS
            Ind := 0;  // Kylix 1 anti warning
          $ENDIF}
            Exit;
          end;
      end
    else
      if (FValue = nil) then
        Ind := -1
      else
        Exit;
    end;

    SetIndicator(1, Ind)
  end;
end;

function TOraParamDesc.GetIndicator(Index: integer): smallint;
begin
  case FDataType of
    dtCursor:
      Result := 0; // strict for binding
    else begin
      CheckRange(Index);
      Result := Marshal.ReadInt16(FIndicator, (Index-1)*sizeof(sb2));
    end;
  end;
end;

procedure TOraParamDesc.SetIndicator(Index: integer; Value: smallint);
begin
  CheckRange(Index);
  Marshal.WriteInt16(FIndicator, (Index-1) * sizeof(sb2), Value);
end;

procedure TOraParamDesc.SetTable(Value: boolean);
begin
  FTable := Value;
end;

procedure TOraParamDesc.SetLength(Value: integer);
begin
  if Value <> FLength then begin
    FreeBuffer;

    FLength := Value;
  end;
end;

procedure TOraParamDesc.SetHasDefault(Value: boolean);
begin
  FHasDefault := Value;
end;

function TOraParamDesc.GetTable: boolean;
begin
  Result := FTable;
end;

function TOraParamDesc.GetLength: integer;
begin
  Result := FLength;
end;

function TOraParamDesc.GetHasDefault: boolean;
begin
  Result := FHasDefault;
end;

function TOraParamDesc.GetCanBeOutput: boolean;
begin
  Result := FCanBeOutput;
end;

{$IFDEF LITE}
function TOraParamDesc.GetOriginalDataType: word;
begin
  Result := FOriginalDataType;
end;
{$ENDIF}

function TOraParamDesc.GetItemAsDateTime(Index: integer): TDateTime;
var
  VPtr: IntPtr;
  OraTS: TOraTimeStamp;
begin
  if not GetItemNull(Index) then
    case FDataType of
      dtDate, dtTime, dtDateTime: begin
        VPtr := PtrOffset(FValue, (Index - 1) * FValueSize);
        Result := OraDateToDateTime(VPtr);
      end;
      {$IFDEF VER6P}{$IFNDEF FPC}dtSQLTimeStamp,{$ENDIF}{$ENDIF}
      dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ: begin
        if GetLength > 1 then
          OraTS := TOraTimeStamp(GetItemAsObject(Index))
        else
          OraTS := GetAsTimeStamp;
        Result := OraTS.AsDateTime;
      end;
      else
        Result := 0;
    end
  else
    Result := 0;
end;

procedure TOraParamDesc.SetItemAsDateTime(Index: integer; Value: TDateTime);
var
  VPtr: IntPtr;
begin
  CheckRange(Index);
  FDataType := dtDateTime;
  AllocBuffer;
  VPtr := PtrOffset(FValue, (Index - 1) * FValueSize);
  DateTimeToOraDate(Value, VPtr);
  SetItemNull(Index, False);
end;

function TOraParamDesc.GetItemAsFloat(Index: integer): double;
begin
  if not GetItemNull(Index) and (FDataType in [dtFloat, dtCurrency]) then begin
    Result := BitConverter.Int64BitsToDouble(Marshal.ReadInt64(FValue, (Index - 1) * FValueSize));
  end
  else
    Result := 0;
end;

procedure TOraParamDesc.SetItemAsFloat(Index: integer; Value: double);
begin
  CheckRange(Index);
  FDataType := dtFloat;
  AllocBuffer;

  Marshal.WriteInt64(FValue, (Index - 1)*FValueSize, BitConverter.DoubleToInt64Bits(Value));
  SetItemNull(Index, False);
end;

{$IFDEF VER14P}

function TOraParamDesc.GetItemAsSingle(Index: integer): double;
begin
  if not GetItemNull(Index) and (FDataType = dtSingle) then begin
    Result := CRBitConverter.Int32BitsToSingle(Marshal.ReadInt32(FValue, (Index - 1) * FValueSize));
  end
  else
    Result := 0;
end;

procedure TOraParamDesc.SetItemAsSingle(Index: integer; Value: double);
begin
  CheckRange(Index);
  FDataType := dtSingle;
  AllocBuffer;

  Marshal.WriteInt32(FValue, (Index - 1)*FValueSize, CRBitConverter.SingleToInt32Bits(Value));
  SetItemNull(Index, False);
end;

{$ENDIF}

function TOraParamDesc.GetItemAsInteger(Index: integer): integer;
begin
  case FDataType of
    dtInt8:
      Result := ShortInt(Marshal.ReadByte(FValue, (Index - 1)*FValueSize));
    dtUInt8:
      Result := Byte(Marshal.ReadByte(FValue, (Index - 1)*FValueSize));
    dtInt16:
      Result := SmallInt(Marshal.ReadInt16(FValue, (Index - 1)*FValueSize));
    dtWord:
      Result := Word(Marshal.ReadInt16(FValue, (Index - 1)*FValueSize));
    dtInteger:
      Result := Integer(Marshal.ReadInt32(FValue, (Index - 1)*FValueSize));
    dtUInt32:
      Result := Longword(Marshal.ReadInt32(FValue, (Index - 1)*FValueSize));
    else
      Result := 0;
  end;
end;

procedure TOraParamDesc.SetItemAsInteger(Index: integer; Value: integer; DataType: Word = dtInteger);
begin
  CheckRange(Index);

  FDataType := DataType;
  AllocBuffer;

  case FDataType of
    dtInt8, dtUInt8:
      Marshal.WriteByte(FValue, (Index - 1)*FValueSize, Byte(Value));
    dtInt16, dtWord:
      Marshal.WriteInt16(FValue, (Index - 1)*FValueSize, SmallInt(Value));
    dtInteger, dtUInt32:
      Marshal.WriteInt32(FValue, (Index - 1)*FValueSize, Integer(Value));
    else
      Assert(False);
  end;

  SetItemNull(Index, False);
end;

function TOraParamDesc.GetItemAsCurrency(Index: integer): currency;
begin
  if not GetItemNull(Index) and (FDataType = dtBCD) then begin
    if GetLength > 1 then
      Result := StrToCurr(TOraNumber(GetItemAsObject(Index)).AsString)
    else
      Result := StrToCurr(GetAsNumber.AsString);
  end
  else
    Result := 0;
end;

procedure TOraParamDesc.SetItemAsCurrency(Index: integer; Value: currency);
var
  OraNumber: TOraNumber;
begin
  CheckRange(Index);
  FDataType := dtBCD;
  AllocBuffer;

  if GetLength > 1 then
    OraNumber := TOraNumber(GetItemAsObject(Index))
  else
    OraNumber := GetAsNumber;

  Assert(OraNumber <> nil);
  OraNumber.AsString := CurrToStr(Value);
end;

{$IFDEF VER6P}
function TOraParamDesc.GetItemAsLargeInt(Index: integer): Int64;
begin
  if not GetItemNull(Index) and (FDataType = dtLargeint) then begin
    if GetLength > 1 then
      Result := TOraNumber(GetItemAsObject(Index)).AsLargeInt
    else
      Result := GetAsNumber.AsLargeInt;
  end
  else
    Result := 0;
end;

procedure TOraParamDesc.SetItemAsLargeInt(Index: integer; Value: Int64);
var
  OraNumber: TOraNumber;
begin
  CheckRange(Index);
  FDataType := dtLargeint;
  AllocBuffer;

  if GetLength > 1 then
    OraNumber := TOraNumber(GetItemAsObject(Index))
  else
    OraNumber := GetAsNumber;

  Assert(OraNumber <> nil);
  OraNumber.AsLargeInt := Value;
end;

{$IFNDEF FPC}
procedure TOraParamDesc.GetItemAsBcd(Index: integer; var Value: TBCD);
begin
  if not GetItemNull(Index) and (FDataType = dtFMTBCD) then begin
    if GetLength > 1 then
      Value := TOraNumber(GetItemAsObject(Index)).AsBCD
    else
      Value := GetAsNumber.AsBCD;
  end
  else
    Value := NullBcd;
end;

procedure TOraParamDesc.SetItemAsBcd(Index: integer; const Value: TBCD);
var
  OraNumber: TOraNumber;
begin
  CheckRange(Index);
  FDataType := dtFMTBCD;
  AllocBuffer;

  if GetLength > 1 then
    OraNumber := TOraNumber(GetItemAsObject(Index))
  else
    OraNumber := GetAsNumber;

  Assert(OraNumber <> nil);
  OraNumber.AsBCD := Value;
end;

procedure TOraParamDesc.GetItemAsSQLTimeStamp(Index: integer; var Value: TSQLTimeStamp);
var
  VPtr: IntPtr;
  OraTS: TOraTimeStamp;
begin
  if not GetItemNull(Index) then
    case FDataType of
      dtDateTime: begin
        VPtr := PtrOffset(FValue, (Index - 1) * FValueSize);
        Value := DateTimeToSQLTimeStamp(OraDateToDateTime(VPtr));
      end;
      dtSQLTimeStamp,
      dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ: begin
        if GetLength > 1 then
          OraTS := TOraTimeStamp(GetItemAsObject(Index))
        else
          OraTS := GetAsTimeStamp;
        OraTimeStampToSQLTimeStamp(OraTS, Value);
      end;
      else
        Value := NullSqlTimeStamp;
    end
  else
    Value := NullSqlTimeStamp;
end;

procedure TOraParamDesc.SetItemAsSQLTimeStamp(Index: integer; const Value: TSQLTimeStamp);
var
  OraTS: TOraTimeStamp;
begin
  CheckRange(Index);
  FDataType := dtSQLTimeStamp;
  AllocBuffer;

  if GetLength > 1 then
    OraTS := TOraTimeStamp(GetItemAsObject(Index))
  else
    OraTS := GetAsTimeStamp;

  Assert(OraTS <> nil);
  SQLTimeStampToOraTimeStamp(OraTS, Value);
end;
{$ENDIF}
{$ENDIF}

function TOraParamDesc.GetItemAsString(Index: integer): string;
begin
{$IFDEF IS_UNICODE}
  Result := GetItemAsWideString(Index);
{$ELSE}
  Result := GetItemAsAnsiString(Index);
{$ENDIF}
end;

procedure TOraParamDesc.SetItemAsString(Index: integer; const Value: string);
begin
{$IFDEF IS_UNICODE}
  SetItemAsWideString(Index, Value);
{$ELSE}
  SetItemAsAnsiString(Index, Value);
{$ENDIF}
end;

function TOraParamDesc.GetItemAsAnsiString(Index: integer): AnsiString;
var
  VPtr: PAChar;
  Ptr: IntPtr;
  Len: integer;
begin
  if GetItemNull(Index) then begin
    Result := '';
    exit;
  end;

  case FDataType of
    dtWideString, dtFixedWideChar:
      Result := AnsiString(GetItemAsWideString(Index));
    dtString, dtFixedChar: begin
      VPtr := PAChar(PtrOffset(FValue, (Index - 1) * FValueSize));
      if FConvertEOL then begin
        Len := StrLen(VPtr);
        Ptr := Marshal.AllocHGlobal(Len * 2);
        try
          Len := AddCRString(VPtr, Ptr, Len);
          Result := Marshal.PtrToStringAnsi(Ptr, Len);
        finally
          Marshal.FreeHGlobal(Ptr);
        end;
      end
      else
        Result := Marshal.PtrToStringAnsi(VPtr);
    end;
  else
    Result := '';
  end;
end;

procedure TOraParamDesc.SetItemAsAnsiString(Index: integer; const Value: AnsiString);
var
  VPtr: IntPtr;
  SPtr: IntPtr;
  SLen: integer;
begin
  CheckRange(Index);
  if FDataType <> dtFixedChar then
    FDataType := dtString;

  SLen := LengthA(Value);
  if not FNeedTruncateString then
    if SLen > FSize then
      SetSize(SLen);
  AllocBuffer;

  VPtr := PtrOffset(FValue, (Index - 1) * FValueSize);
  if Value <> '' then begin
    if FNeedTruncateString then
      if SLen > FValueSize - 1 then  // null terminator
        SLen := FValueSize - 1; // truncate value
    SPtr := Marshal.StringToHGlobalAnsi(Value);
    try
      if FConvertEOL then
        SLen := RemoveCRString(SPtr, VPtr, SLen, LengthA(Value))
      else begin
        CopyBuffer(SPtr, VPtr, SLen);
      end;
    finally
      FreeString(SPtr);
    end;
    if (FLength = 1) or (SLen > FLen) then
      FLen := SLen;
    Marshal.WriteByte(VPtr, SLen, 0);

    SetItemNull(Index, False);
  end
  else
    SetItemNull(Index, True);
end;

function TOraParamDesc.GetItemAsWideString(Index: integer): WideString;
var
  VPtr, Ptr: IntPtr;
  Len : integer;
begin
  case FDataType of
    dtString, dtFixedChar:
      Result := WideString(GetItemAsAnsiString(Index));
    dtWideString, dtFixedWideChar: begin
      VPtr := PtrOffset(FValue, (Index - 1) * FValueSize);
      if FConvertEOL then begin
        Len := StrLenW(VPtr);
        Ptr := Marshal.AllocHGlobal(Len * 4);
        try
          Len := AddCRUnicode(VPtr, Ptr, Len);
          Result := Marshal.PtrToStringUni(Ptr, Len);
        finally
          Marshal.FreeHGlobal(Ptr);
        end;
      end
      else
        Result := Marshal.PtrToStringUni(VPtr);
    end
  else
    Result := '';
  end;
end;

procedure TOraParamDesc.SetItemAsWideString(Index: integer; const Value: WideString);
var
  VPtr: IntPtr;
  SPtr: IntPtr;
  SLen: integer;
begin
  CheckRange(Index);
  if FDataType <> dtFixedWideChar then
    FDataType := dtWideString;

  SLen := Length(Value);
  if not FNeedTruncateString then
    if SLen > FSize then
      SetSize(SLen);
  AllocBuffer;

  VPtr := PtrOffset(FValue, (Index - 1) * FValueSize);
  if Value <> '' then begin
    if FNeedTruncateString then
      if SLen * 2 > FValueSize - 2 then  // null terminator
        SLen := (FValueSize - 2) div 2; // truncate value
    SPtr := Marshal.StringToHGlobalUni(Value);
    try
      if FConvertEOL then
        SLen := RemoveCRUnicode(SPtr, VPtr, SLen, Length(Value))
      else
        CopyBuffer(SPtr, VPtr, SLen * 2);
    finally
      FreeString(SPtr);
    end;
    if (FLength = 1) or (SLen > FLen) then
      FLen := SLen;
    Marshal.WriteInt16(VPtr, SLen * 2, 0);

    SetItemNull(Index, False);
  end
  else
    SetItemNull(Index, True);
end;

function TOraParamDesc.GetItemAsBoolean(Index: integer): boolean;
begin
  if not GetItemNull(Index) and (FDataType = dtBoolean) then begin
    Result := Boolean(Marshal.ReadInt32(FValue, (Index - 1) * FValueSize));
  end
  else
    Result := False;
end;

procedure TOraParamDesc.SetItemAsBoolean(Index: integer; Value: boolean);
begin
  CheckRange(Index);
  FDataType := dtBoolean;
  AllocBuffer;
  Marshal.WriteInt32(FValue, (Index - 1) * FValueSize, Integer(Value));
  SetItemNull(Index, False);
end;

procedure TOraParamDesc.SetItemAsObject(Index: integer; Value: TSharedObject);
var
  ItemValue: Variant;
  OldValue: TSharedObject;
begin
  AllocBuffer;

  OldValue := GetItemAsObject(Index);
  if Value <> OldValue then
  try
  {$IFDEF VER6P}
    ItemValue := Value.ToVariant;
  {$ELSE}
    ItemValue := Integer(Value);
  {$ENDIF}

    if VarIsArray(FData) then
      FData[Index] := ItemValue
    else begin
      Assert(Index = 1);
      FData[Index] := ItemValue;
    end;

    // Increase RefCount for Value
    Value.AddRef;
  finally
    // Decrease RefCount for existing object
    if OldValue <> nil then
      OldValue.Release;
  end;
end;

function TOraParamDesc.GetItemAsObject(Index: integer): TSharedObject;
var
  ItemData: Variant;
begin
  if VarIsArray(FData) then begin
  {$IFDEF VER6P}
    ItemData := FData[Index]
  {$ELSE}
    TVarData(ItemData).VType := varInteger;
    TVarData(ItemData).VPointer := TVarData(FData[Index]).VPointer;
  {$ENDIF}
  end
  else begin
    Assert(Index = 1);
  {$IFDEF VER6P}
    ItemData := FData;
  {$ELSE}
    TVarData(ItemData).VType := varInteger;
    TVarData(ItemData).VPointer := TVarData(FData).VPointer;
  {$ENDIF}
  end;

{$IFDEF VER6P}
  Result := TSharedObject.FromVariant(ItemData);
{$ELSE}
  Result := TObject(Integer(ItemData)) as TSharedObject;
{$ENDIF}
end;

function TOraParamDesc.GetItemAsVariant(Index: integer): variant;
var
  i, Len: word;
{$IFDEF VER6P}
{$IFNDEF FPC}
  Bcd: TBcd;
  TS: TSQLTimeStamp;
{$ENDIF}
{$ENDIF}
begin
  CheckRange(Index);

  if GetItemNull(Index) then begin
    if FDataType = dtString then
      Result := ''
    else
      Result := Null;
    Exit;
  end;

  case FDataType of
    dtBoolean:
      Result := GetItemAsBoolean(Index);
    dtString, dtFixedChar:
      Result := GetItemAsAnsiString(Index);
    dtWideString, dtFixedWideChar:
      Result := GetItemAsWideString(Index);
    dtInt8:
      Result := ShortInt(GetItemAsInteger(Index));
    dtUInt8:
      Result := Byte(GetItemAsInteger(Index));
    dtInt16:
      Result := SmallInt(GetItemAsInteger(Index));
    dtWord:
      Result := Word(GetItemAsInteger(Index));
    dtInteger:
      Result := Integer(GetItemAsInteger(Index));
    dtUInt32:
      Result := {$IFDEF VER6P}Longword{$ENDIF}(GetItemAsInteger(Index));
    dtFloat, dtCurrency:
      Result := GetItemAsFloat(Index);
  {$IFDEF VER14P}
    dtSingle:
      Result := GetItemAsSingle(Index);
  {$ENDIF}
    dtBCD:
      Result := GetItemAsCurrency(Index);
  {$IFDEF VER6P}
    dtInt64:
      Result := GetItemAsLargeInt(Index);
    dtUInt64:
      Result := UInt64(GetItemAsLargeInt(Index));
  {$IFNDEF FPC}
    dtFMTBCD: begin
      GetItemAsBcd(Index, Bcd);
      VarFMTBcdCreate(Result, Bcd);
    end;
    dtSQLTimeStamp: begin
      GetItemAsSQLTimeStamp(Index, TS);
      VarSQLTimeStampCreate(Result, TS);
    end;
  {$ENDIF}
  {$ENDIF}
    dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ:
      Result := GetItemAsDateTime(Index);
    dtDate, dtTime, dtDateTime:
      Result := GetItemAsDateTime(Index);
    dtBlob,dtMemo,dtWideMemo:
      if TBlob({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF}).IsUnicode then
        Result := TBlob({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF}).AsWideString
      else
        Result := TBlob({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF}).AsString;
    dtUnknown:
      Result := Unassigned;
    dtBytes,dtVarBytes: begin
      Len := Word(Marshal.ReadInt16(FValue, (Index - 1) * FValueSize));
      Result := VarArrayCreate([0, Len - 1], varByte);
      for i := 0 to Len - 1 do begin
        Result[i] := Marshal.ReadByte(FValue, (Index - 1) * FValueSize + i + 2);
      end;
    end;
    else
      Result := Null;
  end;
end;

procedure TOraParamDesc.SetItemAsVariant(Index: integer; const Value: variant);
var
  Len: integer;
  sa: AnsiString;
  sw: WideString;
  lw: LongWord;
  Buf: TBytes;
  ItemObject: TSharedObject;
{$IFDEF CLR}
  i, lb: integer;
  Handle: IntPtr;
{$ENDIF}
{$IFDEF VER6P}
  i64: int64;
{$ENDIF}
begin
  CheckRange(Index);

  if VarIsNull(Value) or VarIsEmpty(Value) then
    SetItemNull(Index, True)
  else begin
    if FDataType = dtUnknown then
      case VarType(Value) of
        varSmallint,varInteger,varByte{$IFDEF VER6P},varWord,varShortInt{$ENDIF}:
          SetDataType(dtInteger);
      {$IFDEF VER6P}
        varLongWord,varInt64:
          SetDataType(dtLargeint);
      {$ENDIF}
      {$IFDEF VER14P}
        varSingle:
          SetDataType(dtSingle);
      {$ENDIF}
        varDouble, varCurrency:
          SetDataType(dtFloat);
        varDate:
          SetDataType(dtDateTime);
        varString: begin
          SetDataType(dtString);
          sa := AnsiString(Value);
          SetSize(LengthA(sa));
        end;
      else
        if VarIsStr(Value) then begin
          SetDataType(dtWideString);
          sw := WideString(Value);
          SetSize(Length(sw));
        end
        else
          raise EConvertError.Create(SUnknownDataType);
      end;

    AllocBuffer;
    case FDataType of
      dtBlob, dtOraBlob, dtOraClob, dtWideOraClob, dtNClob: begin
        case VarType(Value) of
        {$IFDEF VER6P}
          varSharedObject: begin
            ItemObject := TSharedObject.FromVariant(Value);
            SetItemAsObject(Index, ItemObject);
          end;
        {$ELSE}
          varInteger: begin
            ItemObject := TObject(Integer(Value))as TSharedObject;
            SetItemAsObject(Index, ItemObject);
          end;
        {$ENDIF}
          varString:
            TOraLob(GetItemAsObject(Index)).AsAnsiString := AnsiString(Value);
        {$IFDEF VER12P}varUString,{$ENDIF}
        {$IFNDEF CLR}varOleStr{$ELSE}varChar{$ENDIF}:
            TOraLob(GetItemAsObject(Index)).AsWideString := WideString(Value);
          varByte + varArray: begin
          {$IFDEF CLR}
            lb := VarArrayLowBound(Value, 1);
            Len := VarArrayHighBound(Value, 1) - lb + 1;
            Borland.Delphi.System.SetLength(Buf, Len);
            for i := 0 to Len - 1 do
              Buf[i] := Value[i + lb];
            Handle := AllocGCHandle(Buf, True);
            try
              TOraLob(GetItemAsObject(Index)).Write(0, Len, GetAddrOfPinnedObject(Handle));
            finally
              FreeGCHandle(Handle);
            end;
          {$ELSE}
            TOraLob(GetItemAsObject(Index)).Write(0, TVarData(Value).VArray.Bounds[0].ElementCount, TVarData(Value).VArray.Data);
          {$ENDIF}
          end;
        else
          raise EConvertError.Create(SCannotConvertType);
        end;
      end;
      dtBytes, dtVarBytes: begin
      {$IFNDEF VER9P}
        System.SetLength(Buf, 0); // to avoid warning
      {$ENDIF}  
        if VarIsStr(Value) then begin
          Buf := Encoding.Default.GetBytes(VarToStr(Value));
          Len := Length(Buf);
          if Len > GetSize then
            Len := GetSize;
          Marshal.Copy(Buf, 0, PtrOffset(FValue, (Index - 1) * FValueSize + SizeOf(Word)), Len);
          Marshal.WriteByte(FValue, (Index - 1) * FValueSize + SizeOf(Word) + Len, 0);
        end
        else begin
        {$IFDEF CLR}
          // VarArrayLowBound(Value, 1) can differ from 0
          lb := VarArrayLowBound(Value, 1);
          Len := VarArrayHighBound(Value, 1) - lb + 1;
          if Len > GetSize then
            Len := GetSize;
          Borland.Delphi.System.SetLength(Buf, Len);
          for i := 0 to Len - 1 do
            Buf[i] := Value[i + lb];
          Marshal.Copy(Buf, 0, PtrOffset(FValue, (Index - 1) * FValueSize + SizeOf(Word)), Length(Buf));
        {$ELSE}
          Len := TVarData(Value).VArray.Bounds[0].ElementCount;
          if Len > GetSize then
            Len := GetSize;
          Move(TVarData(Value).VArray.Data^, (PAnsiChar(FValue) + (Index - 1) * FValueSize + SizeOf(Word))^, Len);
        {$ENDIF}
        end;
        Marshal.WriteInt16(FValue, (Index - 1) * FValueSize, Len);
        SetItemNull(Index, Len = 0);
      end;
      dtString, dtFixedChar:
        SetItemAsAnsiString(Index, AnsiString(Value));
      dtWideString, dtFixedWideChar:
        SetItemAsWideString(Index, WideString(Value));
      dtUInt8, dtWord, dtUInt32:
        case VarType(Value) of
          varByte, varSmallint, varInteger,
        {$IFDEF VER6P}
          varShortInt, varWord, varLongWord, varInt64, {$IFDEF VER12P}varUInt64,{$ENDIF}
        {$ENDIF}
          varSingle, varDouble, varCurrency: begin
            lw := Value; // to avoid Range Check error
            SetItemAsInteger(Index, Integer(lw), FDataType);
          end;
        {$IFNDEF VER6P}
          $E: // VT_DECIMAL - this type of variant is returned by TLargeintField.
            SetItemAsInteger(Index, PInt64(@TVarData(Value).VInteger)^, FDataType);
        {$ENDIF}
        else
          if VarIsStr(Value) then begin
            lw := StrToInt(Value);
            SetItemAsInteger(Index, Integer(lw), FDataType)
          end
          else
            raise EConvertError.Create(SCannotConvertType);
        end;
      dtInt8, dtSmallint, dtInteger:
        case VarType(Value) of
          varByte, varSmallint, varInteger,
        {$IFDEF VER6P}
          varShortInt, varWord, varLongWord, varInt64, {$IFDEF VER12P}varUInt64, {$ENDIF}
        {$ENDIF}
          varSingle, varDouble, varCurrency:
            SetItemAsInteger(Index, Integer(Value), FDataType);
        {$IFNDEF VER6P}
          $E: // VT_DECIMAL - this type of variant is returned by TLargeintField.
            SetItemAsInteger(Index, PInt64(@TVarData(Value).VInteger)^, FDataType);
        {$ENDIF}
        else
          if VarIsStr(Value) then
            SetItemAsInteger(Index, StrToInt(Value), FDataType)
          else
            raise EConvertError.Create(SCannotConvertType);
        end;
      {$IFDEF VER14P}dtSingle,{$ENDIF} dtFloat, dtCurrency:
        case VarType(Value) of
          {$IFDEF VER6P}varWord, varLongWord, varShortInt, varInt64,{$ENDIF}
          varSmallint, varInteger, varByte,
          varSingle, varDouble, varCurrency:
          {$IFDEF VER14P}
            if FDataType = dtSingle then
              SetItemAsSingle(Index, Value)
            else
          {$ENDIF}
              SetItemAsFloat(Index, Value);
        {$IFNDEF VER6P}
          $E: // VT_DECIMAL
            SetItemAsFloat(Index, PInt64(@TVarData(Value).VInteger)^);
        {$ENDIF}
        else
          if VarIsStr(Value) then
          {$IFDEF VER14P}
            if FDataType = dtSingle then
              SetItemAsSingle(Index, StrToFloat(Value))
            else
          {$ENDIF}
              SetItemAsFloat(Index, StrToFloat(Value))
          else
            raise EConvertError.Create(SCannotConvertType);
        end;
      dtBCD:
        case VarType(Value) of
          {$IFDEF VER6P}varWord, varLongWord, varShortInt, varInt64,{$ENDIF}
          varSmallint, varInteger, varByte,
          varSingle, varDouble, varCurrency:
            SetItemAsCurrency(Index, Value);
        {$IFNDEF VER6P}
          $E: // VT_DECIMAL
            SetItemAsCurrency(Index, PInt64(@TVarData(Value).VInteger)^);
        {$ENDIF}
        else
          if VarIsStr(Value) then
            SetItemAsCurrency(Index, StrToCurr(Value))
          else
            raise EConvertError.Create(SCannotConvertType);
        end;
    {$IFDEF VER6P}
      dtInt64, dtUInt64:
        case VarType(Value) of
          {$IFDEF VER6P}varWord, varLongWord, varShortInt, varInt64,{$ENDIF}
          varSmallint, varInteger, varByte,
          varSingle, varDouble, varCurrency:
            SetItemAsLargeInt(Index, Value);
        else
          if VarIsStr(Value) then
            SetItemAsLargeInt(Index, StrToInt64(Value))
          else
            raise EConvertError.Create(SCannotConvertType);
        end;
    {$IFNDEF FPC}
      dtFMTBCD:
        // VarToBcd works correctly only for VarFMTBcd
        case VarType(Value) of
          varSmallint, varInteger, varByte, varWord, varShortInt:
            SetItemAsBcd(Index, IntegerToBcd(Value));
          varLongWord, varInt64: begin
            i64 := Value;
            SetItemAsBcd(Index, StrToBcd(IntToStr(i64)));
          end;
          varSingle, varDouble, varCurrency:
            SetItemAsBcd(Index, DoubleToBcd(Value));
        else
          if VarIsStr(Value) then
            SetItemAsBcd(Index, StrToBcd(Value))
          else
          if VarType(Value) = VarFMTBcd then
            SetItemAsBcd(Index, VarToBcd(Value))
          else
            raise EConvertError.Create(SCannotConvertType);
        end;
    {$ENDIF}
    {$ENDIF}
      dtDateTime, dtDate, dtTime:
        case VarType(Value) of
          varDate:
            SetItemAsDateTime(Index, Value);
          varDouble, varSingle, varCurrency:
            SetItemAsDateTime(Index, Double(Value));
        else
          if VarIsStr(Value) then
            SetItemAsDateTime(Index, StrToDateTime(Value))
          else
            raise EConvertError.Create(SCannotConvertType);
        end;
      dtBoolean:
        case VarType(Value) of
          varBoolean:
            SetItemAsBoolean(Index, Value);
          varSmallint,varInteger,varByte,{$IFDEF VER6P}varWord,varLongWord,varShortInt,varInt64,{$ENDIF}
          varSingle,varDouble,varCurrency:
            SetItemAsBoolean(Index, Value = 0);
        else
          raise EConvertError.Create(SCannotConvertType);
        end;
      {$IFDEF VER6P}{$IFNDEF FPC}dtSQLTimeStamp,{$ENDIF}{$ENDIF}
      dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ, dtIntervalYM, dtIntervalDS, dtNumber:
        case VarType(Value) of
        {$IFDEF VER6P}
          varSharedObject : begin
            ItemObject := TSharedObject.FromVariant(Value);
            SetItemAsObject(Index, ItemObject);
          end;
        {$ELSE}
          varInteger: begin
            ItemObject := TObject(Integer(Value)) as TSharedObject;
            SetItemAsObject(Index, ItemObject);
          end;
        {$ENDIF}
          varDate: begin
            ItemObject := GetItemAsObject(Index);
            if ItemObject = nil then begin
              ItemObject := TOraTimeStamp.Create(OCISvcCtx, FDataType);
              try
                SetItemAsObject(Index, ItemObject);
              finally
                ItemObject.Release;
              end;
            end;
            TOraTimeStamp(ItemObject).AsDateTime := Value;
          end
        else
        {$IFDEF VER6P}
        {$IFNDEF FPC}
          if VarIsSQLTimeStamp(Value) then begin
            ItemObject := GetItemAsObject(Index);
            if ItemObject = nil then begin
              ItemObject := TOraTimeStamp.Create(OCISvcCtx, FDataType);
              try
                SetItemAsObject(Index, ItemObject);
              finally
                ItemObject.Release;
              end;
            end;
            SQLTimeStampToOraTimeStamp(TOraTimeStamp(ItemObject), VarToSQLTimeStamp(Value));
          end
          else
        {$ENDIF}
        {$ENDIF}
            raise EConvertError.Create(SCannotConvertType);
        end;
    else
      raise EConvertError.Create(SCannotConvertType);
    end;
  end;
end;

function TOraParamDesc.GetValue: variant;
var
  i: integer;
begin
  if FLength > 1 then begin
    Result := VarArrayCreate([1, FLength], varVariant);
    for i := 1 to FLength do
      Result[i] := GetItemAsVariant(i);
  end
  else
    Result := GetItemAsVariant(1);
end;

procedure TOraParamDesc.SetValue(const Value: variant);

  procedure InternalSetValue(Index: integer; const Value: variant);
  {$IFNDEF LITE}
  var
    EncryptDataType: word;
  {$ENDIF}
  begin
  {$IFNDEF LITE}
    if Assigned(FEncryptor) then begin
      case FDataType of
        dtFixedChar:
          EncryptDataType := dtString;
        dtFixedWideChar:
          EncryptDataType := dtWideString;
        dtFixedNChar:
          EncryptDataType := dtString;
        dtFixedNWideChar:
          EncryptDataType := dtWideString;
        dtNString:
          EncryptDataType := dtString;
        dtNWideString:
          EncryptDataType := dtWideString;
        else
          EncryptDataType := FDataType;
      end;

      SetItemAsVariant(Index, EncryptValue(EncryptDataType, Value))
    end
    else
  {$ENDIF}
      SetItemAsVariant(Index, Value);
  end;

var
  i: integer;
begin
  if (FDataType in [dtBytes, dtVarBytes]) and
    ((VarType(Value) = varArray or varByte) or VarIsStr(Value))
  then
    InternalSetValue(1, Value)
  else
  if VarIsArray(Value) then begin
    FLen := 0;
    SetLength(VarArrayHighBound(Value, 1));
    for i := VarArrayLowBound(Value, 1) to VarArrayHighBound(Value, 1) do
      InternalSetValue(i, Value[i]);
  end
  else
    InternalSetValue(1, Value)
end;

function TOraParamDesc.GetObject: TSharedObject;
begin
  if VarType(FData) = varSharedObject then
    Result := TSharedObject.FromVariant(FData)
  else
    Result := nil;
end;

procedure TOraParamDesc.SetObject(Value: TSharedObject);
{$IFNDEF LITE}
var
  EncryptDataType: word;
{$ENDIF}
begin
  if Value = GetObject then
    Exit;

  FreeBuffer;

{$IFNDEF LITE}
  if Assigned(FEncryptor) then begin
    case FDataType of
      dtOraBlob:
        EncryptDataType := dtBlob;
      dtOraClob:
        EncryptDataType := dtMemo;
      dtWideOraClob:
        EncryptDataType := dtWideMemo;
      else
        EncryptDataType := FDataType;
    end;

    Value := EncryptObject(EncryptDataType, Value);
  end;
{$ENDIF}

{$IFDEF VER6P}
  FData := Value.ToVariant;
{$ELSE}
  TVarData(FData).VType := varSharedObject;
  TVarData(FData).VPointer := Value;
{$ENDIF}

  if Value <> nil then begin
    Value.AddRef;
    case FDataType of
      dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ{$IFDEF VER6P}{$IFNDEF FPC}, dtSQLTimeStamp{$ENDIF}{$ENDIF}:
        FIndicator := TOraTimeStamp(Value).FIndicator;
      dtIntervalYM, dtIntervalDS:
        FIndicator := TOraInterval(Value).FIndicator;
      dtNumber, dtBCD{$IFDEF VER6P}, dtLargeint{$IFNDEF FPC}, dtFMTBCD{$ENDIF}{$ENDIF}:
        FIndicator := TOraNumber(Value).FIndicator;
    end;
  end;

  FBufferAllocated := True;
end;

function TOraParamDesc.GetAsBlobRef: TBlob;
begin
  Result := TBlob({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF});
end;

function TOraParamDesc.GetAsCursor: TOraCursor;
begin
  Result := TOraCursor({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF});
end;

function TOraParamDesc.GetAsOraBlob: TOraLob;
begin
  Result := TOraLob({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF});
end;

function TOraParamDesc.GetAsBFile: TOraFile;
begin
  Result := TOraFile({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF});
end;

function TOraParamDesc.GetAsTimeStamp: TOraTimeStamp;
begin
  Result := TOraTimeStamp({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF});
end;

function TOraParamDesc.GetAsInterval: TOraInterval;
begin
  Result := TOraInterval({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF});
end;

function TOraParamDesc.GetAsNumber: TOraNumber;
begin
  Result := TOraNumber({$IFDEF CLR}FData{$ELSE}TVarData(FData).VPointer{$ENDIF});
end;

function TOraParamDesc.GetNull: boolean;
begin
  Result := GetItemNull(1);
end;

procedure TOraParamDesc.SetNull(const Value: boolean);
begin
  SetItemNull(1, Value);
end;

function TOraParamDesc.GetItemNull(Index: integer): boolean;
begin
  Result := GetIndicator(Index) < 0;
end;

procedure TOraParamDesc.SetItemNull(Index: integer; Value: boolean);
var
  VPtr: IntPtr;
  Obj: TSharedObject;
begin
  AllocBuffer;

  if Value then begin
    SetIndicator(Index, -1);
    case FDataType of
      dtString, dtFixedChar:
        Marshal.WriteByte(FValue, (Index - 1) * FValueSize, 0);
      dtWideString, dtFixedWideChar:
        Marshal.WriteInt16(FValue, (Index - 1) * FValueSize, 0);
      dtInteger:
        Marshal.WriteInt32(FValue, (Index - 1) * FValueSize, 0);
    {$IFDEF VER14P}
      dtSingle:
        Marshal.WriteInt32(FValue, (Index - 1) * FValueSize, 0);
    {$ENDIF}
      dtFloat:
        Marshal.WriteInt64(FValue, (Index - 1) * FValueSize, 0);
      dtDate, dtTime, dtDateTime: begin
        VPtr := PtrOffset(FValue, (Index - 1) * FValueSize);
        FillChar(VPtr, FValueSize, 0);
      end;
      dtBlob,dtMemo,dtWideMemo,dtOraBlob,dtOraClob: begin
        Obj := GetItemAsObject(Index);
        if Obj <> nil then
          TBlob(Obj).Clear;
      end;
      dtBytes, dtVarBytes:
        Marshal.WriteInt16(FValue, (Index - 1) * FValueSize, 0);
      dtObject,dtXML,dtReference,dtArray,dtTable: begin
        Obj := GetItemAsObject(Index);
        if Obj <> nil then
          TOraObject(Obj).IsNull := True;
      end;
    end;

    if FLength = 1 then
      Flen := 0;
  end
  else
    SetIndicator(Index, 0);
end;

{$IFDEF MSWINDOWS}
{ TCustomNotifyChanges }

constructor TCustomNotifyChanges.Create(AOCISvcCtx: TOCISvcCtx; AOCIColl: pOCIColl);
var
  Count, i, Exists: integer;
  Ind, Elem: IntPtr;
begin
  inherited Create;

  FOCISvcCtx := AOCISvcCtx;

  FOCISvcCtx.OCI8.Check(FOCISvcCtx.OCI8.OCICollSize(FOCISvcCtx.hOCIEnv, FOCISvcCtx.hOCIError, AOCIColl, Count), FOCISvcCtx);

  SetLength(FItems, Count);

  for i := 0 to Count - 1 do begin
    FOCISvcCtx.OCI8.Check(FOCISvcCtx.OCI8.OCICollGetElem(FOCISvcCtx.hOCIEnv, FOCISvcCtx.hOCIError, AOCIColl, i, Exists, Elem, Ind), FOCISvcCtx);

    FItems[i] := CreateItem(Marshal.ReadIntPtr(Elem));
  end;
end;

destructor TCustomNotifyChanges.Destroy;
var
  i: integer;
begin
  for i := 0 to Length(FItems) - 1 do
    FItems[i].Free;

  inherited Destroy;
end;

function TCustomNotifyChanges.GetCount: integer;
begin
  Result := Length(FItems);
end;

{ TNotifyRowChange }

constructor TNotifyRowChange.Create(AOCISvcCtx: TOCISvcCtx; AChangeDescriptor: IntPtr);
var
  Len, Flags: integer;
  Ptr, ValuePtr, StrPtr: IntPtr;
begin
  inherited Create;

  StrPtr := nil;
  ValuePtr := OrdinalToPtr(StrPtr);
  try
    Ptr := OrdinalToPtr(Len);
    try
      AOCISvcCtx.OCI8.Check(AOCISvcCtx.OCI8.OCIAttrGet1(AChangeDescriptor, OCI_DTYPE_ROW_CHDES, ValuePtr, Ptr,
        OCI_ATTR_CHDES_ROW_ROWID, AOCISvcCtx.hOCIError), AOCISvcCtx);
    finally
      PtrToOrdinal(Ptr, Len);
    end;
  finally
    PtrToOrdinal(ValuePtr, StrPtr);
  end;
  FRowId := PtrToStringOCI(StrPtr, Len, AOCISvcCtx.UnicodeEnv);

  AOCISvcCtx.OCI8.Check(AOCISvcCtx.OCI8.OCIAttrGet2(AChangeDescriptor, OCI_DTYPE_ROW_CHDES, Flags, nil,
    OCI_ATTR_CHDES_ROW_OPFLAGS, AOCISvcCtx.hOCIError), AOCISvcCtx);

  FOperations := [];
  if Flags and OCI_OPCODE_INSERT <> 0 then
    Include(FOperations, cnoInsert);
  if Flags and OCI_OPCODE_UPDATE <> 0 then
    Include(FOperations, cnoUpdate);
  if Flags and OCI_OPCODE_DELETE <> 0 then
    Include(FOperations, cnoDelete);
end;

{ TNotifyRowChanges }

function TNotifyRowChanges.CreateItem(ChangeDescriptor: IntPtr): TObject;
begin
  Result := TNotifyRowChange.Create(FOCISvcCtx, ChangeDescriptor);
end;

function TNotifyRowChanges.GetChanges(Index: integer): TNotifyRowChange;
begin
  Result := TNotifyRowChange(FItems[Index]);
end;

{ TNotifyTableChange }

constructor TNotifyTableChange.Create(AOCISvcCtx: TOCISvcCtx; AChangeDescriptor: IntPtr);
var
  Len, Flags, OCIRowChanges: integer;
  Ptr, ValuePtr, StrPtr: IntPtr;
begin
  inherited Create;

  StrPtr := nil;
  ValuePtr := OrdinalToPtr(StrPtr);
  try
    Ptr := OrdinalToPtr(Len);
    try
      AOCISvcCtx.OCI8.Check(AOCISvcCtx.OCI8.OCIAttrGet1(AChangeDescriptor, OCI_DTYPE_TABLE_CHDES, ValuePtr, Ptr,
        OCI_ATTR_CHDES_TABLE_NAME, AOCISvcCtx.hOCIError), AOCISvcCtx);
    finally
      PtrToOrdinal(Ptr, Len);
    end;
  finally
    PtrToOrdinal(ValuePtr, StrPtr);
  end;
  FTableName := PtrToStringOCI(StrPtr, Len, AOCISvcCtx.UnicodeEnv);

  AOCISvcCtx.OCI8.Check(AOCISvcCtx.OCI8.OCIAttrGet2(AChangeDescriptor, OCI_DTYPE_TABLE_CHDES, Flags, nil,
    OCI_ATTR_CHDES_TABLE_OPFLAGS, AOCISvcCtx.hOCIError), AOCISvcCtx);

  FOperations := [];
  if Flags and OCI_OPCODE_INSERT <> 0 then
    Include(FOperations, cnoInsert);
  if Flags and OCI_OPCODE_UPDATE <> 0 then
    Include(FOperations, cnoUpdate);
  if Flags and OCI_OPCODE_DELETE <> 0 then
    Include(FOperations, cnoDelete);
  if Flags and OCI_OPCODE_ALLROWS <> 0 then
    Include(FOperations, cnoAllRows);
  if Flags and OCI_OPCODE_ALTER <> 0 then
    Include(FOperations, cnoAlter);
  if Flags and OCI_OPCODE_DROP <> 0 then
    Include(FOperations, cnoDrop);

  if not (cnoAllRows in FOperations) then begin
    AOCISvcCtx.OCI8.Check(AOCISvcCtx.OCI8.OCIAttrGet2(AChangeDescriptor, OCI_DTYPE_TABLE_CHDES, OCIRowChanges, nil,
      OCI_ATTR_CHDES_TABLE_ROW_CHANGES, AOCISvcCtx.hOCIError), AOCISvcCtx);

    FRowChanges := TNotifyRowChanges.Create(AOCISvcCtx, pOCIColl(OCIRowChanges));
  end
  else
    FRowChanges := nil;
end;

destructor TNotifyTableChange.Destroy;
begin
  FRowChanges.Free;

  inherited Destroy;
end;

{ TNotifyTableChanges }

function TNotifyTableChanges.CreateItem(ChangeDescriptor: IntPtr): TObject;
begin
  Result := TNotifyTableChange.Create(FOCISvcCtx, ChangeDescriptor);
end;

function TNotifyTableChanges.GetChanges(Index: integer): TNotifyTableChange;
begin
  Result := TNotifyTableChange(FItems[Index]);
end;

{ TNotifyChange }

constructor TNotifyChange.Create(AOCISvcCtx: TOCISvcCtx; AChangeDescriptor: IntPtr);
var
  OCINotifyType, OCITableChanges: integer;
begin
  inherited Create;

  // Get the Notification Type
  AOCISvcCtx.OCI8.Check(AOCISvcCtx.OCI8.OCIAttrGet2(AChangeDescriptor, OCI_DTYPE_CHDES, OCINotifyType, nil,
    OCI_ATTR_CHDES_NFYTYPE, AOCISvcCtx.hOCIError), AOCISvcCtx);
  case OCINotifyType of
    OCI_EVENT_NONE:
      FNotifyType := cneNone;
    OCI_EVENT_STARTUP:
      FNotifyType := cneStartup;
    OCI_EVENT_SHUTDOWN:
      FNotifyType := cneShutdown;
    OCI_EVENT_SHUTDOWN_ANY:
      FNotifyType := cneShutdownAny;
    OCI_EVENT_DROP_DB:
      FNotifyType := cneDropDB;
    OCI_EVENT_DEREG:
      FNotifyType := cneDereg;
    OCI_EVENT_OBJCHANGE:
      FNotifyType := cneObjChange;
    OCI_EVENT_QUERYCHANGE:
      FNotifyType := cneObjChange;
  else
    Assert(False);
    FNotifyType := cneNone;
  end;

  if OCINotifyType in [OCI_EVENT_OBJCHANGE, OCI_EVENT_QUERYCHANGE] then begin
    AOCISvcCtx.OCI8.Check(AOCISvcCtx.OCI8.OCIAttrGet2(AChangeDescriptor, OCI_DTYPE_CHDES, OCITableChanges, nil,
      OCI_ATTR_CHDES_TABLE_CHANGES, AOCISvcCtx.hOCIError), AOCISvcCtx);

    FTableChanges := TNotifyTableChanges.Create(AOCISvcCtx, pOCIColl(OCITableChanges));
  end
  else
    FTableChanges := nil;
end;

destructor TNotifyChange.Destroy;
begin
  FTableChanges.Free;

  inherited Destroy;
end;

{ TOCIChangeNotification }

constructor TOCIChangeNotification.Create;
begin
  inherited Create;

  FOCISvcCtx := nil;
  FEnabled := True;
  FQueryResultOnly := False;
  FOperations := [cnoInsert, cnoUpdate, cnoDelete];
end;

destructor TOCIChangeNotification.Destroy;
begin
  if FGCHandle <> nil then
    FreeGCHandle(FGCHandle);

  inherited;
end;

function TOCIChangeNotification.GetGCHandle: IntPtr;
begin
  if FGCHandle = nil then
    FGCHandle := AllocGCHandle(Self);
  Result := FGCHandle;
end;

function TOCIChangeNotification.GetOCI8: TOCI8API;
begin
  Result := FOCISvcCtx.OCI8
end;

procedure TOCIChangeNotification.SetOCISvcCtx(Value: TOCISvcCtx);
begin
  if FOCISvcCtx <> Value then begin
    ReleaseOCISvcCtx;

    FOCISvcCtx := Value;
    if FOCISvcCtx <> nil then
      FOCISvcCtx.AddRef;
  end;
end;

procedure TOCIChangeNotification.ReleaseOCISvcCtx;
begin
  if FOCISvcCtx <> nil then begin
    FOCISvcCtx.ReleaseRef;
    FOCISvcCtx := nil;
  end;
end;

procedure TOCIChangeNotification.Register(Connection: TOCIConnection);
var
  hOCISubscr: pOCISubscription;
  AttrValue: integer;
begin
  SetOCISvcCtx(Connection.OCISvcCtx);
  try
  {$IFDEF NET}
    if OCISvcCtx.Home.Direct then
      RaiseError(SChangeNotifyNotSupportedWithDirect);
  {$ENDIF}

    if OCISvcCtx.Home.OCIVersion < 10200 then
      RaiseError(SChangeNotifyOCIVersion);

    if Connection.GetOracleVersion < 10200 then
      RaiseError(SChangeNotifyServerVersion);

    OCI8.Check(OCI8.OCIHandleAlloc(OCISvcCtx.hOCIEnv, hOCISubscr, OCI_HTYPE_SUBSCRIPTION, 0, nil), FOCISvcCtx);
    try
      AttrValue := OCI_SUBSCR_NAMESPACE_DBCHANGE;
      Connection.OCI8.Check(OCI8.OCIAttrSet2(hOCISubscr, OCI_HTYPE_SUBSCRIPTION, AttrValue, SizeOf(ub4),
        OCI_ATTR_SUBSCR_NAMESPACE, OCISvcCtx.hOCIError), FOCISvcCtx);

      Connection.OCI8.Check(OCI8.OCIAttrSet1(hOCISubscr, OCI_HTYPE_SUBSCRIPTION, OCICallbackChangeNotifyPtr,  0,
        OCI_ATTR_SUBSCR_CALLBACK, OCISvcCtx.hOCIError), FOCISvcCtx);

      AttrValue := 1;
      Connection.OCI8.Check(OCI8.OCIAttrSet2(hOCISubscr, OCI_HTYPE_SUBSCRIPTION, AttrValue, SizeOf(ub4),
        OCI_ATTR_CHNF_ROWIDS, OCISvcCtx.hOCIError), FOCISvcCtx);

      if FOperations = [] then
        raise Exception.Create(SChangeNotifyOperationsCannotBeEmpty);
      AttrValue := 0;
      if FOperations <> [cnoInsert, cnoUpdate, cnoDelete] then begin // default
        if cnoInsert in FOperations then
          AttrValue := OCI_OPCODE_INSERT;
        if cnoUpdate in FOperations then
          AttrValue := AttrValue or OCI_OPCODE_UPDATE;
        if cnoUpdate in FOperations then
          AttrValue := AttrValue or OCI_OPCODE_DELETE;
      end;
      OCI8.Check(OCI8.OCIAttrSet2(hOCISubscr, OCI_HTYPE_SUBSCRIPTION, AttrValue, 0,
        OCI_ATTR_CHNF_OPERATIONS, OCISvcCtx.hOCIError), FOCISvcCtx);

      OCI8.Check(OCI8.OCIAttrSet1(hOCISubscr, OCI_HTYPE_SUBSCRIPTION, GCHandle, 0,
        OCI_ATTR_SUBSCR_CTX, FOCISvcCtx.hOCIError), FOCISvcCtx);

      OCI8.Check(OCI8.OCIAttrSet2(hOCISubscr, OCI_HTYPE_SUBSCRIPTION, FTimeout, 0,
        OCI_ATTR_SUBSCR_TIMEOUT, OCISvcCtx.hOCIError), FOCISvcCtx);

      if FQueryResultOnly then
        AttrValue := OCI_SUBSCR_CQ_QOS_QUERY
      else
        AttrValue := 0;
      OCI8.Check(OCI8.OCIAttrSet2(hOCISubscr, OCI_HTYPE_SUBSCRIPTION, AttrValue, 0,
        OCI_ATTR_SUBSCR_CQ_QOSFLAGS, OCISvcCtx.hOCIError), FOCISvcCtx);

      if FPersistent then
        AttrValue := OCI_SUBSCR_QOS_RELIABLE
      else
        AttrValue := 0;
      OCI8.Check(OCI8.OCIAttrSet2(hOCISubscr, OCI_HTYPE_SUBSCRIPTION, AttrValue, 0,
        OCI_ATTR_SUBSCR_QOSFLAGS, OCISvcCtx.hOCIError), FOCISvcCtx);

      if hODACWindow = 0 then
        AllocODACWnd;

      OCI8.Check(OCI8.OCISubscriptionRegister(OCISvcCtx.hOCISvcCtx, hOCISubscr, 1,
        OCISvcCtx.hOCIError, OCI_DEFAULT), FOCISvcCtx);
    except
      OCI8.OCIHandleFree(hOCISubscr, OCI_HTYPE_SUBSCRIPTION);
      raise;
    end;

    hOCISubscription := hOCISubscr;
  except
    ReleaseOCISvcCtx;
    raise;
  end;
end;

procedure TOCIChangeNotification.Unregister(Connection: TOCIConnection);
begin
  if hOCISubscription <> nil then
  try
    Connection.OCI8.OCISubscriptionUnRegister(OCISvcCtx.hOCISvcCtx, hOCISubscription,
      OCISvcCtx.hOCIError, OCI_DEFAULT);

    Connection.OCI8.OCIHandleFree(hOCISubscription, OCI_HTYPE_SUBSCRIPTION);

    hOCISubscription := nil;
  finally
    ReleaseOCISvcCtx;
  end;
end;

function TOCIChangeNotification.GetSubscriptionHandle(Connection: TOCIConnection): pOCISubscription;
begin
  if hOCISubscription = nil then
    Register(Connection);
  Result := hOCISubscription;
end;

function TOCIChangeNotification.IsActive: boolean;
begin
  Result := hOCISubscription <> nil;
end;

procedure TOCIChangeNotification.SetEnabled(Value: boolean);
begin
  if hOCISubscription <> nil then begin
    if FEnabled and not Value then
      OCI8.Check(OCI8.OCISubscriptionDisable(hOCISubscription, OCISvcCtx.hOCIError, OCI_DEFAULT), FOCISvcCtx);
    if not FEnabled and Value then
      OCI8.Check(OCI8.OCISubscriptionEnable(hOCISubscription, OCISvcCtx.hOCIError, OCI_DEFAULT), FOCISvcCtx);
  end;
  FEnabled := Value;
end;

function OCICallbackChangeNotify(pCtx: IntPtr; pSubscrHp: pOCISubscription;
  pPayload: IntPtr; iPayloadLen: ub4; pDescriptor: IntPtr; iMode: ub4): sword;{$IFNDEF CLR} cdecl; {$ENDIF}
begin
  Result := TOCIChangeNotification(GetGCHandleTarget(pCtx)).CallbackChangeNotify(pCtx,
    pSubscrHp, pPayload, iPayloadLen, pDescriptor, iMode);
end;

function TOCIChangeNotification.CallbackChangeNotify(pCtx: IntPtr; pSubscrHp: pOCISubscription;
  pPayload: IntPtr; iPayloadLen: ub4; pDescriptor: IntPtr; iMode: ub4): sword;
var
  NotifyChange: TNotifyChange;
begin
  NotifyChange := TNotifyChange.Create(FOCISvcCtx, pDescriptor);

  if NotifyChange.NotifyType = cneDereg then begin
    OCI8.OCIHandleFree(hOCISubscription, OCI_HTYPE_SUBSCRIPTION);
    hOCISubscription := nil;
  end;

  if Assigned(FOnChange) then
    PostMessage(hODACWindow, WM_CHANGENOTIFY, WPARAM(GCHandle),
      LPARAM(AllocGCHandle(NotifyChange)));

  Result := OCI_SUCCESS;
end;

function TOCIChangeNotification.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prEnabled:
      SetEnabled(Boolean(Value));
    prTimeout:
      FTimeout := Value;
    prPersistent:
      FPersistent := Boolean(Value);
    prQueryResultOnly:
      FQueryResultOnly := Boolean(Value);
    prOperations:
      FOperations := TChangeNotifyDMLOperations(Byte(Value));
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

function TOCIChangeNotification.GetProp(Prop: integer; var Value: variant): boolean;
begin
  Assert(False, IntToStr(Prop));
  Result := False;
end;
{$ENDIF}

{ TOCICommand }

constructor TOCICommand.Create;
begin
  inherited Create;

  FOCICallStyle := None;
  FCursor := TOraCursor.Create;
  FCursorRef := FCursor;
  SetCursorState(csInactive);
  FAutoCommit := True;
  FSQLType := SQL_UNKNOWN;
  FIterCount := 1;
  FCacheLobs := True;
  FCheckParamHasDefault := True;

  FSmallintPrecision := -1;
  FIntegerPrecision := -1;
  FLargeIntPrecision := -1;
  FFloatPrecision := -1;
  FBCDPrecision := -1;
  FBCDScale := 0;
{$IFDEF VER6P}
{$IFNDEF FPC}
  FFmtBCDPrecision := -1;
  FFmtBCDScale := 0;
{$ENDIF}
{$ENDIF}
{$IFDEF FPC}
  FRawAsString := True;
{$ENDIF}

{$IFDEF MSWINDOWS}
  hBusy := CreateMutex(nil, False, '');
{$ENDIF}
{$IFDEF WIN32_64}
  hExecuted := TEvent.Create(nil, True, True, '');
{$ENDIF}
end;

destructor TOCICommand.Destroy;
begin
{$IFDEF MSWINDOWS}
  if hExecThread <> nil then begin
    if FConnection <> nil then
      FConnection.StopThread(hExecThread, True);
  end
  else
{$ENDIF}
    if GetCursorState > csInactive then
      Close;

{$IFDEF MSWINDOWS}
  CloseHandle(hBusy);
{$ENDIF}
{$IFDEF WIN32_64}
  hExecuted.Free;
{$ENDIF}

  Assert(FCursorRef <> nil);

  if (FCursorRef <> FCursor) then
    FCursorRef.Free;

  FCursor.Free;

  if FGCHandle <> nil then
    FreeGCHandle(FGCHandle);

  inherited;
end;

procedure TOCICommand.RaiseError(const Msg: string);
begin
  raise Exception.Create(Msg);
end;

procedure TOCICommand.AllocOCISvcCtx;
begin
  if FOCISvcCtx <> FConnection.OCISvcCtx then begin
    ReleaseOCISvcCtx;

    FOCISvcCtx := FConnection.OCISvcCtx;
  {$IFNDEF AUTOREFCOUNT}
    if FOCISvcCtx <> nil then
      FOCISvcCtx.AddRef;
  {$ENDIF}
  end;
end;

procedure TOCICommand.ReleaseOCISvcCtx;
begin
  if FOCISvcCtx <> nil then begin
  {$IFNDEF AUTOREFCOUNT}
    FOCISvcCtx.ReleaseRef;
  {$ENDIF}
    FOCISvcCtx := nil;
  end;
end;

procedure TOCICommand.CheckOCI;
begin
  if not ((FOCICallStyle = OCI73) or (FOCICallStyle = OCI80)) then
    RaiseError(SCheckOCI);
end;

procedure TOCICommand.CheckOCI73;
begin
  if not (FOCICallStyle = OCI73) then
    RaiseError(SCheckOCI73);
end;

procedure TOCICommand.CheckOCI80;
begin
  if not (FOCICallStyle = OCI80) then
    RaiseError(SCheckOCI80);
end;

procedure TOCICommand.Check(Status: sword);
begin
  if Status <> OCI_SUCCESS then
    FConnection.OraError(FOCICallStyle, Status, not (FNonBlocking and (FExecuting
      or (GetCursorState in [csFetching, csFetchingAll]))), Component)
end;

procedure TOCICommand.CheckSession;
begin
  if FConnection = nil then
    RaiseError(SSessionNotDefined);
  if not FConnection.GetConnected then
    RaiseError(SSessionNotConnected);
end;

procedure TOCICommand.CheckActive;
begin
  if GetCursorState = csInactive then
    RaiseError(SCursorNotOpened);
end;

procedure TOCICommand.CheckInactive;
begin
  if GetCursorState <> csInactive then
    RaiseError(SCursorOpened);
end;

function TOCICommand.GetSmallintPrecision: integer;
begin
  if FSmallintPrecision <> -1 then
    Result := FSmallintPrecision
  else
    Result := FConnection.FSmallintPrecision;
end;

function TOCICommand.GetIntegerPrecision: integer;
begin
  if FIntegerPrecision <> -1 then
    Result := FIntegerPrecision
  else
    Result := FConnection.FIntegerPrecision;
end;

function TOCICommand.GetLargeintPrecision: integer;
const
  DefaultLargeIntPrecision = 18;
begin
  if FLargeintPrecision <> -1 then
    Result := FLargeintPrecision
  else
    Result := FConnection.FLargeintPrecision;

  if (Result = 0) and FConnection.FEnableLargeint then
    Result := DefaultLargeIntPrecision;
end;

function TOCICommand.GetFloatPrecision: integer;
begin
  if FFloatPrecision <> -1 then
    Result := FFloatPrecision
  else
    Result := FConnection.FFloatPrecision;
end;

function TOCICommand.GetBCDPrecision: integer;
begin
  if FBCDPrecision <> -1 then
    Result := FBCDPrecision
  else
    Result := FConnection.FBCDPrecision;
end;

function TOCICommand.GetBCDScale: integer;
begin
  if FBCDPrecision <> -1 then
    Result := FBCDScale
  else
    Result := FConnection.FBCDScale;
end;

{$IFDEF VER6P}
{$IFNDEF FPC}
function TOCICommand.GetFmtBCDPrecision: integer;
begin
  if FFmtBCDPrecision <> -1 then
    Result := FFmtBCDPrecision
  else
    Result := FConnection.FFmtBCDPrecision;
end;

function TOCICommand.GetFmtBCDScale: integer;
begin
  if FFmtBCDPrecision <> -1 then
    Result := FFmtBCDScale
  else
    Result := FConnection.FFmtBCDScale;
end;
{$ENDIF}
{$ENDIF}

function TOCICommand.GetOraType7(DataType: integer; SubDataType: integer): integer;
var
  OraType: integer;
begin
  case DataType of
    dtBoolean:
      OraType := SQLT_INT;
    dtString, dtWideString:
      if SubDataType in [dtFixedChar, dtFixedWideChar] then
        OraType := CHAR_TYPE
      else
        OraType := STRING_TYPE;  // return with terminator
    dtInteger:
      OraType := INTEGER_TYPE;
    dtFloat:
      OraType := FLOAT_TYPE;
    dtDateTime:
      OraType := DATE_TYPE;
    dtFixedChar, dtFixedWideChar:
      OraType := CHAR_TYPE;
    dtMemo:
      if SubDataType in [dtString, dtWideString] then
        OraType := STRING_TYPE  // return with terminator
      else if SubDataType in [dtFixedChar, dtFixedWideChar] then
        OraType := CHAR_TYPE
      else
        OraType := LONG_TYPE;
    dtBlob:
      OraType := LONGRAW_TYPE;
    dtRowId:
      OraType := ROWID_TYPE;
    dtCursor:
      OraType := CURSOR_TYPE;
    dtExtString, dtExtWideString:
      if SubDataType in [dtFixedChar, dtFixedWideChar] then
        OraType := CHAR_TYPE
      else
        OraType := STRING_TYPE;
    dtVarBytes, dtExtVarBytes:
      OraType := RAW_TYPE;
    dtLabel:
      OraType := SQLT_OSL;
  else
    RaiseError(SDataTypeNotSupported);
    OraType := 0;
  end;
  Result := OraType;
end;

function TOCICommand.GetInternalType8(OraType: Integer; IsNational: boolean): Integer;
begin
  case OraType of
    SQLT_STR, SQLT_CHR, SQLT_AVC:
      if IsNational then
        Result := dtNString
      else
        Result := dtString;
    SQLT_AFC:
      if IsNational then
        Result := dtFixedNChar
      else
        Result := dtFixedChar;
    SQLT_NUM:
      Result := dtNumber;
    SQLT_DAT:
      Result := dtDateTime;
    SQLT_RID:
      Result := dtRowId;
    SQLT_RDD:
      Result := dtURowId;
    SQLT_BIN:
      Result := dtVarBytes;
    SQLT_LNG:
      Result := dtMemo;
    SQLT_LBI:
      Result := dtBlob;
    SQLT_CLOB:
      if IsNational then
        Result := dtNClob
      else
        Result := dtOraClob;
    SQLT_BLOB:
      Result := dtOraBlob;
    SQLT_BFILEE:
      Result := dtBFILE;
    SQLT_CFILEE:
      Result := dtCFILE;
    SQLT_RSET:
      Result := dtCursor;
    SQLT_NTY:
      Result := dtXML;
    SQLT_REF:
      Result := dtReference;
    SQLT_OSL:
      Result := dtLabel;
    SQLT_TIMESTAMP:
      Result := dtTimeStamp;
    SQLT_TIMESTAMP_TZ:
      Result := dtTimeStampTZ;
    SQLT_TIMESTAMP_LTZ:
      Result := dtTimeStampLTZ;
    SQLT_INTERVAL_YM:
      Result := dtIntervalYM;
    SQLT_INTERVAL_DS:
      Result := dtIntervalDS;
    SQLT_IBFLOAT:
      Result := dtBFloat;
    SQLT_IBDOUBLE:
      Result := dtBDouble;
    SQLT_UND:
      Result := dtUndefined;
    else
      Result := dtUnknown;
  end;
end;

function TOCICommand.GetOraType8(DataType: integer; SubDataType: integer): integer;
var
  OraType: integer;
begin
  case DataType of
    dtString, dtExtString:
      if SubDataType in [dtFixedChar, dtFixedNChar] then
        OraType := SQLT_AFC
      else
        OraType := SQLT_STR;
    dtWideString, dtExtWideString:
      if SubDataType in [dtFixedWideChar, dtFixedNWideChar] then
        OraType := SQLT_AFC
      else
        OraType := SQLT_STR;
    dtInt8, dtUInt8, dtInt16, dtWord ,dtInteger, dtUInt32:
      OraType := SQLT_INT;
    dtFloat, dtCurrency:
      if (OCISvcCtx.Home.OCIVersion >= 10000) and (FConnection.GetOracleVersion >= 10000) then
        if (SubDataType = dtBFloat) or (SubDataType = dtBDouble) then
          OraType := SQLT_BDOUBLE
        else
          OraType := SQLT_FLT
      else
        OraType := SQLT_FLT;
  {$IFDEF VER14P}
    dtSingle:
      if (OCISvcCtx.Home.OCIVersion >= 10000) and (FConnection.GetOracleVersion >= 10000) then
        OraType := SQLT_BFLOAT
      else
        OraType := SQLT_FLT;
  {$ENDIF}
    dtDateTime, dtDate, dtTime:
      OraType := SQLT_DAT;
    dtFixedChar, dtFixedNChar, dtFixedWideChar, dtFixedNWideChar:
      OraType := SQLT_AFC;
    dtMemo, dtWideMemo:
      if SubDataType in [dtString, dtNString, dtWideString, dtNWideString] then
        OraType := SQLT_STR  // return with terminator
      else if SubDataType in [dtFixedChar, dtFixedNChar, dtFixedWideChar, dtFixedNWideChar] then
        OraType := SQLT_AFC
      else
        OraType := SQLT_LNG;
    dtBytes, dtVarBytes, dtExtVarBytes:
      OraType := SQLT_BIN;
    dtBlob:
      OraType := SQLT_LBI;
    dtOraBlob:
      OraType := SQLT_BLOB;
    dtOraClob, dtWideOraClob:
      OraType := SQLT_CLOB;
    dtBFILE:
      OraType := SQLT_BFILE;
    dtCFILE:
      OraType := SQLT_CFILE;
    dtRowId:
      OraType := SQLT_RDD;
    dtCursor:
      OraType := SQLT_RSET;
    dtObject:
      OraType := SQLT_NTY;
    dtXML: begin
      if OCISvcCtx.Home.OCIVersion < 9200 then
        RaiseError(SDataTypeNotSupported);
      OraType := SQLT_NTY;
    end;
    dtReference:
      OraType := SQLT_REF;
    dtArray:
      OraType := SQLT_NTY;
    dtTable:
      OraType := SQLT_NTY;
    dtBoolean:
      OraType := SQLT_INT;
    dtLabel:
      OraType := SQLT_OSL;
    dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ{$IFDEF VER6P}{$IFNDEF FPC}, dtSQLTimeStamp{$ENDIF}{$ENDIF},
    dtIntervalYM, dtIntervalDS: begin
      if OCISvcCtx.Home.OCIVersion < 9000 then
        RaiseError(SDataTypeNotSupported);
      OraType := 0; // anti warning
      case DataType of
        dtTimeStamp{$IFDEF VER6P}{$IFNDEF FPC}, dtSQLTimeStamp{$ENDIF}{$ENDIF}:
          OraType := SQLT_TIMESTAMP;
        dtTimeStampTZ:
          OraType := SQLT_TIMESTAMP_TZ;
        dtTimeStampLTZ:
          OraType := SQLT_TIMESTAMP;
        dtIntervalYM:
          OraType := SQLT_INTERVAL_YM;
        dtIntervalDS:
          OraType := SQLT_INTERVAL_DS;
      end;
    end;
    dtUndefined:
      OraType := SQLT_CHR;
    dtNumber, dtLargeint, dtBCD{$IFDEF VER6P}{$IFNDEF FPC}, dtFMTBCD{$ENDIF}{$ENDIF}: begin
      OraType := SQLT_VNU;
    end;
  else
    RaiseError(SDataTypeNotSupported);
    OraType := 0;
  end;
  Result := OraType;
end;

function TOCICommand.GetOraType(DataType: integer; SubDataType: integer): integer;
begin
  if FOCICallStyle = OCI73 then begin
    Result := GetOraType7(DataType, SubDataType);
  end
  else
  if FOCICallStyle = OCI80 then begin
    Result := GetOraType8(DataType, SubDataType);
  end
  else begin
    Result := 0;
    CheckOCI;
  end;
end;

procedure TOCICommand.InternalOpen;
var
  Res: sword;
begin
  CheckOCI73;
  CheckSession;
  AllocOCISvcCtx;

  Busy;
  try // For Busy
    FConnection.BusyWait;
      Res := OCI7.oopen(FCursorRef.CDA, FConnection.GetLDA, nil, -1, -1, nil, -1);
    FConnection.Release;

    Check(Res);

    SetCursorState(csOpen);
  finally
    Release;
  end;
end;

function TOCICommand.GetGCHandle: IntPtr;
begin
  if FGCHandle = nil then
    FGCHandle := AllocGCHandle(Self);
  Result := FGCHandle;
end;

function TOCICommand.GetOCI7: TOCI7API;
begin
  Result := OCISvcCtx.OCI7;
end;

function TOCICommand.GetOCI8: TOCI8API;
begin
  Result := OCISvcCtx.OCI8;
end;

/// RemoveCRSymbols is used to remove #13 symbol from string. It is needed for
/// pl/sql code to be executed without runtime errors. If ErrorOffset <> -1 is
/// Result may contain invalid value but ErrorOffset is recalculated to
/// reflect error correctly.
function TOCICommand.RemoveCRSymbols(SQLText: string;
  var ErrorOffset: integer): string;
const
  WrappedConstL: string = 'wrapped';
  WrappedConstU: string = 'WRAPPED';
var
  i, j, starti, Len: integer;
  InlineComment: boolean;
  NestedComment: boolean;
  StringLiteral: boolean;
  AlternativeQuoting: boolean;
  QuoteDelimiter: Char;

  IsWrapped: boolean;
  WrappedIndex: integer;
begin
  Result := '';

  if SQLText = '' then
    Exit;

  Len := Length(SQLText);
  Result := '';
  j := 1;
  i := 1;
  starti := 1;
  IsWrapped := False;
  WrappedIndex := 1;
  InlineComment := False;
  NestedComment := False;
  StringLiteral := False;
  AlternativeQuoting := False;
  QuoteDelimiter := #0;

  while i < Len do begin
    if (ErrorOffset <> -1) and (ErrorOffset = j - 1) then begin
      ErrorOffset := i - 1;
      Exit;
    end;
    case SQLText[i] of
      #13:
        if not StringLiteral or RemoveCRInStringLiterals then begin
          Result := Result + Copy(SQLText, starti, i - starti) + #10;
          if SQLText[i + 1] = #10 then
            starti := i + 2
          else begin
            starti := i + 1;
            j := j + 1;
          end;
          i := i + 1;
          Continue;
        end;
      #10:
        InlineComment := False;
      '-':
        if not (NestedComment or StringLiteral) and (SQLText[i + 1] = '-') then
          InlineComment := True;
      '/':
        if not (InlineComment or StringLiteral) and (SQLText[i + 1] = '*') then
          NestedComment := True;
      '''': begin
        // to avoid bug if comment contains single apostrophe
        if not (InlineComment or NestedComment or IsWrapped) then begin
          if not StringLiteral then begin
            if (i > 1) and ((SQLText[i - 1] = 'q') or (SQLText[i - 1] = 'Q')) then begin
              AlternativeQuoting := True;
              QuoteDelimiter := SQLText[i + 1];
              case QuoteDelimiter of
                '[': QuoteDelimiter := ']';
                '{': QuoteDelimiter := '}';
                '<': QuoteDelimiter := '>';
                '(': QuoteDelimiter := ')';
              end;
              j := j + 1;
              i := i + 1;
            end
            else
              AlternativeQuoting := False;
            StringLiteral := True;
          end
          else begin
            if AlternativeQuoting then begin
              if (i > 1) and (SQLText[i - 1] = QuoteDelimiter) then
                StringLiteral := False;
            end
            else
              StringLiteral := False;
          end;
        end;
      end;
      '*':
        if not (InlineComment or StringLiteral) and NestedComment
          and (SQLText[i + 1] = '/')
        then begin
          NestedComment := False;
        /// on case of such code as "select /*all fields*/* from dept"
          j := j + 1;
          i := i + 1;
        end;
    end;
    //to avoid bug with processing wrapped packages
    if not (IsWrapped or NestedComment or StringLiteral) then begin
      if ((SQLText[i] = WrappedConstU[WrappedIndex]) or (SQLText[i] = WrappedConstL[WrappedIndex]))
        and (i > 1) and ((WrappedIndex > 1) or (SQLText[i - 1] = #10) or (SQLText[i - 1] = ' ')
        or (SQLText[i - 1] = '/'))
      then
        inc(WrappedIndex)
      else
        WrappedIndex := 1;

      if (WrappedIndex = 8) then begin
        if (i < Len) and ((SQLText[i + 1] = #13) or (SQLText[i + 1] = #10)
          or (SQLText[i + 1] = ' ') or (SQLText[i + 1] = '/'))
        then
          IsWrapped := True;
        WrappedIndex := 1;
      end;
    end
    else
      WrappedIndex := 1;

    j := j + 1;
    i := i + 1;
  end;
  Result := Result + Copy(SQLText, starti, i - starti + 1);
  if (ErrorOffset <> -1) and (ErrorOffset = j - 1) then begin
    ErrorOffset := i - 1;
  end;
end;

procedure TOCICommand.InternalParse;
var
  Res: sword;
  SQLText: string;
begin
  CheckOCI73;
  CheckActive;

// for PL-SQL
  Res := -1;
  SQLText := RemoveCRSymbols(TrimRight(FSQL), Res);

  Busy;
  try   // For Busy
    FConnection.BusyWait;
      Res := OCI7.oparse(FCursorRef.CDA, PAnsiChar(AnsiString(SQLText)), Length(SQLText) + 1, //-1,
        OCI_PARSE_NODEFER, OCI_LANG_V7);  // DEFER ???
    FConnection.Release;

    // check for compilation errors
    if (Res = OCI_SUCCESS) and (FCursorRef.CDA.wrn and 33 = 33) then
      FConnection.FLastError := 24344;

    Check(Res);

    FSQLType := FCursorRef.CDA.ft;
    FLastSQLtype := FSQLType;

    SetCursorState(csParsed);
  finally
    FErrorOffset := FCursorRef.CDA.peo;
    Release;
  end;
end;

procedure TOCICommand.InternalPrepare;
var
  SQLText: string;
  Res: sword;
  StmtType: word;
  StmtTypeInt32: Integer;
  OCIStmt: pOCIStmt;
{$IFDEF MSWINDOWS}
  OCISubscr: pOCISubscription;
{$ENDIF}
  i, Size: integer;
  p: IntPtr;
begin
  CheckOCI80;
  CheckSession;
  AllocOCISvcCtx;

  for i := 0 to Params.Count - 1 do
    TOraParamDesc(Params[i]).ClearBindData;

// for PL-SQL
  Res := -1;
  SQLText := RemoveCRSymbols(TrimRight(FSQL), Res);
  if SQLText = '' then
    SQLText := ' ';

  if OCISvcCtx.UnicodeEnv and (OCISvcCtx.Home.OCIVersion >= 10200) and
    (OCISvcCtx.Home.OCIVersion < 11000) and (SQLText[Length(SQLText)] = 'n')
  then
    SQLText := SQLText + ' ';

  Busy;
  try   // For Busy
    FConnection.BusyWait;

    if FConnection.FStatementCache and FStatementCache then begin
      if OCISvcCtx.Home.PossibleOCICallStyles = [OCI80] then
        RaiseError(SStmtCacheNotSupportedWithDirect);
      p := StringToHGlobalOCI(SQLText, Size, OCISvcCtx.UnicodeEnv);
      Res := OCI8.OCIStmtPrepare2(OCISvcCtx.hOCISvcCtx, OCIStmt, OCISvcCtx.hOCIError, p, Size,
        nil, 0, OCI_NTV_SYNTAX, OCI_DEFAULT);
      FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
      FCursorRef.hOCIStmt := OCIStmt;
    end
    else begin
      p := StringToHGlobalOCI(SQLText, Size, OCISvcCtx.UnicodeEnv);
      Res := OCI8.OCIStmtPrepare(FCursorRef.OCIStmt, OCISvcCtx.hOCIError, p, Size, OCI_NTV_SYNTAX, OCI_DEFAULT);
      FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
    end;
    FConnection.Release;

    Check(Res);

    Check(OCI8.OCIAttrGet2(FCursorRef.OCIStmt, OCI_HTYPE_STMT, StmtTypeInt32, nil, OCI_ATTR_STMT_TYPE, OCISvcCtx.hOCIError));
    StmtType := Word(StmtTypeInt32);

    case StmtType of
      OCI_STMT_SELECT:
        FSQLType := SQL_SELECT;
      OCI_STMT_UPDATE:
        FSQLType := SQL_UPDATE;
      OCI_STMT_DELETE:
        FSQLType := SQL_DELETE;
      OCI_STMT_INSERT:
        FSQLType := SQL_INSERT;
      OCI_STMT_BEGIN, OCI_STMT_DECLARE:
        FSQLType := SQL_PLSQL;
      14,15: // explain 805 - 14, 816 - 15
        FSQLType:= SQL_EXPLAIN;
    else
      FSQLType := SQL_UNKNOWN;
    end;
    FLastSQLType := FSQLType;

  {$IFDEF MSWINDOWS}
    if (FChangeNotification <> nil) and (FChangeNotification.FEnabled) then begin
      OCISubscr := FChangeNotification.GetSubscriptionHandle(FConnection);

      Check(OCI8.OCIAttrSet1(FCursorRef.OCIStmt, OCI_HTYPE_STMT, OCISubscr, 0,
        OCI_ATTR_CHNF_REGHANDLE, OCISvcCtx.hOCIError));
    end;
  {$ENDIF}

    SetCursorState(csPrepared);
  finally
    Release;
  end;
end;

procedure TOCICommand.Prepare;
begin
  CheckSession;
  if GetCursorState <> csInactive then
    Exit;
//  CheckInactive;

  AllocOCISvcCtx;

  FOCICallStyle := FConnection.OCICallStyleCommand; // see InitProcParams and SetCursor too
  FCursorRef.Init(OCISvcCtx, OCICallStyle);

  FRowsProcessed := 0;
  FErrorOffset := 0;

  FCursorRef.AllocCursor(FConnection.FStatementCache);
  try
    if FOCICallStyle = OCI73 then begin
      InternalOpen;
      try
        InternalParse;
      except
        InternalClose;
        raise;
      end;
    end
    else
    if FOCICallStyle = OCI80 then begin
      InternalPrepare;
    end
    else
      CheckOCI;
  except
    FCursorRef.FreeCursor;
    raise;
  end;

  inherited;
end;

procedure TOCICommand.Unprepare;
begin
  Close;

  inherited;
end;

function TOCICommand.NeedBindParam(Param: TOraParamDesc): boolean;
begin
  Result := Param.GetIsBound or (FCheckParamHasDefault and not Param.FHasDefault) or
    (Param.ParamType <> pdInput);
end;

function OCICallbackInBind(ictxp: IntPtr; bindp: pOCIBind; iter: ub4; index: ub4;
  var bufp: IntPtr; var alen: ub4; var piece: ub1; var indp: IntPtr): sb4; {$IFNDEF CLR} cdecl; {$ENDIF}forward;

function OCICallbackOutBind(octxp: IntPtr; bindp: pOCIBind; iter: ub4; index: ub4;
  var bufp: IntPtr; var alen: pub4; var piece: ub1; var indp: IntPtr; var rcodep: pub2): sb4; {$IFNDEF CLR} cdecl; {$ENDIF}forward;

procedure TOCICommand.BindParam(Param: TOraParamDesc);
var
  NullBuf: IntPtr;
  OraType: word;
  hBind: pOCIBind;
  ValuePtr: IntPtr;
  LenPtr: IntPtr;
  StrPtr: IntPtr;
  BufferSize: integer;
  BufferSkip: integer;
  ParamName: string;
  Obj: TOraObject;
  CharsetId: Integer; //sb2
  CharsetForm : Integer;
  MaxDataSize: Integer;
  Res, StrSize: integer;
begin
  if not NeedBindParam(Param) then
    exit;

  Param.ValidateParamValue;

  Param.AllocBuffer;

  if Param.DataType = dtUnknown then
    if Param.GetNull then
      OraType := VARCHAR2_TYPE  // WAR
    else
      raise Exception.Create(Format(SUnknownParamDataType, [Param.GetName]))
  else
    OraType := GetOraType(Param.DataType, Param.SubDataType);

  Param.SyncIndicator(FConnection);

  ParamName :=  Param.Name;
  BufferSize := Param.FValueSize;
  BufferSkip := BufferSize;
  ValuePtr := Param.ValuePtr;
  LenPtr := nil;

  if not Param.FTable then begin
    case Param.DataType of
      dtBytes,dtVarBytes: begin
        LenPtr := ValuePtr;
        BufferSize := 2000; // for RAW datatype out params
        ValuePtr := PtrOffset(ValuePtr, SizeOf(Word));
      end;
      dtString, dtFixedChar: begin
        if ((Param.ParamType in [pdUnknown, pdInput]) or (FSQLType = SQL_SELECT) and
          (Param.GetParamType = pdInputOutput)) and (Param.FLen <> 0)
        then begin
          BufferSize := Param.FLen;
          Marshal.WriteByte(ValuePtr, BufferSize, 0); // anti ORA-01480
          Inc(BufferSize);
        end;
        if (not FConnection.FUseUnicode) and (FConnection.FCharLength > 1) then
          if (OCISvcCtx.Home.PossibleOCICallStyles = [OCI80]) then begin
            if BufferSize > FConnection.GetMaxStringSize then begin
              BufferSize := FConnection.GetMaxStringSize;
              Marshal.WriteByte(ValuePtr, BufferSize - 1, 0);
            end
          end
          else begin
            if BufferSize > FConnection.GetMaxStringSize + 1 then begin
              BufferSize := FConnection.GetMaxStringSize + 1;
              Marshal.WriteByte(ValuePtr, BufferSize - 1, 0);
            end;
          end;
        if (Param.DataType = dtFixedChar) and (BufferSize > 0) then
          Dec(BufferSize);
      end;
      dtWideString, dtFixedWideChar: begin
        if ((Param.ParamType in [pdUnknown, pdInput]) or (FSQLType = SQL_SELECT) and
          (Param.GetParamType = pdInputOutput)) and (Param.FLen <> 0)
        then begin
          BufferSize := Param.FLen * 2;
          Marshal.WriteInt16(ValuePtr, BufferSize, 0);
          BufferSize := BufferSize + 2;
        end;
        if (not FConnection.FUseUnicode) and (FConnection.FCharLength > 1) then
          if OCISvcCtx.Home.PossibleOCICallStyles = [OCI80] then begin
             if BufferSize > FConnection.GetMaxStringSize * 2 then begin
              BufferSize := FConnection.GetMaxStringSize * 2;
              BufferSize := BufferSize - BufferSize mod 2 - 1;
              Marshal.WriteInt16(ValuePtr, BufferSize - 1, 0);
            end;
          end
          else begin
            if BufferSize > FConnection.GetMaxStringSize * 2 + 2 then begin
              BufferSize := FConnection.GetMaxStringSize * 2 + 2;
              BufferSize := BufferSize - BufferSize mod 2;
              Marshal.WriteInt16(ValuePtr, BufferSize - 2, 0);
            end;
          end;
        if (Param.DataType = dtFixedWideChar) and (BufferSize > 0) then
          BufferSize := BufferSize - 2;
      end;
      dtBlob, dtMemo, dtWideMemo:
        if Param.ParamType in [pdUnknown, pdInput] then begin
          BufferSize := Param.GetAsBlobRef.Size; // anti ORA-01026
          if BufferSize = 0 then
            Inc(BufferSize);
        end
        else begin
          BufferSize := MaxBlobSize;
          if Param.ParamType in [pdOutput, pdResult] then
            Param.GetAsBlobRef.Clear;  // prevent write OUT data
        end;
    end;
  end
  else
    case Param.DataType of
      dtString, dtFixedChar: begin
        if (OCISvcCtx.Home.PossibleOCICallStyles = [OCI80]) then begin
          if BufferSize > FConnection.GetMaxStringSize + 1 then begin
            BufferSize := FConnection.GetMaxStringSize + 1;
            Marshal.WriteByte(ValuePtr, BufferSize - 1, 0);// anti ORA-01480
          end
        end
        else begin
          if BufferSize > FConnection.GetMaxStringSize then begin
            BufferSize := FConnection.GetMaxStringSize;
            Marshal.WriteByte(ValuePtr, BufferSize - 1, 0);// anti ORA-01480
          end
        end
      end;
    end;

  NullBuf := Marshal.AllocHGlobal(sizeof(IntPtr));
  Marshal.WriteIntPtr(NullBuf, nil);
  try
    if FOCICallStyle = OCI73 then begin
      case Param.DataType of
        dtCursor: begin
          Assert(Param.GetAsCursor <> nil);
          Param.GetAsCursor.Init(OCISvcCtx, OCICallStyle);
          Param.GetAsCursor.AllocCursor;
          ValuePtr := Param.GetAsCursor.CDA;
        end;
        dtUnknown:  begin
          ValuePtr := NullBuf;
          BufferSize := 1;
        end;
      end;

      if not Param.FTable then begin
        if not(Param.DataType in [dtBlob,dtMemo]) then
          if LenPtr <> nil then
            Check(OCI7.obndra(FCursorRef.CDA, PAnsiChar(AnsiString(ParamName)), -1, ValuePtr, BufferSize,
              OraType, -1, Param.IndicatorPtr, LenPtr, nil, 0, nil, nil, -1, -1))
          else
            Check(OCI7.obndrv(FCursorRef.CDA, PAnsiChar(AnsiString(ParamName)), -1, ValuePtr, BufferSize,
              OraType, -1, Param.IndicatorPtr, nil, -1, -1))
        else
        { Piecewise }
          Check(OCI7.obindps(FCursorRef.CDA, 0, PAnsiChar(AnsiString(ParamName)), -1, nil, MaxBlobSize,
            OraType, 0, Param.IndicatorPtr, nil, nil, 0, 0, 0, 0, 0, nil, nil, 0, 0));

        Param.ActualLength := 1;
      end
      else begin
      { Table }
        Param.ActualLength := Param.FLength;
        Check(OCI7.obindps(FCursorRef.CDA, 1, PAnsiChar(AnsiString(ParamName)), -1, ValuePtr, BufferSize,
          OraType, 0, Param.IndicatorPtr, nil, nil, BufferSize, sizeof(sb2),
          0, 0, Param.FLength, Param.FActualLengthPtr, nil, 0, 0));
      end;
    end
    else
    if FOCICallStyle = OCI80 then begin
      case Param.DataType of
        dtCursor: begin
          Assert(Param.GetAsCursor <> nil);
          Param.GetAsCursor.Init(OCISvcCtx, OCICallStyle);
          Param.GetAsCursor.AllocCursor;
          ValuePtr := Param.GetAsCursor.OCIStmtPtr;
        end;
        dtOraBlob,dtOraClob,dtNClob: begin
          if Param.GetLength <= 1 then begin
            Param.GetAsOraBlob.OCISvcCtx := FConnection.OCISvcCtx;
            Param.GetAsOraBlob.FCharsetId := FConnection.FCharsetId;
            Param.GetAsOraBlob.FCharLength := FConnection.FCharLength;
            Param.GetAsOraBlob.AllocLob;
            ValuePtr := Param.GetAsOraBlob.OCILobLocatorPtr;
          end;
        end;
        dtBFile,dtCFile: begin
          Param.GetAsBFile.OCISvcCtx := FConnection.OCISvcCtx;
          Param.GetAsBFile.AllocLob;
          ValuePtr := Param.GetAsBFile.OCILobLocatorPtr;
        end;
        dtObject,dtXML,dtArray,dtTable: begin
          Obj := TOraObject(Param.GetObject);
          if Obj <> nil then begin
            Obj.AllocObject(OCISvcCtx);
            if not Obj.IsNull then
              Obj.WriteLobs;
          end;
          ValuePtr := nil;
        end;
        dtReference: begin
          ValuePtr := nil;
          //ValuePtr := Param.AsRef.OCIRefPtr;
          //RefPtr := nil;
          //ValuePtr := @RefPtr;//Param.AsRef.OCIRefPtr;
        end;
        dtNumber, dtBCD{$IFDEF VER6P}, dtLargeint{$IFNDEF FPC}, dtFMTBCD{$ENDIF}{$ENDIF}: begin
          if Param.GetLength <= 1 then begin
            BufferSize := OCI_NUMBER_SIZE;
            Param.GetAsNumber.SetEnvironment(OCISvcCtx.Environment);
            ValuePtr := Param.GetAsNumber.OCINumberPtr;
          end;
        end;
        dtUnknown: begin
          ValuePtr := NullBuf;
          BufferSize := 1;
        end;
        else
          if OCISvcCtx.Home.OCIVersion >= 9000 then begin
            case Param.DataType of
              dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ{$IFDEF VER6P}{$IFNDEF FPC}, dtSQLTimeStamp{$ENDIF}{$ENDIF}:
                if Param.GetLength <= 1 then
                  with Param.GetAsTimeStamp do begin
                    BufferSize := sizeof(IntPtr);
                    case Param.DataType of
                      dtTimeStamp{$IFDEF VER6P}{$IFNDEF FPC}, dtSQLTimeStamp{$ENDIF}{$ENDIF}:
                        DescriptorType := OCI_DTYPE_TIMESTAMP;
                      dtTimeStampTZ:
                        DescriptorType := OCI_DTYPE_TIMESTAMP_TZ;
                      dtTimeStampLTZ:
                        DescriptorType := OCI_DTYPE_TIMESTAMP;
                    end;
                    SetEnvironment(OCISvcCtx.Environment);
                    AllocDateTime;
                    ValuePtr := GetOCIDateTimePtr;
                  end;
              dtIntervalYM, dtIntervalDS:
                if Param.GetLength <= 1 then
                  with Param.GetAsInterval do begin
                    BufferSize := sizeof(IntPtr);
                    if Param.DataType = dtIntervalYM then
                      DescriptorType := OCI_DTYPE_INTERVAL_YM
                    else
                      DescriptorType := OCI_DTYPE_INTERVAL_DS;
                    SetEnvironment(OCISvcCtx.Environment);
                    AllocInterval;
                    ValuePtr := GetOCIIntervalPtr;
                  end;
            end;
          end;
      end;


      if (Param.FHandle <> nil) and (Param.FBindBufferSize = BufferSize) then
        Exit;

      if not Param.FTable then begin
        if FIterCount = 1 then begin
          if not (Param.DataType in [dtBlob,dtMemo,dtWideMemo]) then begin
            StrPtr := StringToHGlobalOCI(ParamName, StrSize, OCISvcCtx.UnicodeEnv);
            Res := OCI8.OCIBindByName(FCursorRef.OCIStmt, hBind, OCISvcCtx.hOCIError, StrPtr, StrSize,
              ValuePtr, BufferSize, OraType,
              Param.IndicatorPtr, LenPtr, nil, 0, nil, OCI_DEFAULT);
            FreeStringOCI(StrPtr, OCISvcCtx.UnicodeEnv);
            Check(Res);

            case Param.DataType of
              dtObject,dtArray,dtTable: begin
                Obj := TOraObject(Param.GetObject);
                if Obj <> nil then
                  Check(OCI8.OCIBindObject(hBind, OCISvcCtx.hOCIError, Obj.ObjectType.TDO, Obj.InstancePtr, nil, Obj.IndicatorPtr, nil));
              end;
              dtXML: begin
                Obj := TOraObject(Param.GetObject);
                if Obj <> nil then begin
                  // if XML is NULL then Instance and Indicator must be nil (for OUT parameters especially)
                  if Obj.IsNull then
                    Obj.FreeObject;

                  Check(OCI8.OCIBindObject(hBind, OCISvcCtx.hOCIError, Obj.ObjectType.TDO, Obj.InstancePtr, nil, Obj.IndicatorPtr, nil));
                end;
              end;
              dtReference: begin
                Obj := TOraObject(Param.GetObject);
                if Obj <> nil then
                  Check(OCI8.OCIBindObject(hBind, OCISvcCtx.hOCIError, Obj.ObjectType.TDO, IntPtr(TOraRef(Obj).OCIRefPtr), nil, nil, nil));
              end;
            end;
          end
          else begin
          { Piecewise }
            {if Param.FParamType = pdInput then begin
              BufferSize := Param.GetAsBlobRef.Size; // anti ORA-01026
              if BufferSize = 0 then
                Inc(BufferSize);
            end
            else begin
              BufferSize := MaxBlobSize;
              if Param.FParamType in [pdOutput, pdResult] then
                Param.GetAsBlobRef.Clear;  // prevent write OUT data
            end;}

            StrPtr := StringToHGlobalOCI(ParamName, StrSize, OCISvcCtx.UnicodeEnv);
            Res := OCI8.OCIBindByName(FCursorRef.OCIStmt, hBind, OCISvcCtx.hOCIError, StrPtr, StrSize,
              nil, BufferSize, OraType, Param.IndicatorPtr,
              nil, nil, 0, nil, OCI_DATA_AT_EXEC);
            FreeStringOCI(StrPtr, OCISvcCtx.UnicodeEnv);
            Check(Res);

          // Dynamic blob
          {$IFDEF CLR}
            if OCISvcCtx.Home.PossibleOCICallStyles = [OCI80] then
              Check(OCI8.OCIBindDynamic(hBind, OCISvcCtx.hOCIError, GCHandle, IntPtr(HOCICallbackInBind), GCHandle, IntPtr(HOCICallbackOutBind)))
            else
          {$ENDIF}
              Check(OCI8.OCIBindDynamic(hBind, OCISvcCtx.hOCIError, GCHandle, OCICallbackInBindPtr, GCHandle, OCICallbackOutBindPtr));
          end;
          Param.ActualLength := 1;
        end
        else begin
        // DML Array
          if FIterCount > Param.FLength then
            RaiseError(Format(SArrayParam, [ParamName, FIterCount]));

          StrPtr := StringToHGlobalOCI(ParamName, StrSize, OCISvcCtx.UnicodeEnv);
          Res := OCI8.OCIBindByName(FCursorRef.OCIStmt, hBind, OCISvcCtx.hOCIError, StrPtr, StrSize,
            ValuePtr, BufferSize, OraType,
            Param.IndicatorPtr, LenPtr, nil, 0, nil, OCI_DEFAULT);
          FreeStringOCI(StrPtr, OCISvcCtx.UnicodeEnv);
          Check(Res);

          Check(OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, BufferSkip, sizeof(sb2),
            BufferSkip, 0))
        end;
        Param.FHandle := hBind;
        Param.FBindBufferSize := BufferSize;
      end
      else begin
      { Table }
      // PL/SQL table
        Param.ActualLength := Param.FLength;
        StrPtr := StringToHGlobalOCI(ParamName, StrSize, OCISvcCtx.UnicodeEnv);
        Res := OCI8.OCIBindByName(FCursorRef.OCIStmt, hBind, OCISvcCtx.hOCIError, StrPtr, StrSize,
          ValuePtr, BufferSize, OraType,
          Param.IndicatorPtr, nil, nil, Param.FLength, Param.FActualLengthPtr, OCI_DEFAULT);
        FreeStringOCI(StrPtr, OCISvcCtx.UnicodeEnv);
        Check(Res);

        Check(OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, BufferSkip, sizeof(sb2),
          0, 0));

        Param.FHandle := hBind;
        Param.FBindBufferSize := BufferSize;
      end;

      case Param.DataType of
        dtString, dtFixedChar:
          CharsetId := Integer(FConnection.FCharsetId);
        dtWideString, dtFixedWideChar:
          CharsetId := Integer(OCI_UTF16ID);
        dtBlob,dtMemo,dtWideMemo:
          if Param.GetAsBlobRef.IsUnicode then
            CharsetId := Integer(OCI_UTF16ID)
          else
            CharsetId := Integer(FConnection.FCharsetId);
      else
        CharsetId := 0;
      end;

      if Param.GetNational or
         ((CharsetId = OCI_UTF16ID) and FConnection.FUnicodeAsNational and (OCISvcCtx.Home.OCIVersion >= 9000)) then
      begin
        CharsetForm := SQLCS_NCHAR;
        Check(OCI8.OCIAttrSet2(hBind, OCI_HTYPE_BIND, CharsetForm, 0, OCI_ATTR_CHARSET_FORM, OCISvcCtx.hOCIError));
      end;
      if Integer(CharsetId) > 0 then
        Check(OCI8.OCIAttrSet2(hBind, OCI_HTYPE_BIND, CharsetId, 0, OCI_ATTR_CHARSET_ID, OCISvcCtx.hOCIError));
      if UseMaxDataSize and not (OCISvcCtx.Home.PossibleOCICallStyles = [OCI80]) and
        (Param.DataType in [dtString, dtFixedChar, dtWideString, dtFixedWideChar])
      then begin
        MaxDataSize := Param.FValueSize - 1;
        if Param.DataType in [dtWideString, dtFixedWideChar] then
          MaxDataSize := MaxDataSize div 2;
        if (Param.ParamType in [pdUnknown, pdInput]) and not Param.FTable then begin //(((Param.ParamType = pdUnknown) and (Param.FLen > 0)) or
                                                                       // Unknown param is binded as Input/OutPut
                                                                       // cr8800
          MaxDataSize := FConnection.GetMaxStringSize * FConnection.FCharLength;
          if Param.FLen * 3 < MaxDataSize then
            MaxDataSize := Param.FLen * 3;

          if (Param.DataType in [dtWideString, dtFixedWideChar]) then begin
            if (MaxDataSize < 4) then
             MaxDataSize := 4;
          end
          else
            if MaxDataSize < 2 then
              MaxDataSize := 2;
        end;
        Check(OCI8.OCIAttrSet2(hBind, OCI_HTYPE_BIND, MaxDataSize, 0, OCI_ATTR_MAXDATA_SIZE, OCISvcCtx.hOCIError));
        if (OCISvcCtx.Home.OCIVersion >= 9000) and (FConnection.GetOracleVersion >= 9200) and (Param.ParamType = pdInput) and (Param.FLen > 0) and
           ((FConnection.GetOracleVersion < 9206) or (FConnection.GetOracleVersion > 10000)) then //Oracle 9.2.0.6 Patchset Bug
        begin
          MaxDataSize := Integer(Param.FLen);
          Check(OCI8.OCIAttrSet2(hBind, OCI_HTYPE_BIND, MaxDataSize, 0, OCI_ATTR_MAXCHAR_SIZE, OCISvcCtx.hOCIError));
        end;
      end;
    end
    else
      CheckOCI;
  finally
    Marshal.FreeHGlobal(NullBuf);
  end;
end;

function TOCICommand.InternalExecute(Mode: integer; Rows: Integer = 0): sword;
var
  OldCursorState: TCursorState;
  Res: sword;
  Res1: sword;
  Iters:ub4;
  i: integer;
  ValueInt: Integer;
  OCIStmt: pOCIStmt;
begin
  CheckActive;

  Busy;
  OldCursorState := GetCursorState;
  SetCursorState(csExecuting);
  Res := OCI_SUCCESS;

  OCIStmt := nil;
  try // For Busy
    try
      if FOCICallStyle = OCI73 then begin
        if Mode = OCI_DEFAULT then begin
          FConnection.BusyWait;
            Res := OCI7.oexn(FCursorRef.CDA, FIterCount, 0);
          FConnection.Release;

          if (Res <> OCI_SUCCESS) and
             (Res <> OCI_STILL_IS_PIECE) and
             (Res <> OCI_STILL_IS_PIECE1) and
             (Res <> OCI_BLOCKED)
          then begin
            FErrorOffset := FCursorRef.CDA.peo;
            Check(Res);
          end;

          if Res = OCI_SUCCESS then
            FRowsProcessed := FCursorRef.CDA.rpc;
        end;
      end
      else
      if FOCICallStyle = OCI80 then begin
        if FSQLType = SQL_SELECT then begin
          Iters := Rows
        end
        else
          Iters := FIterCount;

        OCIStmt := FCursorRef.OCIStmt;
        FConnection.BusyWait;
          Res := OCI8.OCIStmtExecute(OCISvcCtx.hOCISvcCtx, OCIStmt, OCISvcCtx.hOCIError, Iters, 0, nil, nil, Mode);
        FConnection.Release;

        if Mode <> OCI_DESCRIBE_ONLY then begin
          Check(OCI8.OCIAttrGet2(OCIStmt, OCI_HTYPE_STMT, ValueInt, nil, OCI_ATTR_ROW_COUNT, OCISvcCtx.hOCIError));
          FRowsProcessed := Integer(ValueInt);
        end;

        if FSQLType = SQL_UNKNOWN then begin
          Check(OCI8.OCIAttrGet2(OCIStmt, OCI_HTYPE_STMT, ValueInt, nil, OCI_ATTR_SQLFNCODE, OCISvcCtx.hOCIError));
          FSQLType := Word(ValueInt);
          FLastSQLType := FSQLType;
        end;

        if (Res <> OCI_SUCCESS) and
           (Res <> OCI_NEED_DATA) and
           ((FSQLType <> SQL_SELECT) or (Res <> OCI_NO_DATA))
        then begin
          Res1 := OCI8.GetOraError(Res, OCISvcCtx);
          if Res1 <> Abs(OCI_BLOCKED) then
            Check(Res)
          else
            Res := Res1;
        end;
      end
      else
        CheckOCI;
    except
      if GetCursorState <> csInactive then  // on lost connection
        SetCursorState(OldCursorState);
      raise;
    end;

    if Mode <> OCI_DESCRIBE_ONLY then begin
      SetCursorState(csExecuted);

      for i := 0 to FParams.Count - 1 do
        if TOraParamDesc(FParams[i]).DataType = dtCursor then
          TOraParamDesc(FParams[i]).GetAsCursor.FState := csExecuted;
    end
    else
      SetCursorState(OldCursorState);

  finally
    if (GetCursorState <> csInactive) and // on lost connection
       (FOCICallStyle = OCI80) and (OCISvcCtx.Home.OCIVersion >= 8050)
    then begin
      if OCISvcCtx.Home.OCIVersion >= 8100 then
        Check(OCISvcCtx.OCI8.OCIAttrGet2(OCIStmt, OCI_HTYPE_STMT, ValueInt, nil, OCI_ATTR_PARSE_ERROR_OFFSET, OCISvcCtx.hOCIError))
      else
        Check(OCISvcCtx.OCI8.OCIAttrGet2(OCIStmt, OCI_HTYPE_STMT, ValueInt, nil, $80, OCISvcCtx.hOCIError));
      FErrorOffset := Word(ValueInt);
    end;
    Release;
  end;
  FFetchedRows := 0;
  Result := Res;
end;

procedure TOCICommand.Exec;
const
  BufSize = 100;
var
  i, j: integer;
  Res: sword;
  PieceStatus: ub1;
  Blob: TBlob;
  Piece: PPieceHeader;
  Ptr: IntPtr;
  BufLen: ub4;
  Iteration: ub4;
  Index: ub4;
  NeedData: integer;
  IsData: integer;
  hBind: pOCIHandle;
  Buf: IntPtr;
  Param: TOraParamDesc;
  Mode: TParamDirection;
  CommitOnSuccess: boolean;
  ItemObject: TSharedObject;
  OraLob: TOraLob;
  LobType: TLobType;
  OraObj: TOraObject;

  procedure Warning(Msg: string);
  begin
  {$IFDEF WIN32_64}
    MessageBox(0{HInstance}, PChar(Msg), 'Warning', MB_OK or MB_ICONWARNING);
  {$ENDIF}
  end;

  procedure CreateLobTemporary(OraLob: TOraLob);
  begin
    OraLob.OCISvcCtx := FConnection.OCISvcCtx;
    {$IFDEF HAVE_COMPRESS}
    if (Param.DataType = dtOraBlob) and (FCompressBlob in [cbServer, cbClientServer]) then
      OraLob.Compressed := True
    else
      OraLob.Compressed := False;
    {$ENDIF}
    if Param.DataType = dtOraBlob then
      LobType := ltBlob
    else if Param.GetNational then
      LobType := ltNClob
    else
      LobType := ltClob;
    OraLob.CreateTemporary(LobType);
    OraLob.WriteLob;
  end;

begin
  CommitOnSuccess := (FOCICallStyle = OCI80) and
    (FSQLType <> SQL_SELECT) and
    FAutoCommit and
    FConnection.AutoCommit;

  if FTemporaryLobUpdate then
    for i := 0 to FParams.Count - 1 do begin
      Param := TOraParamDesc(FParams[i]);
      if (Param.DataType in [dtOraBlob,dtOraClob]) and (Param.ParamType in [pdUnknown, pdInput, pdInputOutput]) then
        // standard parameter
        if Param.GetLength <= 1 then begin
          if not Param.GetNull then begin
            OraLob := Param.GetAsOraBlob;
            CreateLobTemporary(OraLob);
          end;
        end
        // DML array
        else begin
          for Index := 1 to Param.GetLength do begin
            OraLob := TOraLob(Param.GetItemAsObject(Index));
            if not OraLob.IsEmpty then
              CreateLobTemporary(OraLob);
          end;
          // update array of OCILobLocator that were recreated by CreateLobTemporary
          Param.SyncIndicator(FConnection);
        end;
    end
  else
  if CommitOnSuccess then
    for i := 0 to FParams.Count - 1 do
      if TOraParamDesc(FParams[i]).DataType in [dtOraBlob, dtOraClob] then begin
        CommitOnSuccess := False;
        break;
      end;

  if (FSQLType = SQL_SELECT) and (FCursorRef <> nil) and (FCursorRef.FScrollable) then begin
    Res := InternalExecute(OCI_SCROLLABLE_CURSOR)
  end
  else
    if CommitOnSuccess then
      Res := InternalExecute(OCI_COMMIT_ON_SUCCESS)
    else
      Res := InternalExecute(OCI_DEFAULT);

  // remember ROWID value for updates without explicit prepare
  if FStoreRowId then
    FRowId := GetRowId
  else
    FRowId := '';

  // Reading/Writing Piecewise data
    if Res <> OCI_SUCCESS then begin
      Buf := Marshal.AllocHGlobal(BufSize + 1);
      try
        if FOCICallStyle = OCI80 then begin
          GetPI(hBind, PieceStatus, Ptr, Iteration, Index, Mode);
          repeat
            for i := 0 to FParams.Count - 1 do
              if TOraParamDesc(FParams[i]).FHandle = hBind then
                break;
            Assert(i < FParams.Count);

            Blob := TOraParamDesc(FParams[i]).GetAsBlobRef;

            if Mode = pdInput then begin
              Piece := Blob.FirstPiece;
              if IntPtr(Piece) <> nil then
                repeat
                  BufLen := Piece.Used;
                  if IntPtr(Piece.Next) = nil then
                    PieceStatus := OCI_LAST_PIECE;

                  SetPI(hBind, OCI_HTYPE_BIND, PieceStatus, PtrOffset(Piece, Sizeof(TPieceHeader)), BufLen, nil);

                  Res := InternalExecute(OCI_DEFAULT);

                  GetPI(hBind, PieceStatus, Ptr, Iteration, Index, Mode);

                  Piece := Piece.Next;
                until (Res = OCI_SUCCESS) or (PieceStatus = OCI_FIRST_PIECE) or {WAR} (PieceStatus = OCI_ONE_PIECE)
              else begin
                BufLen := 0;
                SetPI(hBind, OCI_HTYPE_BIND, OCI_LAST_PIECE, Buf, BufLen, nil);
                Res := InternalExecute(OCI_DEFAULT);
                GetPI(hBind, PieceStatus, Ptr, Iteration, Index, Mode);
              end;
            end
            else
            if Mode in [pdOutput, pdResult] then begin
              Blob.Clear;

              repeat
                BufLen := Blob.PieceSize;
                Blob.AllocPiece(Piece, BufLen);

                SetPI(hBind, OCI_HTYPE_BIND, PieceStatus, PtrOffset(Piece, Sizeof(TPieceHeader)), BufLen, nil);

                Res := InternalExecute(OCI_DEFAULT);

                Piece.Used := BufLen;
                if BufLen < Cardinal(Blob.PieceSize) then
                  Blob.ReallocPiece(Piece, BufLen);
                Blob.AppendPiece(Piece);

                GetPI(hBind, PieceStatus, Ptr, Iteration, Index, Mode);

              until (Res = OCI_SUCCESS) or (PieceStatus = OCI_FIRST_PIECE) or (PieceStatus = OCI_ONE_PIECE);
            end;
          until Res = OCI_SUCCESS;
        end
        else
        if FOCICallStyle = OCI73 then begin
          NeedData := OCI_STILL_IS_PIECE1;
          IsData := OCI_STILL_IS_PIECE;

          // IN params
          for i := 0 to FParams.Count - 1 do begin
            Param := TOraParamDesc(FParams[i]);
            if (Param.DataType in [dtBlob, dtMemo, dtWideMemo]) and
              (Param.ParamType in [pdInput, pdInputOutput]) and not Param.GetNull// and (FOCICallStyle = OCI73) or {for OCI73}
              //((GetParam(i).ParamType in [pdInput, pdInputOutput]) and{or} not GetParam(i).IsNull) and (FOCICallStyle = OCI80))    {for OCI80}
            then begin
              if Res <> NeedData then begin
                Warning(STooManyInputParams);
                break;
              end;

              GetPI(hBind, PieceStatus, Ptr, Iteration, Index, Mode);

              Blob := Param.GetAsBlobRef;
              Assert(Blob <> nil);

              Piece := Blob.FirstPiece;
              if IntPtr(Piece) <> nil then
                repeat
                  BufLen := Piece.Used;
                  if IntPtr(Piece.Next) = nil then
                    PieceStatus := OCI_LAST_PIECE;

                  SetPI(hBind, OCI_HTYPE_BIND, PieceStatus, PtrOffset(Piece, Sizeof(TPieceHeader)), BufLen, nil);

                  Res := InternalExecute(OCI_DEFAULT);

                  GetPI(hBind, PieceStatus, Ptr, Iteration, Index, Mode);

                  Piece := Piece.Next;
                until (Res = OCI_SUCCESS) or (PieceStatus = OCI_FIRST_PIECE) or {WAR} (PieceStatus = OCI_ONE_PIECE)
              else begin
                BufLen := 0;
                SetPI(hBind, OCI_HTYPE_BIND, OCI_LAST_PIECE, Buf, BufLen, nil);
                Res := InternalExecute(OCI_DEFAULT);
              end;
            end;
          end;

          if (Res = NeedData) then begin
            Warning(SNotEnoughInputParams);
            while Res = NeedData do begin
              BufLen := 0;
              SetPI(hBind, OCI_HTYPE_BIND, OCI_LAST_PIECE, Buf, BufLen, nil);
              Res := InternalExecute(OCI_DEFAULT);
            end;
          end;

          // OUT params
          for i := 0 to FParams.Count - 1 do begin
            Param := TOraParamDesc(FParams[i]);
            if (Param.DataType in [dtBlob, dtMemo, dtWideMemo]) and
              (Param.ParamType in [pdInputOutput, pdOutput, pdResult])
            then begin
              if Res <> IsData then begin
                Warning(STooNanyOutputParams);
                break;
              end;

              GetPI(hBind, PieceStatus, Ptr, Iteration, Index, Mode);

              Blob := Param.GetAsBlobRef;
              Assert(Blob <> nil);

              Blob.Clear;

              repeat
                BufLen := Blob.PieceSize;
                Blob.AllocPiece(Piece, BufLen);

                SetPI(hBind, OCI_HTYPE_BIND, PieceStatus, PtrOffset(Piece, Sizeof(TPieceHeader)), BufLen, nil);

                Res := InternalExecute(OCI_DEFAULT);

                Piece.Used := BufLen;
                if BufLen < Cardinal(Blob.PieceSize) then
                  Blob.ReallocPiece(Piece, BufLen);
                Blob.AppendPiece(Piece);

                GetPI(hBind, PieceStatus, Ptr, Iteration, Index, Mode);

              until (Res = OCI_SUCCESS) or (PieceStatus = OCI_FIRST_PIECE) or (PieceStatus = OCI_ONE_PIECE);
            end;
          end;

          if Res = IsData then begin
            Warning(SNotEnoughOutputParams);
            while Res = IsData do begin
              BufLen := BufSize;
              GetPI(hBind, PieceStatus, Ptr, Iteration, Index, Mode); // ???
              SetPI(hBind, OCI_HTYPE_BIND, OCI_LAST_PIECE, Buf, BufLen, nil);
              Res := InternalExecute(OCI_DEFAULT);
            end;
          end;

          // OCI73 bug - damage data of last piece
          BufLen := 0;
          SetPI(hBind, OCI_HTYPE_BIND, OCI_LAST_PIECE, nil, BufLen, nil);
        end
        else begin
          CheckOCI;
        end;
      finally
        Marshal.FreeHGlobal(Buf);
      end;
    end;

// Reading/Writing LOBs, Updating DML Array params
  if (Res = OCI_SUCCESS) and (FOCICallStyle = OCI80) and (FRowsProcessed > 0) then
    for i := 0 to FParams.Count - 1 do begin
      Param := TOraParamDesc(FParams[i]);
      if (Param.FLength > 1) and (Param.ParamType in [pdUnknown, pdInputOutput, pdOutput, pdResult]) then begin
        for j := 1 to Param.FLength do begin
          case Param.DataType of
            dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ{$IFDEF VER6P}{$IFNDEF FPC}, dtSQLTimeStamp{$ENDIF}{$ENDIF}: begin
              ItemObject := Param.GetItemAsObject(j);
              if ItemObject <> nil then
                Marshal.WriteInt16(TOraTimeStamp(ItemObject).FIndicator, Marshal.ReadInt16(Param.FIndicator, (j - 1) * sizeof(sb2)));
            end;
            dtIntervalYM, dtIntervalDS: begin
              ItemObject := Param.GetItemAsObject(j);
              if ItemObject <> nil then
                Marshal.WriteInt16(TOraInterval(ItemObject).FIndicator, Marshal.ReadInt16(Param.FIndicator, (j - 1) * sizeof(sb2)));
            end;
            dtNumber, dtBCD{$IFDEF VER6P}, dtLargeint{$IFNDEF FPC}, dtFMTBCD{$ENDIF}{$ENDIF}: begin
              ItemObject := Param.GetItemAsObject(j);
              if ItemObject <> nil then
                Marshal.WriteInt16(TOraNumber(ItemObject).FIndicator, Marshal.ReadInt16(Param.FIndicator, (j - 1) * sizeof(sb2)));
            end;
          end;
        end;
      end
      else if Param.DataType in [dtOraBlob,dtOraClob] then begin
        Param.GetAsOraBlob.Cached := FCacheLobs or (Param.GetParamType = pdInput);
        if Param.GetAsOraBlob.Cached then begin
          if Param.ParamType in [pdInput] then begin
            if not FTemporaryLobUpdate and (not Param.GetNull) then begin
            {$IFDEF HAVE_COMPRESS}
              if (Param.DataType = dtOraBlob) and (FCompressBlob in [cbServer, cbClientServer]) then
                Param.GetAsOraBlob.Compressed := True
              else
                Param.GetAsOraBlob.Compressed := False;
            {$ENDIF}
              Param.GetAsOraBlob.WriteLob;
            end;
          end
          else if (Param.ParamType in [pdOutput, pdResult]) or
                   FTemporaryLobUpdate and (Param.ParamType in [pdInputOutput])
          then begin
            if not Param.GetNull then begin
              Param.GetAsOraBlob.ReadLob;
            {$IFDEF HAVE_COMPRESS}
              if (Param.DataType = dtOraBlob) and (FCompressBlob in [cbClient, cbClientServer]) then
                Param.GetAsOraBlob.Compressed := True
              else
                Param.GetAsOraBlob.Compressed := False;
            {$ENDIF}
            end
            else begin
              Param.GetAsOraBlob.FreeBlob;
              Param.GetAsOraBlob.Clear;
            end;
          end
          else
            RaiseError(SNeedParamType);
        end;
      end
      else if Param.DataType in [dtObject, dtArray, dtTable] then begin
        if Param.ParamType in [pdInputOutput, pdOutput, pdResult] then begin
          OraObj := TOraObject(Param.GetObject);
          if (OraObj <> nil) and (not OraObj.IsNull) then
            OraObj.ReadLobs;
        end;
      end
      else
        if Param.DataType = dtXML then
          if Param.ParamType in [pdInputOutput, pdOutput, pdResult] then
            TOraXML(Param.GetObject).ReadXML;
    end;

// Adjust table params FActualLength
  {
  for i := 0 to FParams.Count - 1 do begin
    if Param.FTable then
      if Param.FActualLength < Param.FLength then
        FillChar(Param.FIndicator,
  }

// AutoCommit
  if (Res = OCI_SUCCESS) and
     (FSQLType <> SQL_SELECT) and
     FAutoCommit and
     FConnection.AutoCommit and
     not CommitOnSuccess
  then
    FConnection.GetInternalTransaction.Commit;
end;

function TOCICommand.CallbackInBind(Bind: pOCIBind; Iter: ub4; Index: ub4;
  var Buf: IntPtr; var BufLen: ub4; var PieceStatus: ub1; var Ind: IntPtr): sb4;
var
  i: word;
  Param: TOraParamDesc;
  Blob: TBlob;
  Piece: PPieceHeader;
begin
  for i := 0 to FParams.Count - 1 do
    if TOraParamDesc(FParams[i]).FHandle = Bind then
      break;
  Assert(i < FParams.Count);
  Param := TOraParamDesc(FParams[i]);
  Blob := Param.GetAsBlobRef;

  Piece := Blob.FirstPiece;
  if PieceStatus = OCI_FIRST_PIECE then
    Param.FBlobPiece := 0
  else begin
    i := 0;
    while (IntPtr(Piece) <> nil) and (i < Param.FBlobPiece) do begin
      Piece := Piece.Next;
      Inc(i);
    end;
  end;

  if IntPtr(Piece) <> nil then begin
    Buf := PieceData(Piece);
    BufLen := Piece.Used;
    Ind := Param.IndicatorPtr;
    if IntPtr(Piece.Next) = nil then
      PieceStatus := OCI_LAST_PIECE
    else
      if Param.FBlobPiece = 0 then
        PieceStatus := OCI_FIRST_PIECE
      else
        PieceStatus := OCI_NEXT_PIECE;
    Inc(Param.FBlobPiece);
  end
  else begin
    Buf := nil;
    BufLen := 0;
    Ind := nil;
    PieceStatus := OCI_LAST_PIECE;
  end;

  Result := OCI_CONTINUE;
end;

function TOCICommand.CallbackOutBind(Bind: pOCIBind; Iter: ub4; Index: ub4;
  var Buf: IntPtr; var BufLen: pub4; var PieceStatus: ub1; var Ind: IntPtr): sb4;
var
  i: integer;
  Blob: TBlob;
  Piece: PPieceHeader;
  Len: cardinal;
begin
  for i := 0 to FParams.Count - 1 do
    if TOraParamDesc(FParams[i]).FHandle = Bind then
      break;
  Assert(i < FParams.Count);

  Blob := TOraParamDesc(FParams[i]).GetAsBlobRef;

  if PieceStatus = OCI_ONE_PIECE then
    Blob.Clear;

  Len := Blob.PieceSize;
  Blob.AllocPiece(Piece, Len);
  Blob.AppendPiece(Piece);

  Buf := PieceData(Piece);

  Piece.Used := Len;
  BufLen := PieceUsedPtr(Piece);

  Ind := TOraParamDesc(FParams[Index]).IndicatorPtr;

  PieceStatus := OCI_NEXT_PIECE;

  Result := OCI_CONTINUE;
end;

function OCICallbackInBind(ictxp: IntPtr; bindp: pOCIBind; iter: ub4; index: ub4;
  var bufp: IntPtr; var alen: ub4; var piece: ub1; var indp: IntPtr): sb4; {$IFNDEF CLR} cdecl; {$ENDIF}
begin
  Result := TOCICommand(GetGCHandleTarget(ictxp)).CallbackInBind(bindp, iter, index, bufp, alen,
    piece, indp);
end;

function OCICallbackOutBind(octxp: IntPtr; bindp: pOCIBind; iter: ub4; index: ub4;
  var bufp: IntPtr; var alen: pub4; var piece: ub1; var indp: IntPtr; var rcodep: pub2): sb4; {$IFNDEF CLR} cdecl; {$ENDIF}
begin
  Result := TOCICommand(GetGCHandleTarget(octxp)).CallbackOutBind(bindp, iter, index, bufp, alen,
    piece, indp);
  rcodep := nil;
end;

procedure TOCICommand.DefineData(Field: TFieldDesc; Buf: IntPtr;
  Ind: psb2; BufSkip: integer; IndSkip: integer);
var
  OraType: word;
  hDefine: pOCIDefine;
  ValuePtr: IntPtr;
  IndPtr: IntPtr;
  LenPtr: pub2;
  LenSkip: integer;
  Size: longword;
  CharsetId: Integer;//sb2
  CharsetForm : Integer;
begin
  OraType := GetOraType(Field.DataType, Field.SubDataType);

  if (Field.DataType in [dtWideString, dtExtWideString]) or
     (Field.SubDataType in [dtWideString, dtNWideString, dtFixedWideChar, dtFixedNWideChar])
  then begin// in future use DataSize
    Size := Field.Length * 2;
    if not (Field.SubDataType in [dtFixedWideChar, dtFixedNWideChar]) or (Size = 0) then
      Size := Size + 2;
  end
  else
  if (Field.DataType in [dtString, dtExtString]) or
     (Field.SubDataType in [dtString, dtNString, dtFixedChar, dtFixedNChar])
  then  begin// in future use DataSize
    Size := Field.Length;
    if not (Field.SubDataType in [dtFixedChar, dtFixedNChar]) or (Size = 0) then
      Size := Size + 1;
  end
  else
    case Field.DataType of
      dtExtVarBytes:
        Size := Field.Length + SizeOf(Word);
      dtNumber, dtLargeint, dtBCD{$IFDEF VER6P}{$IFNDEF FPC}, dtFMTBCD{$ENDIF}{$ENDIF}:
        Size := OCI_NUMBER_SIZE;
    else
      Size := Field.Size;
    end;

  if FOCICallStyle = OCI73 then begin
    case Field.DataType of
      dtVarBytes, dtExtVarBytes: begin
        LenPtr := Buf;
        Buf := PtrOffset(Buf, 2);
        LenSkip := BufSkip;
      end
    else
      LenPtr := nil;
      LenSkip := 0;
    end;

    if (BufSkip > 0) or (IndSkip > 0) then
      Check(OCI7.odefinps(FCursorRef.CDA, 1, Field.ActualFieldNo, Buf, Size, OraType, 0, Ind, nil, 0, 0, LenPtr, pub2(0), BufSkip, IndSkip, LenSkip, 0))
    else
      Check(OCI7.odefin(FCursorRef.CDA, Field.ActualFieldNo, Buf, Size, OraType, -1, Ind, nil, -1, -1, LenPtr, pub2(0))); // not Array
  end
  else
  if FOCICallStyle = OCI80 then begin
    hDefine := nil;
    LenPtr := nil;
    LenSkip := 0;
    case Field.DataType of
      dtObject,dtXML,dtReference,dtArray,dtTable:
        ValuePtr := nil;
      dtVarBytes,dtExtVarBytes: begin
        LenPtr := Buf;
        LenSkip := BufSkip;
        ValuePtr := PtrOffset(Buf, 2);
      end;
    else
      ValuePtr := Buf;
    end;

    if Field.DataType = dtXML then
      IndPtr := nil
    else
      IndPtr := Ind;

    Check(OCI8.OCIDefineByPos(FCursorRef.OCIStmt, hDefine, OCISvcCtx.hOCIError, Field.ActualFieldNo,
      ValuePtr, Size, OraType, IndPtr, LenPtr, nil, OCI_DEFAULT));

    CharsetId := 0;
    if (Field.DataType in [dtWideString, dtExtWideString]) or
       (Field.DataType in [dtBlob,dtWideMemo]) and
       (Field.SubDataType in [dtWideString, dtNWideString, dtFixedWideChar, dtFixedNWideChar])
    then
      CharsetId := Integer(OCI_UTF16ID)
    else
    if (Field.DataType in [dtString, dtExtString]) or
       (Field.DataType in [dtBlob,dtMemo]) and
       (Field.SubDataType in [dtString, dtNString, dtFixedChar, dtFixedNChar])
    then
      CharsetId := Integer(FConnection.FCharsetId);

    if Field.SubDataType in [dtNString, dtNWideString, dtFixedNChar, dtFixedNWideChar, dtNClob] then begin
      CharsetForm := SQLCS_NCHAR;
      Check(OCI8.OCIAttrSet2(hDefine, OCI_HTYPE_DEFINE, CharsetForm, 0, OCI_ATTR_CHARSET_FORM, OCISvcCtx.hOCIError));
    end;

    if CharsetId > 0 then
      Check(OCI8.OCIAttrSet2(hDefine, OCI_HTYPE_DEFINE, CharsetId, 0, OCI_ATTR_CHARSET_ID, OCISvcCtx.hOCIError));

    case Field.DataType of
      dtObject,dtXML,dtArray,dtTable:
        Check(OCI8.OCIDefineObject(hDefine, OCISvcCtx.hOCIError, TOraType(Field.ObjectType).TDO,
          Buf, nil, nil {IntPtr(Ind)}, nil));
      dtReference:
        Check(OCI8.OCIDefineObject(hDefine, OCISvcCtx.hOCIError, nil, Buf, nil, nil , nil));
    end;

    if (BufSkip > 0) or (IndSkip > 0) then
      Check(OCI8.OCIDefineArrayOfStruct(hDefine, OCISvcCtx.hOCIError, BufSkip, IndSkip, LenSkip, 0));

    Field.Handle := hDefine;
  end
  else
    CheckOCI;
end;

procedure TOCICommand.DefineDynamic7(Field: TFieldDesc; Buf: IntPtr; Ind: psb2);
var
  OraType: word;
begin
  CheckOCI73;

  OraType := GetOraType(Field.DataType, Field.SubDataType);

  Check(OCI7.odefinps(FCursorRef.CDA, 0, Field.ActualFieldNo, Buf, MaxBlobSize, OraType, 0,
    Ind, nil, 0, 0, pub2(0), pub2(0), 0, 0, 0, 0));
end;

procedure TOCICommand.DefineDynamic8(Field: TFieldDesc; {Buf: IntPtr; Ind: psb2;}
  Owner: IntPtr; Proc: IntPtr; CharsetId: integer);
var
  OraType: word;
  hDefine: pOCIDefine;
begin
  CheckOCI80;

  OraType := GetOraType(Field.DataType, Field.SubDataType);

  hDefine := nil;
  Check(OCI8.OCIDefineByPos(FCursorRef.OCIStmt, hDefine, OCISvcCtx.hOCIError, Field.ActualFieldNo,
    nil, MaxBlobSize, OraType, nil, nil, nil, OCI_DYNAMIC_FETCH));

  Check(OCI8.OCIDefineDynamic(hDefine, OCISvcCtx.hOCIError, Owner, Proc));

  if CharsetId > 0 then
    Check(OCI8.OCIAttrSet2(hDefine, OCI_HTYPE_DEFINE, CharsetId, 0, OCI_ATTR_CHARSET_ID, OCISvcCtx.hOCIError));

  Field.Handle := hDefine;
end;

function TOCICommand.InternalFetch7(Rows: word): word;
var
  Res: sword;
begin
//  In PtrCDA^.rpc  problem with cursor ???
  FConnection.BusyWait;
    Res := OCI7.ofen(FCursorRef.CDA, Rows);
  FConnection.Release;

  if FCursorRef.CDA.rpc > Cardinal(FFetchedRows) then
    Result := FCursorRef.CDA.rpc - Cardinal(FFetchedRows)
  else begin
    Result := 0;
    Res := OCI_NO_DATA_FOUND;
  end;
  FFetchedRows := FCursorRef.CDA.rpc;

  if Res <> 0 then begin
    if Res = OCI_NO_DATA_FOUND then begin
      InternalCancel;
    end
    else
      Check(Res);
  end;
end;

function TOCICommand.InternalFetch8(Rows: word; Orientation: integer; Offset: integer): word;
var
  Res: sword;
  RowsProc: integer;
  ValueInt: Integer;
begin
  FConnection.BusyWait;
  if Orientation = OCI_FETCH_NEXT then
    Res := OCI8.OCIStmtFetch(FCursorRef.OCIStmt, OCISvcCtx.hOCIError, Rows, OCI_FETCH_NEXT, OCI_DEFAULT)
  else
    Res := OCI8.OCIStmtFetch2(FCursorRef.OCIStmt, OCISvcCtx.hOCIError, Rows, Orientation, Offset, OCI_DEFAULT);
  FConnection.Release;

  Check(OCI8.OCIAttrGet2(FCursorRef.OCIStmt, OCI_HTYPE_STMT, ValueInt, nil, OCI_ATTR_ROW_COUNT, OCISvcCtx.hOCIError));
  RowsProc := Integer(ValueInt);
  if RowsProc > FFetchedRows then
    Result := RowsProc - FFetchedRows
  else
    Result := 0; // bug with 'select level from dual connect by level<=1000' under Direct mode
  FFetchedRows := RowsProc;

  if Res = OCI_NO_DATA then begin
    if not FCursorRef.FScrollable then
      InternalCancel
  end
  else
    try
      Check(Res);
    except
      Finish;
      raise;
    end;
end;

function TOCICommand.InternalExecuteFetch8(Rows: word): word;
var
  Res: sword;
  ValueInt: Integer;
  RowsProc: Integer;
begin
  Res := InternalExecute(OCI_DEFAULT, Rows);

  if Res <> 0 then begin
    Check(OCI8.OCIAttrGet2(FCursorRef.OCIStmt, OCI_HTYPE_STMT, ValueInt, nil, OCI_ATTR_ROW_COUNT, OCISvcCtx.hOCIError));
    RowsProc := Integer(ValueInt);
    Result := RowsProc - FFetchedRows;
    FFetchedRows := RowsProc;

    if Res = OCI_NO_DATA then
      if not FCursorRef.FScrollable then
        InternalCancel;
  end
  else begin
    Check(OCI8.OCIAttrGet2(FCursorRef.OCIStmt, OCI_HTYPE_STMT, ValueInt, nil, OCI_ATTR_ROW_COUNT, OCISvcCtx.hOCIError));
    FFetchedRows := Integer(ValueInt);
    Result := Rows;
  end;
end;

function TOCICommand.InternalFetch(Rows: word; Orientation: integer = OCI_FETCH_NEXT; Offset: integer = 0): word;
var
  FetchingAll: boolean;
begin
  FetchingAll := GetCursorState = csFetchingAll;
  CheckActive;

  if FOCICallStyle = OCI73 then begin
    Result := InternalFetch7(Rows);
  end
  else
  if FOCICallStyle = OCI80 then begin
    if (GetCursorState < csExecuting) then begin
      FetchingAll := GetCursorState = csExecuteFetchAll;
      Result := InternalExecuteFetch8(Rows);
    end
    else
      Result:= InternalFetch8(Rows, Orientation, Offset);
  end
  else begin
    Result := 0;
    CheckOCI;
  end;

  if GetCursorState < csFetching then
    if FetchingAll then
      SetCursorState(csFetchingAll)
    else
      SetCursorState(csFetching);
end;

// For piecewise
function TOCICommand.InternalFetchPiece7: integer;
var
  Res: sword;
begin
  FConnection.BusyWait;
    Res := OCI7.ofen(FCursorRef.CDA, 1);
  FConnection.Release;

  if Res <> 0 then begin
    if Res = OCI_NO_DATA_FOUND then begin
      InternalCancel;
    end
    else
      if Res <> OCI_STILL_IS_PIECE then
        Check(Res);
  end;

  Result := Res;
end;

function TOCICommand.InternalFetchPiece8(Orientation: integer; Offset: integer): integer;
var
  Res: sword;
begin
  FConnection.BusyWait;
    if Orientation = OCI_FETCH_NEXT then
      Res := OCI8.OCIStmtFetch(FCursorRef.OCIStmt, OCISvcCtx.hOCIError, 1, OCI_FETCH_NEXT, OCI_DEFAULT)
    else
      Res := OCI8.OCIStmtFetch2(FCursorRef.OCIStmt, OCISvcCtx.hOCIError, 1, Orientation, Offset, OCI_DEFAULT);
  FConnection.Release;

  if Res <> 0 then begin
    if Res = OCI_NO_DATA then // OCI_SUCCESS_WITH_INFO
      if FCursorRef.FScrollable then
      else
        InternalCancel
    else
      if Res <> OCI_NEED_DATA then
        Check(Res);
  end;

  Result := Res;
end;

function TOCICommand.InternalFetchPiece(Orientation: integer = OCI_FETCH_NEXT; Offset: integer = 0): integer;
begin
  CheckActive;

  if FOCICallStyle = OCI73 then begin
    Result := InternalFetchPiece7;
  end
  else
  if FOCICallStyle = OCI80 then begin
    Result := InternalFetchPiece8(Orientation, Offset);
  end
  else begin
    Result := 0;
    CheckOCI;
  end;

  if GetCursorState < csFetching then
    SetCursorState(csFetching);
end;

procedure TOCICommand.InternalCancel;
begin
  CheckActive;
  FConnection.BusyWait;
  try
    if FOCICallStyle = OCI73 then begin
      Check(OCI7.ocan(FCursorRef.CDA));
    end
    else
    if FOCICallStyle = OCI80 then begin
      //Check(OCIStmtFetch(Cursor.OCIStmt, hOCIError, 0, OCI_FETCH_NEXT, OCI_DEFAULT));
    end
    else
      CheckOCI;
  finally
    FConnection.Release;
    SetCursorState(csFetched);
  end;
end;

procedure TOCICommand.InternalClose;
begin
  CheckOCI73;
  CheckActive;
  Busy;
  try // For Busy
    FConnection.BusyWait;
    try
      Check(OCI7.oclose(FCursorRef.CDA));
    finally
      FConnection.Release;
      SetCursorState(csInactive);
    end;
  finally
    Release;
  end;
end;

procedure TOCICommand.Finish;
begin
  CheckActive;

  try
    if FOCICallStyle = OCI73 then begin
      try
        InternalClose;
      finally
        FCursorRef.FreeCursor;
      end;
    end
    else
    if FOCICallStyle = OCI80 then begin
      Busy;
      try
        FConnection.BusyWait;
        try
        // Free statement handle
          FCursorRef.FreeCursor;
        finally
          FConnection.Release;
        end;
      finally
        Release;
      end;
    end
    else
      CheckOCI;
  finally
    SetCursorState(csInactive);
    FSQLType := SQL_UNKNOWN;
  end;
end;

procedure TOCICommand.Close;
begin
  Finish;

  ReleaseOCISvcCtx;

  inherited;
end;

function TOCICommand.NativeCursor: boolean;
begin
  Result := FCursorRef = FCursor;
end;

function TOCICommand.RowsReturn: boolean;
begin
  Result := (FSQLType = SQL_SELECT) or
    (FCursorRef <> FCursor) and (FCursorRef.State >= csExecuted);
end;

// Check return SQL statement rows
procedure TOCICommand.CheckRowsReturn;
begin
  if not RowsReturn then
    RaiseError(SNotRows);
end;

procedure TOCICommand.GetPI(var Handle: pOCIHandle; var Piece: byte;
  var Buf: IntPtr; var Iteration: cardinal; var Index: cardinal; var Mode: TParamDirection);
var
  Res: sword;
  HType: ub4;
  IOMode: ub1;
  hIteration, hIndex, hPiece: IntPtr;
  hHType: IntPtr;
  hIOMode: IntPtr;
begin
  if FOCICallStyle = OCI73 then begin
    FConnection.BusyWait;
    Res := OCI7.ogetpi(FCursorRef.CDA, Piece, Buf, Iteration, Index);
    FConnection.Release;

    Check(Res);
    Handle := nil;
    HType := 0;
    Mode := pdUnknown;
  end
  else
  if FOCICallStyle = OCI80 then begin
    hIteration := OrdinalToPtr(Iteration);
    hIndex := OrdinalToPtr(Index);
    hPiece := OrdinalToPtr(Piece);
    hHType := AllocOrdinal(HType);
    hIOMode := AllocOrdinal(IOMode);
    try
      FConnection.BusyWait;
        Res := OCI8.OCIStmtGetPieceInfo(FCursorRef.OCIStmt, OCISvcCtx.hOCIError, Handle, hHType,
          hIOMode, hIteration, hIndex, hPiece);
      FConnection.Release;
    finally
      PtrToOrdinal(hIteration, Iteration);
      PtrToOrdinal(hIndex, Index);
      PtrToOrdinal(hPiece, Piece);
      PtrToOrdinal(hHType, HType);
      PtrToOrdinal(hIOMode, IOMode);
    end;

    Check(Res);
    case IOMode of
      OCI_PARAM_IN:
        Mode := pdInput;
      OCI_PARAM_OUT:
        Mode := pdOutput;
    else
      Mode := pdUnknown;
    end;
  end
  else
    CheckOCI;
end;

procedure TOCICommand.SetPI(Handle: pOCIHandle; HType: cardinal; Piece: byte;
  Buf: IntPtr; var BufLen: cardinal; Ind: psb2);
var
  Res: sword;
  HGlobal: IntPtr;
begin
  if FOCICallStyle = OCI73 then begin
    FConnection.BusyWait;
    Res := OCI7.osetpi(FCursorRef.CDA, Piece, Buf, BufLen);
    FConnection.Release;

    Check(Res);
  end
  else
  if FOCICallStyle = OCI80 then begin
    HGlobal := OrdinalToPtr(BufLen);
    try
      FConnection.BusyWait;
        Res := OCI8.OCIStmtSetPieceInfo(Handle, HType, OCISvcCtx.hOCIError, Buf, HGlobal, Piece, Ind, nil);
      FConnection.Release;
    finally
      PtrToOrdinal(HGlobal, BufLen);
    end;

    Check(Res);
  end
  else
    CheckOCI;
end;

/// DescSP performs low-level call of the SYS.DBMS_DESCRIBE.DESCRIBE_PROCEDURE
/// to retrieve procedure params. Should be used in InitProcParams7 instead of
/// odessp in Direct mode.
{$IFNDEF VER7P}
{$O-}
{$ENDIF}
function TOCICommand.DescSP(const objnam: string; ovrld: pub2; pos: pub2; level: pub2;
  argnam: IntPtr; arnlen: pub2; dtype: pub2; defsup: pub1; mode: pub1;
  dtsiz: pub4; prec: psb2; scale: psb2; radix: pub1;
  spare: pub4; var arrsiz: ub4): sword;
var
  hOCIStmt: pOCIStmt;
  SQLText: string;
  hBind: pOCIBind;
  i, Size: integer;
  Indicator: IntPtr;
  p, PObjName, PArrSize: IntPtr;
  //ValuePtr: Integer;
begin
  {Result := OCIAttrGet2(FConnection.GetSvcCtx, OCI_HTYPE_SVCCTX, ValuePtr, nil, OCI_ATTR_ENV, hOCIError);
  if Result <> OCI_SUCCESS then
    Exit;}

/// alloc statement handle
  Result := OCI8.OCIHandleAlloc(OCISvcCtx.hOCIEnv, hOCIStmt, OCI_HTYPE_STMT, 0, nil);
  if Result <> OCI_SUCCESS then
    Exit;

  try
  /// prepare
    SQLText :=
      'begin' +
      ' sys.dbms_describe.describe_procedure(:object_name, null, null, :overload,' +
      ' :position, :level, :argument, :datatype, :default, :in_out, :length,' +
      ' :precision, :scale, :radix, :spare);' +
      'end;';
    p := StringToHGlobalOCI(SQLText, Size, OCISvcCtx.UnicodeEnv);
    try
      Result := OCI8.OCIStmtPrepare(hOCIStmt, OCISvcCtx.hOCIError, p, Size, OCI_NTV_SYNTAX, OCI_DEFAULT);
    finally
      FreeStringOCI(p, OCISvcCtx.UnicodeEnv);
    end;
    if Result <> OCI_SUCCESS then
      Exit;

  /// bind object_name param
    PObjName := StringToHGlobalOCI(objnam, Size, False);
    try
      Result := OCI8.OCIBindByPos(hOCIStmt, hBind, OCISvcCtx.hOCIError, 1, PObjName, Size + 1,
        SQLT_STR, nil, nil, nil, 0, nil, OCI_DEFAULT);
      if Result <> OCI_SUCCESS then
        Exit;

    /// bind overload param
      PArrSize := OrdinalToPtr(arrsiz);
      try
        Result := OCI8.OCIBindByPos(hOCIStmt, hBind, OCISvcCtx.hOCIError, 2, ovrld,
          sizeof(ub2), SQLT_INT, nil, nil, nil, arrsiz, PArrSize, OCI_DEFAULT);

        if Result <> OCI_SUCCESS then
          Exit;
        Result := OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, sizeof(ub2), 0, 0, 0);
        if Result <> OCI_SUCCESS then
          Exit;

      /// bind position param
        Result := OCI8.OCIBindByPos(hOCIStmt, hBind, OCISvcCtx.hOCIError, 3, pos,
          sizeof(ub2), SQLT_INT, nil, nil, nil, arrsiz, PArrSize, OCI_DEFAULT);
        if Result <> OCI_SUCCESS then
          Exit;
        Result := OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, sizeof(ub2), 0, 0, 0);
        if Result <> OCI_SUCCESS then
          Exit;

      /// bind level param
        Result := OCI8.OCIBindByPos(hOCIStmt, hBind, OCISvcCtx.hOCIError, 4, level,
          sizeof(ub2), SQLT_INT, nil, nil, nil, arrsiz, PArrSize, OCI_DEFAULT);
        if Result <> OCI_SUCCESS then
          Exit;
        Result := OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, sizeof(ub2), 0, 0, 0);
        if Result <> OCI_SUCCESS then
          Exit;

      /// bind argument param
        for i := 0 to Marshal.ReadInt32(PArrSize) - 1 do
          Marshal.WriteInt16(arnlen, sizeof(ub2) * i + 30);
      /// indicator is needed to allow NULL arument name values (i.e Result)
        Indicator := Marshal.AllocHGlobal(2 * Marshal.ReadInt32(PArrSize));
        try
          Result := OCI8.OCIBindByPos(hOCIStmt, hBind, OCISvcCtx.hOCIError, 5, argnam,
            31, SQLT_CHR, Indicator, arnlen, nil, arrsiz, PArrSize, OCI_DEFAULT);
          if Result <> OCI_SUCCESS then
            Exit;
          Result := OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, 30, sizeof(sb2), sizeof(ub2), 0);
          if Result <> OCI_SUCCESS then
            Exit;

        /// bind datatype param
          Result := OCI8.OCIBindByPos(hOCIStmt, hBind, OCISvcCtx.hOCIError, 6, dtype,
            sizeof(ub2), SQLT_INT, nil, nil, nil, arrsiz, PArrSize, OCI_DEFAULT);
          if Result <> OCI_SUCCESS then
            Exit;
          Result := OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, sizeof(ub2), 0, 0, 0);
          if Result <> OCI_SUCCESS then
            Exit;

        /// bind default param
          Result := OCI8.OCIBindByPos(hOCIStmt, hBind, OCISvcCtx.hOCIError, 7, defsup,
            sizeof(ub1), SQLT_INT, nil, nil, nil, arrsiz, PArrSize, OCI_DEFAULT);
          if Result <> OCI_SUCCESS then
            Exit;
          Result := OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, sizeof(ub1), 0, 0, 0);
          if Result <> OCI_SUCCESS then
            Exit;

        /// bind in_out param
          Result := OCI8.OCIBindByPos(hOCIStmt, hBind, OCISvcCtx.hOCIError, 8, mode,
            sizeof(ub1), SQLT_INT, nil, nil, nil, arrsiz, PArrSize, OCI_DEFAULT);
          if Result <> OCI_SUCCESS then
            Exit;
          Result := OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, sizeof(ub1), 0, 0, 0);
          if Result <> OCI_SUCCESS then
            Exit;

        /// bind length param
          Result := OCI8.OCIBindByPos(hOCIStmt, hBind, OCISvcCtx.hOCIError, 9, dtsiz,
            sizeof(ub4), SQLT_INT, nil, nil, nil, arrsiz, PArrSize, OCI_DEFAULT);
          if Result <> OCI_SUCCESS then
            Exit;
          Result := OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, sizeof(ub4), 0, 0, 0);
          if Result <> OCI_SUCCESS then
            Exit;

        /// bind precision param
          Result := OCI8.OCIBindByPos(hOCIStmt, hBind, OCISvcCtx.hOCIError, 10, prec,
            sizeof(sb2), SQLT_INT, nil, nil, nil, arrsiz, PArrSize, OCI_DEFAULT);
          if Result <> OCI_SUCCESS then
            Exit;
          Result := OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, sizeof(sb2), 0, 0, 0);
          if Result <> OCI_SUCCESS then
            Exit;

        /// bind scale param
          Result := OCI8.OCIBindByPos(hOCIStmt, hBind, OCISvcCtx.hOCIError, 11, scale,
            sizeof(sb2), SQLT_INT, nil, nil, nil, arrsiz, PArrSize, OCI_DEFAULT);
          if Result <> OCI_SUCCESS then
            Exit;
          Result := OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, sizeof(sb2), 0, 0, 0);
          if Result <> OCI_SUCCESS then
            Exit;

        /// bind radix param
          Result := OCI8.OCIBindByPos(hOCIStmt, hBind, OCISvcCtx.hOCIError, 12, radix,
            sizeof(ub1), SQLT_INT, nil, nil, nil, arrsiz, PArrSize, OCI_DEFAULT);
          if Result <> OCI_SUCCESS then
            Exit;
          Result := OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, sizeof(ub1), 0, 0, 0);
          if Result <> OCI_SUCCESS then
            Exit;

        /// bind spare param
          Result := OCI8.OCIBindByPos(hOCIStmt, hBind, OCISvcCtx.hOCIError, 13, spare,
            sizeof(ub4), SQLT_INT, nil, nil, nil, arrsiz, PArrSize, OCI_DEFAULT);
          if Result <> OCI_SUCCESS then
            Exit;
          Result := OCI8.OCIBindArrayOfStruct(hBind, OCISvcCtx.hOCIError, sizeof(ub4), 0, 0, 0);
          if Result <> OCI_SUCCESS then
            Exit;

        /// execute statement
          Result := OCI8.OCIStmtExecute(OCISvcCtx.hOCISvcCtx, hOCIStmt, OCISvcCtx.hOCIError, 1, 0, nil, nil, OCI_DEFAULT);
          if Result <> OCI_SUCCESS then
            Exit;

        finally
          Marshal.FreeHGlobal(Indicator);
        end;
      finally
        PtrToOrdinal(PArrSize, arrsiz);
      end;
    finally
      FreeStringOCI(PObjName, False);
    end;
  finally
    /// free statement handle
    OCI8.OCIHandleFree(hOCIStmt, OCI_HTYPE_STMT);
  end;
end;


procedure TOCICommand.InitProcParams7(Name: string; Overload: integer);
const
  MaxParams = 150;

  DBMS_TIME          = 178;
  DBMS_TIME_TZ       = 179;
  DBMS_TIMESTAMP     = 180;
  DBMS_TIMESTAMP_TZ  = 181;
  DBMS_TIMESTAMP_LTZ = 231;
var
  ovrld: IntPtr;
  pos: IntPtr;
  level: IntPtr;
  argnm: IntPtr;
  arnlen: IntPtr;
  dtype: IntPtr;
  defsup: IntPtr;
  mode: IntPtr;
  dtsize: IntPtr;
  prec: IntPtr;
  scale: IntPtr;
  radix: IntPtr;
  spare: IntPtr;
  arrsize: ub4;
  i: word;
  Param: TOraParamDesc;
  Table: boolean;
  TableLength, OraType: integer;
  Res: sword;
//  Msg: array [0..512] of char;
  ParamName: string;
  ParamIndex: integer;
  ParamOverload: integer;
begin
  arrsize := MaxParams;

  ovrld := Marshal.AllocHGlobal( (MaxParams + 1) * 2);
  pos := Marshal.AllocHGlobal( (MaxParams + 1) * 2);
  level := Marshal.AllocHGlobal( (MaxParams + 1) * 2);
  argnm := Marshal.AllocHGlobal( (MaxParams + 1) * 30);
  arnlen := Marshal.AllocHGlobal( (MaxParams + 1) * 2);
  dtype := Marshal.AllocHGlobal( (MaxParams + 1) * 2);
  defsup := Marshal.AllocHGlobal( MaxParams + 1 );
  mode := Marshal.AllocHGlobal( MaxParams + 1 );
  dtsize := Marshal.AllocHGlobal( (MaxParams + 1) * 4);
  prec := Marshal.AllocHGlobal( (MaxParams + 1) * 2);
  scale := Marshal.AllocHGlobal( (MaxParams + 1) * 2);
  radix := Marshal.AllocHGlobal( MaxParams + 1 );
  spare := Marshal.AllocHGlobal( (MaxParams + 1) * 4);
  try
    if OCI73 in OCISvcCtx.Home.PossibleOCICallStyles then
      Res := OCI7.odessp(FConnection.GetLDA, PAnsiChar(AnsiString(Name)), NativeUInt(-1), nil, 0, nil, 0, ovrld,
        pos, level, argnm, arnlen, dtype, defsup, mode, dtsize, prec,
        scale, radix, spare, arrsize)
    else
      Res := DescSP(Name, ovrld,
        pos, level, argnm, arnlen, dtype, defsup, mode, dtsize,
        prec, scale, radix, spare, arrsize);

    if Res <> 0 then begin  // for using with OCI8 and UseOCI7ProcDesc = True
      if OCI73 in OCISvcCtx.Home.PossibleOCICallStyles then
        FConnection.OraError(OCI73, Res, True, Component)
      else
        FConnection.OraError(OCI80, Res, True, Component);
  //      oerhms(FConnection.GetLDA, Res, Msg, 512);
  //      raise EOraError.Create(Abs(Res), Msg);
    end;

    Assert(arrsize < MaxParams);

    FParams.Clear;

    Param := nil;
    Table := False;
    TableLength := 0;

    // Overload 0 and 1 is equal
    if Overload = 0 then
      Overload := 1;

    i := 0;
    while i < arrsize do begin
      ParamOverload := Marshal.ReadInt16(ovrld, i * 2);
      // Overload 0 and 1 is equal
      if ParamOverload = 0 then
        ParamOverload := 1;
      if (Marshal.ReadInt16(dtype, i * 2) <> UNKNOWN_TYPE) and (ParamOverload = Overload) then begin
        if Marshal.ReadInt16(level, i * 2) = 0 then begin
          Param := TOraParamDesc(AddParam);

          if Marshal.ReadInt16(pos, i * 2) = 0 then begin
            Param.Name := 'RESULT';

            Param.ParamType := pdResult;
          end
          else begin
            ParamName := string(Marshal.PtrToStringAnsi(PtrOffset(argnm, i * 30), Marshal.ReadInt16(arnlen, i * 2)));
            ParamName := StringReplace(ParamName, ' ' , '_', [rfReplaceAll]);
            if FParams.FindParam(ParamName) <> nil then begin
              ParamIndex := 1;
              while FParams.FindParam(ParamName + '_' + IntToStr(ParamIndex)) <> nil do
                Inc(ParamIndex);
              ParamName := ParamName + '_' + IntToStr(ParamIndex);
            end;
            Param.Name := ParamName;

            case Marshal.ReadByte(mode, i) of
              0: Param.ParamType := pdInput;
              1: Param.ParamType := pdOutput;
              2: Param.ParamType := pdInputOutput;
            end;

            Param.SetHasDefault(Boolean(Marshal.ReadByte(defsup, i)));
          end;
        end;

        Assert(Param <> nil);

        if (Marshal.ReadInt16(level, i * 2) = 0) or Table then begin
          OraType := Marshal.ReadInt16(dtype, i * 2);
          case OraType of
            VARCHAR2_TYPE: begin
            {$IFNDEF LITE}
              if FConnection.FUseUnicode then
                Param.DataType := dtWideString
              else
            {$ENDIF}
                Param.DataType := dtString;
              if Marshal.ReadInt32(dtsize, i * 4) > 0 then
                Param.Size := Marshal.ReadInt32(dtsize, i * 4);
            end;
            CHAR_TYPE: begin
            {$IFNDEF LITE}
              if FConnection.FUseUnicode then
                Param.DataType := dtFixedWideChar
              else
            {$ENDIF}
                Param.DataType := dtFixedChar;
              if Marshal.ReadInt32(dtsize, i * 4) > 0 then
                Param.Size := Marshal.ReadInt32(dtsize, i * 4);
            end;
            NUMBER_TYPE:
              if not FConnection.FEnableIntegers or (Abs(Marshal.ReadInt16(scale, i * 2)) > 0)
                or (Marshal.ReadInt16(prec, i * 2) > GetIntegerPrecision) or (Marshal.ReadInt16(prec, i * 2) = 0)
              then begin
                Param.DataType := dtFloat;
              end
              else
                Param.DataType := dtInteger;
            INTEGER_TYPE:
              Param.DataType := dtInteger;
            DATE_TYPE,
            DBMS_TIME, DBMS_TIME_TZ:
              Param.DataType := dtDateTime;
            ROWID_TYPE: begin
              Param.DataType := dtString;
              Param.Size := RowIdSize + 1;
            end;
            RAW_TYPE: begin
              Param.DataType := dtVarBytes;
              if Marshal.ReadInt32(dtsize, i * 4) > 0 then
                Param.Size := Marshal.ReadInt32(dtsize, i * 4);
            end;
            LONG_TYPE:
            {$IFNDEF LITE}
              if FConnection.FUseUnicode then
                Param.DataType := dtWideMemo
              else
            {$ENDIF}
                Param.DataType := dtMemo;
            LONGRAW_TYPE:
              Param.DataType := dtBlob;
            CURSOR_TYPE: begin
              Param.DataType := dtCursor;
              //Param.FParamType := pdOutput
            end;
            SQLT_TAB: begin
              Table := True;
              TableLength := 1;
            end;
            SQLT_BOL:
              Param.DataType := dtBoolean;
            SQLT_REC: begin
              //Rec := True;
            end;
          // Oracle8 types
            SQLT_CLOB:
              Param.DataType := dtOraClob;
            SQLT_BLOB:
              Param.DataType := dtOraBlob;
            SQLT_BFILEE:
              Param.DataType := dtBFILE;
            SQLT_CFILEE:
              Param.DataType := dtCFILE;
            SQLT_RSET:
              Param.DataType := dtCursor;
            SQLT_NTY:
              Param.DataType := dtObject;//TOraType(Field.ObjectType).DataType;
            SQLT_REF:
              Param.DataType := dtReference;
            SQLT_NCO:
              Param.DataType := dtTable;
            SQLT_VARRAY:
              Param.DataType := dtArray;
          // Oracle9 types
            SQLT_TIMESTAMP, SQLT_TIMESTAMP_TZ, SQLT_TIMESTAMP_LTZ,
            DBMS_TIMESTAMP, DBMS_TIMESTAMP_TZ, DBMS_TIMESTAMP_LTZ: begin
            {$IFDEF VER6P}
            {$IFNDEF FPC}
              if FConnection.FEnableSQLTimeStamp then
                Param.DataType := dtSQLTimeStamp
            {$ELSE}
              if FConnection.FTimeStampAsString then
                Param.DataType := dtDateTime
            {$ENDIF}
              else
            {$ENDIF}
                case OraType of
                  SQLT_TIMESTAMP, DBMS_TIMESTAMP:
                    Param.DataType := dtTimeStamp;
                  SQLT_TIMESTAMP_TZ, DBMS_TIMESTAMP_TZ:
                    Param.DataType := dtTimeStampTZ;
                  SQLT_TIMESTAMP_LTZ, DBMS_TIMESTAMP_LTZ:
                    Param.DataType := dtTimeStampLTZ;
                end;
            end;
            SQLT_INTERVAL_YM:
              Param.DataType := dtIntervalYM;
            SQLT_INTERVAL_DS:
              Param.DataType := dtIntervalDS;
          else
            RaiseError(SUnsupportedDataType + ' [' + IntToStr(Marshal.ReadInt16(dtype, i * 2)) + ']')
          end;
        end;

        if Marshal.ReadInt16(level, i * 2) > 0 then
          if Table then begin
          // for PL/SQL table
            Param.FTable := Table;
            Param.FLength := TableLength;
            Table := False;
            TableLength := 0;
          end;
        if (Param.ValuePtr = nil) and not Table then
          Param.AllocBuffer;
      end;
      Inc(i);
    end;
  finally
    Marshal.FreeHGlobal(argnm);
    Marshal.FreeHGlobal(ovrld);
    Marshal.FreeHGlobal(pos);
    Marshal.FreeHGlobal(level);
    Marshal.FreeHGlobal(arnlen);
    Marshal.FreeHGlobal(dtype);
    Marshal.FreeHGlobal(defsup);
    Marshal.FreeHGlobal(mode);
    Marshal.FreeHGlobal(dtsize);
    Marshal.FreeHGlobal(prec);
    Marshal.FreeHGlobal(scale);
    Marshal.FreeHGlobal(radix);
    Marshal.FreeHGlobal(spare);
  end;
end;

procedure TOCICommand.InitProcParams8(Name: string; Overload: integer);

  function DescribeSynonym(const SynonymName: string): string;
  var
    Handle: IntPtr;
    hDescribe: pOCIDescribe;
    b1: Integer; //byte
    hParam: pOCIParam;
    Len: Integer;
    Ptr, ValuePtr, StrPtr: IntPtr;
    ValueInt: Integer;
    ObjType: byte;
    Res, Size: integer;
  begin
    Result := SynonymName;
    Check(OCI8.OCIHandleAlloc(OCISvcCtx.hOCIEnv, hDescribe, OCI_HTYPE_DESCRIBE, 0, nil));
    try
      b1 := 1;
      Check(OCI8.OCIAttrSet2(hDescribe, OCI_HTYPE_DESCRIBE, b1, 0, OCI_ATTR_DESC_PUBLIC, OCISvcCtx.hOCIError));
      Ptr := Marshal.AllocHGlobal(sizeof(integer));
      try
        while True do begin
          Handle := StringToHGlobalOCI(Result, Size, OCISvcCtx.UnicodeEnv);
          Res := OCI8.OCIDescribeAny(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, Handle, Size,
            OCI_OTYPE_NAME, OCI_DEFAULT, OCI_PTYPE_UNK, hDescribe);
          FreeStringOCI(Handle, OCISvcCtx.UnicodeEnv);
          Check(Res);

          ValuePtr := OrdinalToPtr(hParam);
          try
            Check(OCI8.OCIAttrGet1(hDescribe, OCI_HTYPE_DESCRIBE, ValuePtr, nil,
              OCI_ATTR_PARAM, OCISvcCtx.hOCIError));
          finally
            PtrToOrdinal(ValuePtr, hParam);
          end;

          Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil,
            OCI_ATTR_PTYPE, OCISvcCtx.hOCIError));
          ObjType := Byte(ValueInt);

          case ObjType of
            OCI_PTYPE_TYPE:
              Break;
            OCI_PTYPE_SYN: begin
              StrPtr := nil;
              ValuePtr := OrdinalToPtr(StrPtr);
              try
                Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, Ptr, OCI_ATTR_NAME, OCISvcCtx.hOCIError));
              finally
                PtrToOrdinal(ValuePtr, StrPtr);
              end;
              Len := Cardinal(Marshal.ReadInt32(Ptr));
              Result := OCISQLInfo.QuoteIfNeed(PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv));

              StrPtr := nil;
              ValuePtr := OrdinalToPtr(StrPtr);
              try
                Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, Ptr, OCI_ATTR_SCHEMA_NAME, OCISvcCtx.hOCIError));
              finally
                PtrToOrdinal(ValuePtr, StrPtr);
              end;
              Len := Cardinal(Marshal.ReadInt32(Ptr));
              if Len > 0 then
                Result := OCISQLInfo.QuoteIfNeed(PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv)) + '.' + Result;
            end
          else
            RaiseOraError(4043, Format(SObjectNotExist, [Name]));
          end;
        end;
      finally
        Marshal.FreeHGlobal(Ptr);
      end;
    finally
      Check(OCI8.OCIHandleFree(hDescribe, OCI_HTYPE_DESCRIBE));
    end;
  end;

var
  Res: sword;
  i, BufSize: integer;
  Param: TOraParamDesc;
  hDescribe: pOCIDescribe;
  hParam: pOCIParam;
  hArgList: pOCIParam;
  hArgList1: pOCIParam; // arguments of level 1
  hArg: pOCIParam;
  hProcList: pOCIParam;
  ArgCount: word;
  pName: string;
  Len: cardinal;
  OraType: word;
  Size: word;
  Scale: shortint;
  Prec: word; // ??? byte
  Mode: byte;
  ProcCount: word;
  ListType: byte;
  lOverload: word;
  d1,d2: integer;
  St,St1: string;
  ObjType: byte;
  b1: Integer; //byte
  iOffset: integer;
  Handle: IntPtr;
  ValuePtr, StrPtr: IntPtr;
  ValueInt: Integer;
  PLen: IntPtr;
  TypeName, SchemaName: string;
  ObjectType: TOraType;
  OraObject: TOraObject;
  IsEqual: boolean;
  ParamName: string;
  ParamIndex: Integer;
begin
  Check(OCI8.OCIHandleAlloc(OCISvcCtx.hOCIEnv, hDescribe, OCI_HTYPE_DESCRIBE, 0, nil));
  Check(OCI8.OCIAttrSet2(hDescribe, OCI_HTYPE_DESCRIBE, b1, 0, OCI_ATTR_DESC_PUBLIC, OCISvcCtx.hOCIError));
  try
    if Overload = 1 then
      Overload := 0;
    lOverload := 0;

    PLen  := Marshal.AllocHGlobal(sizeof(Integer));
    try
      while True do begin
        d1 := Pos('.', Name);
        if d1 > 0 then begin
          d2 := Pos('.', Copy(Name, d1 + 1, Length(Name)));
          if d2 > 0 then
            inc(d2, d1);
        end
        else
          d2 :=0;

      { Get the describe handle }
        if d2 > 0 then
          St := Copy(Name, 1, d2 - 1)
        else
          St := Name;

        Handle := StringToHGlobalOCI(St, BufSize, OCISvcCtx.UnicodeEnv);
        Res := OCI8.OCIDescribeAny(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, Handle, BufSize,
          OCI_OTYPE_NAME, 0, OCI_PTYPE_UNK, hDescribe);
        FreeStringOCI(Handle, OCISvcCtx.UnicodeEnv);

        if (Res <> 0) and (d1 > 0) and (d2 = 0) then begin
        // for <package>.<proc>
          St := Copy(Name, 1, d1 - 1);
          Handle := StringToHGlobalOCI(St, BufSize, OCISvcCtx.UnicodeEnv);
          Res := OCI8.OCIDescribeAny(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, Handle, BufSize,
            OCI_OTYPE_NAME, 0, OCI_PTYPE_UNK, hDescribe);
          FreeStringOCI(Handle, OCISvcCtx.UnicodeEnv);
          Check(Res);
        end
        else
          Check(Res);

        if d2 = 0 then
          d2 := d1;

        ValuePtr := OrdinalToPtr(hParam);
        try
          Check(OCI8.OCIAttrGet1(hDescribe, OCI_HTYPE_DESCRIBE, ValuePtr, nil, OCI_ATTR_PARAM, OCISvcCtx.hOCIError));
        finally
          PtrToOrdinal(ValuePtr, hParam);
        end;

        Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil,
          OCI_ATTR_PTYPE, OCISvcCtx.hOCIError));
        ObjType := Byte(ValueInt);

        case ObjType of
          OCI_PTYPE_PROC, OCI_PTYPE_FUNC: begin

          end;
          OCI_PTYPE_PKG, OCI_PTYPE_TYPE : begin
          // Describe package proc
          // Describe object methods

          { Get the parameter handle }
            ValuePtr := OrdinalToPtr(hParam);
            try
              Check(OCI8.OCIAttrGet1(hDescribe, OCI_HTYPE_DESCRIBE, ValuePtr, nil,
                OCI_ATTR_PARAM, OCISvcCtx.hOCIError));
            finally
              PtrToOrdinal(ValuePtr, hParam);
            end;

            if ObjType = OCI_PTYPE_PKG then begin
            { Get the subprogram list }
              ValuePtr := OrdinalToPtr(hProcList);
              try
                Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, nil,
                  OCI_ATTR_LIST_SUBPROGRAMS, OCISvcCtx.hOCIError));
              finally
                PtrToOrdinal(ValuePtr, hProcList);
              end;

              iOffset := 0;
            end
            else begin
            { Get the method list }
              ValuePtr := OrdinalToPtr(hProcList);
              try
                Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, nil,
                  OCI_ATTR_LIST_TYPE_METHODS, OCISvcCtx.hOCIError));
              finally
                PtrToOrdinal(ValuePtr, hProcList);
              end;

              iOffset := 1;
            end;

          { Get the number of procs }
            Check(OCI8.OCIAttrGet2(hProcList, OCI_DTYPE_PARAM, ValueInt, nil,
              OCI_ATTR_NUM_PARAMS, OCISvcCtx.hOCIError));
            ProcCount := Word(ValueInt);

            St := Copy(Name, d2 + 1, Length(Name));
            i := iOffset;
            lOverload := 0;
            while i < ProcCount + iOffset do begin
            { Get the parameter handle }
              Check(OCI8.OCIParamGet(hProcList, OCI_DTYPE_PARAM, OCISvcCtx.hOCIError, hParam, i));  // hProc

              try
                StrPtr := nil;
                ValuePtr := OrdinalToPtr(StrPtr);
                try
                  Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, PLen, OCI_ATTR_NAME, OCISvcCtx.hOCIError));
                finally
                  PtrToOrdinal(ValuePtr, StrPtr);
                end;
                Len := Cardinal(Marshal.ReadInt32(PLen));
                St1 := PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv);

                if OCISQLInfo.IsQuoted(St) then
                  IsEqual := OCISQLInfo.UnQuote(St) = St1
                else
                  IsEqual := AnsiUpperCase(St) = St1;

                if IsEqual then begin
                  if Overload > 0 then
                    Inc(lOverload);
                  if lOverload = Overload then
                    break;
                end;

              finally
                // free memory after OCIParamGet
                OCI8.OCIDescriptorFree(hParam, OCI_DTYPE_PARAM);
              end;

              Inc(i);
            end;

            if i = ProcCount + iOffset then
              RaiseOraError(4043, Format(SObjectNotExist, [Name]));
          end;
          OCI_PTYPE_SYN: begin
          // Describe synonyms
            if d2 > 0 then
              Name := '.' + Copy(Name, d2 + 1, Length(Name))
            else
              Name := '';

            StrPtr := nil;
            ValuePtr := OrdinalToPtr(StrPtr);
            try
              Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, PLen,
                OCI_ATTR_NAME, OCISvcCtx.hOCIError));
            finally
              PtrToOrdinal(ValuePtr, StrPtr);
            end;
            Len := Cardinal(Marshal.ReadInt32(PLen));
            pName := OCISQLInfo.QuoteIfNeed(PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv));
            Name := pName + Name;

            StrPtr := nil;
            ValuePtr := OrdinalToPtr(StrPtr);
            try
              Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, PLen,
                OCI_ATTR_SCHEMA_NAME, OCISvcCtx.hOCIError));
            finally
              PtrToOrdinal(ValuePtr, StrPtr);
            end;
            Len := Cardinal(Marshal.ReadInt32(PLen));
            pName := OCISQLInfo.QuoteIfNeed(PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv));
            Name := pName + '.' + Name;

            Continue;
          end;
          //OCI_PTYPE_SCHEMA:
        else
          RaiseOraError(4043, Format(SObjectNotExist, [St]));
        end;

      { Get the arg list }
        ValuePtr := OrdinalToPtr(hArgList);
        try
          Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, nil,
            OCI_ATTR_LIST_ARGUMENTS, OCISvcCtx.hOCIError));
        finally
          PtrToOrdinal(ValuePtr, hArgList);
        end;

      { Get the number of arguments }
        Check(OCI8.OCIAttrGet2(hArgList, OCI_DTYPE_PARAM, ValueInt, nil,
          OCI_ATTR_NUM_PARAMS, OCISvcCtx.hOCIError));
        ArgCount := Word(ValueInt);

        ListType := 0;
        if (OCISvcCtx.Home.OCIVersion < 8100) then begin
          if (ObjType = OCI_PTYPE_FUNC)
          /// Test param at zero position for package subprogram. It won't return
          /// error in case of function.
            or ((ObjType = OCI_PTYPE_PKG)
            and (OCI8.OCIParamGet(hArgList, OCI_DTYPE_PARAM, OCISvcCtx.hOCIError, hArg, 0) = 0))
          then
            ListType := OCI_LTYPE_ARG_FUNC
        end
        else begin
        /// Get the type of subproram for 8.1.5 and above. In 8.0.x client attribute
        /// OCI_ATTR_LTYPE is not supported.
          Check(OCI8.OCIAttrGet2(hArgList, OCI_DTYPE_PARAM, ValueInt, nil,
            OCI_ATTR_LTYPE, OCISvcCtx.hOCIError));
          ListType := Byte(ValueInt);
        end;

        FParams.Clear;

        Param := nil;
        hArgList1 := nil;

        if ListType in [OCI_LTYPE_ARG_FUNC, OCI_LTYPE_TYPE_ARG_FUNC] then begin // IsFunc
          i := 0;
          if ListType in [OCI_LTYPE_ARG_FUNC] then
            Dec(ArgCount);
        end
        else
          // OCI_LTYPE_ARG_PROC, OCI_LTYPE_TYPE_ARG_PROC
          i := 1;

        while i <= ArgCount do begin
          if hArgList1 = nil then
            Check(OCI8.OCIParamGet(hArgList, OCI_DTYPE_PARAM, OCISvcCtx.hOCIError, hArg, i))
          else
            Check(OCI8.OCIParamGet(hArgList1, OCI_DTYPE_PARAM, OCISvcCtx.hOCIError, hArg, 1));

          try
            Check(OCI8.OCIAttrGet2(hArg, OCI_DTYPE_PARAM, ValueInt, nil,
              OCI_ATTR_PTYPE, OCISvcCtx.hOCIError));
            ObjType := Byte(ValueInt);

            //Check(OCIAttrGet(hArg, OCI_DTYPE_PARAM, @Level, nil, OCI_ATTR_LEVEL, OCISvcCtx.hOCIError));
            Check(OCI8.OCIAttrGet2(hArg, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_DATA_TYPE, OCISvcCtx.hOCIError));
            OraType := Word(ValueInt);

            if (OraType <> SQLT_UNK) and (lOverload = Overload) then begin
              if hArgList1 = nil then begin
                if i > 0 then begin
                  StrPtr := nil;
                  ValuePtr := OrdinalToPtr(StrPtr);
                  try
                    Check(OCI8.OCIAttrGet1(hArg, OCI_DTYPE_PARAM, ValuePtr, PLen, OCI_ATTR_NAME, OCISvcCtx.hOCIError));
                  finally
                    PtrToOrdinal(ValuePtr, StrPtr);
                  end;
                  Len := Cardinal(Marshal.ReadInt32(PLen));
                  ParamName := PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv);
                  ParamName := StringReplace(ParamName, ' ' , '_', [rfReplaceAll]);
                  if FParams.FindParam(ParamName) <> nil then begin
                    ParamIndex := 1;
                    while FParams.FindParam(ParamName + '_' + IntToStr(ParamIndex)) <> nil do
                      Inc(ParamIndex);
                    ParamName := ParamName + '_' + IntToStr(ParamIndex);
                  end;
                end;
                Check(OCI8.OCIAttrGet2(hArg, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_IOMODE, OCISvcCtx.hOCIError));
                Mode := Byte(ValueInt);

                Param := TOraParamDesc(AddParam);
                if i > 0 then begin
                  Param.Name := ParamName;

                  case Mode of
                    0: Param.ParamType := pdInput;
                    1: Param.ParamType := pdOutput;
                    2: Param.ParamType := pdInputOutput;
                  end;

                  Check(OCI8.OCIAttrGet2(hArg, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_HAS_DEFAULT, OCISvcCtx.hOCIError));
                  Param.SetHasDefault(Boolean(ValueInt));
                end
                else begin
                  Param.Name := 'RESULT';
                  Param.ParamType := pdResult;
                end;
              end;

              Assert(Param <> nil);

              Size := 0;
              Scale := 0;
              Prec := 0;
              if //(OraType <> SQLT_NTY) and
                 (ObjType = OCI_PTYPE_ARG) then begin  // for Self param of methods
                Check(OCI8.OCIAttrGet2(hArg, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_DATA_SIZE, OCISvcCtx.hOCIError));
                Size := Word(ValueInt);
                Check(OCI8.OCIAttrGet2(hArg, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_SCALE, OCISvcCtx.hOCIError));
                Scale := sb1(ValueInt);
                Check(OCI8.OCIAttrGet2(hArg, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_PRECISION, OCISvcCtx.hOCIError));
                Prec := Word(ValueInt);
              end;
              // Use default value OCI_ATTR_HAS_DEFAULT

              case OraType of
                SQLT_CHR: begin
                  if FConnection.FUseUnicode then
                    Param.DataType := dtWideString
                  else
                    Param.DataType := dtString;
                  if Size > 0 then
                    Param.Size := Size;
                  Check(OCI8.OCIAttrGet2(hArg, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_CHARSET_FORM, OCISvcCtx.hOCIError));
                  Param.SetNational(ub1(ValueInt) = SQLCS_NCHAR);
                end;
                SQLT_AFC: begin
                  if FConnection.FUseUnicode then
                    Param.DataType := dtFixedWideChar
                  else
                    Param.DataType := dtFixedChar;
                  if Size > 0 then
                    Param.Size := Size;
                  Check(OCI8.OCIAttrGet2(hArg, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_CHARSET_FORM, OCISvcCtx.hOCIError));
                  Param.SetNational(ub1(ValueInt) = SQLCS_NCHAR);
                end;
                SQLT_NUM: begin
                  if Prec = 0 then begin
                    Prec := 38;
                    if Scale <= 0 then // NUMBER without Prec and Scale
                      Scale := 38;
                  end;
                  if FConnection.FEnableIntegers and (Prec <= GetSmallintPrecision) and (Scale = 0)
                  then
                    Param.DataType := dtSmallint
                  else
                  if FConnection.FEnableIntegers and (Prec <= GetIntegerPrecision) and (Scale = 0)
                  then
                    Param.DataType := dtInteger
                  else
                  if FConnection.FEnableIntegers and (Prec <= GetLargeintPrecision) and (Scale = 0)
                  then
                    Param.DataType := dtLargeint
                  else
                  if Prec <= GetFloatPrecision then
                    Param.DataType := dtFloat
                  else
                  if (FConnection.EnableBCD or FEnableBCD) and (Prec <= GetBCDPrecision) and
                    (Scale >= 0) and (Scale <= GetBCDScale)
                  then
                    Param.DataType := dtBCD
                {$IFDEF VER6P}
                {$IFNDEF FPC}
                  else
                  if (FConnection.EnableFMTBCD or FEnableFMTBCD) and (Prec <= GetFmtBCDPrecision) and
                   (Scale >= 0) and (Scale <= GetFmtBCDScale)
                  then
                    Param.DataType := dtFMTBCD
                {$ENDIF}
                {$ENDIF}
                  else
                  if FConnection.FEnableNumbers then
                    Param.DataType := dtNumber
                  else
                    Param.DataType := dtFloat;
                end;
                INTEGER_TYPE:
                  Param.DataType := dtInteger;
                SQLT_IBFLOAT: begin
                  Param.DataType := dtFloat;
                  Param.SubDataType := dtBFloat;
                end;
                SQLT_IBDOUBLE: begin
                  Param.DataType := dtFloat;
                  Param.SubDataType := dtBDouble;
                end;
                SQLT_DAT:
                  Param.DataType := dtDateTime;
                SQLT_RID,SQLT_RDD : begin
                {$IFNDEF LITE}
                  if FConnection.FUseUnicode then
                    Param.DataType := dtWideString // dtRowId;
                  else
                {$ENDIF}
                    Param.DataType := dtString; // dtRowId;
                  Param.Size := RowIdSize + 1; // for terminator
                end;
                SQLT_BIN: begin
                  Param.DataType := dtVarBytes;
                  if Size > 0 then
                    Param.Size := Size;
                end;
                SQLT_LNG:
                {$IFNDEF LITE}
                  if FConnection.FUseUnicode then
                    Param.DataType := dtWideMemo
                  else
                {$ENDIF}
                    Param.DataType := dtMemo;
                SQLT_LBI:
                  Param.DataType := dtBlob;
                SQLT_CUR: begin  // SQLT_RSET
                  Param.DataType := dtCursor;
                  //Param.ParamType := pdOutput;
                end;
                SQLT_TAB: begin
                  ValuePtr := OrdinalToPtr(hArgList1);
                  try
                    Check(OCI8.OCIAttrGet1(hArg, OCI_DTYPE_PARAM, ValuePtr, nil, OCI_ATTR_LIST_ARGUMENTS, OCISvcCtx.hOCIError));
                  finally
                    PtrToOrdinal(ValuePtr, hArgList1);
                  end;
                  Param.FTable := True;
                  Param.FLength := 1;
                  Continue;
                end;
                SQLT_BOL:
                  Param.DataType := dtBoolean;
                SQLT_REC: begin
                  //Rec:= True;
                end;
              // Oracle8 types
                SQLT_CLOB:
                  Param.DataType := dtOraClob;
                SQLT_BLOB:
                  Param.DataType := dtOraBlob;
                SQLT_BFILEE:
                  Param.DataType := dtBFILE;
                SQLT_CFILEE:
                  Param.DataType := dtCFILE;
                SQLT_NTY: begin
                  StrPtr := nil;
                  ValuePtr := OrdinalToPtr(StrPtr);
                  try
                    Check(OCISvcCtx.OCI8.OCIAttrGet1(hArg, OCI_DTYPE_PARAM, ValuePtr, PLen, OCI_ATTR_TYPE_NAME, OCISvcCtx.hOCIError));
                  finally
                    PtrToOrdinal(ValuePtr, StrPtr);
                  end;
                  Len := Marshal.ReadInt32(PLen);
                  TypeName := OCISQLInfo.QuoteIfNeed(PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv));

                  StrPtr := nil;
                  ValuePtr := OrdinalToPtr(StrPtr);
                  try
                    Check(OCISvcCtx.OCI8.OCIAttrGet1(hArg, OCI_DTYPE_PARAM, ValuePtr, PLen, OCI_ATTR_SCHEMA_NAME, OCISvcCtx.hOCIError));
                  finally
                    PtrToOrdinal(ValuePtr, StrPtr);
                  end;
                  Len := Marshal.ReadInt32(PLen);
                  SchemaName := PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv);

                  if SchemaName <> 'PUBLIC' then // Oracle 10
                    TypeName := SchemaName + '.' + TypeName;

                  TypeName := DescribeSynonym(TypeName);
                  ObjectType := nil;
                  if ObjectTypes <> nil then
                    ObjectType := TOraType(ObjectTypes.FindType(OCISvcCtx, TypeName));
                  if ObjectType = nil then
                    ObjectType := TOraType.Create(OCISvcCtx, TypeName)
                  else
                    ObjectType.AddRef;

                  try
                    if ObjectType.DataType = dtXml then begin
                      Param.DataType := dtXml;
                      OraObject := TOraXML.Create(OCISvcCtx, ObjectType);
                      try
                        Param.SetObject(OraObject); // increments ref count to 2
                      finally
                        OraObject.Free;             // decrements ref count to 1
                      end;
                    end
                    else begin
                      Param.DataType := dtObject;//TOraType(Field.ObjectType).DataType;
                      OraObject := TOraObject.Create(ObjectType);
                      try
                        Param.SetObject(OraObject); // increments ref count to 2
                      finally
                        OraObject.Free;             // decrements ref count to 1
                      end;
                    end;
                  finally
                    ObjectType.Release;
                  end;
                end;
                SQLT_REF:
                  Param.DataType := dtReference;
                SQLT_NCO:
                  Param.DataType := dtTable;
                SQLT_VARRAY:
                  Param.DataType := dtArray;
              // Oracle9 types
                SQLT_TIMESTAMP, SQLT_TIMESTAMP_TZ, SQLT_TIMESTAMP_LTZ: begin
                {$IFDEF VER6P}
                {$IFNDEF FPC}
                  if FConnection.FEnableSQLTimeStamp then
                    Param.DataType := dtSQLTimeStamp
                {$ELSE}
                  if FConnection.FTimeStampAsString then
                    Param.DataType := dtDateTime
                {$ENDIF}
                  else
                {$ENDIF}
                    case OraType of
                      SQLT_TIMESTAMP:
                        Param.DataType := dtTimeStamp;
                      SQLT_TIMESTAMP_TZ:
                        Param.DataType := dtTimeStampTZ;
                      SQLT_TIMESTAMP_LTZ:
                        Param.DataType := dtTimeStampLTZ;
                    end;
                end;
                SQLT_INTERVAL_YM:
                  Param.DataType := dtIntervalYM;
                SQLT_INTERVAL_DS:
                  Param.DataType := dtIntervalDS;
              else
                RaiseError(SUnsupportedDataType + ' [' + IntToStr(OraType) + ']')
              end;
              if Param.ValuePtr = nil then
                Param.AllocBuffer;
            end;

            hArgList1 := nil;
            Inc(i);

          finally
            // free memory after OCIParamGet
            OCISvcCtx.OCI8.OCIDescriptorFree(hArg, OCI_DTYPE_PARAM);
          end;

        end;

        break;
      end;
    finally
      Marshal.FreeHGlobal(PLen);
    end;

  finally
    Check(OCISvcCtx.OCI8.OCIHandleFree(hDescribe, OCI_HTYPE_DESCRIBE));
  end;
end;

procedure TOCICommand.InitProcParams(Name: string; Overload: integer);
begin
  CheckSession;
  AllocOCISvcCtx;
  try
    FOCICallStyle := FConnection.FOCICallStyleCommand;

    if FOCICallStyle = OCI73 then begin
      InitProcParams7(Name, Overload);
    end
    else
    if FOCICallStyle = OCI80 then begin
      if UseOCI7ProcDesc or
        not (OCI73 in OCISvcCtx.Home.PossibleOCICallStyles)
      /// Oracle Server 8.0.5 has a bug with OCI80 call style after recompiling.
        or (FConnection.GetOracleVersion = 8050)
      {/// Oracle 8.0.5 has a bug with OCI80 call style??? - Not detected.
      /// Oracle 8.0.4 has bug with OCI73 call style (cannot describe more than 10
      /// parameters).

        or (FConnection.Home.OCIVersionSt < '8.1')
        and (StrLComp(PChar(FConnection.Home.OCIVersionSt), '8.0.4', 5) <> 0)}
      then
        InitProcParams7(Name, Overload)
      else
        InitProcParams8(Name, Overload);
    end
    else
      CheckOCI;
  finally
    ReleaseOCISvcCtx;
  end;
end;

procedure TOCICommand.DoExecute;
var
  OldPrepared: boolean;
begin
  OldPrepared := GetPrepared;
  if not OldPrepared then
    Prepare;
  try
    if FSQLType <> SQL_EXPLAIN then  // avoid binding with EXPLAIN PLAN
      BindParams;
    Exec;
  {$IFDEF AUTOTEST}
    inherited Execute;
  {$ENDIF}
  finally
    if (not OldPrepared or FForceUnprepare) and (GetCursorState <> csInactive) then
      Unprepare;
    FForceUnprepare := False;

    FIterCount := 1;
  end;
end;

procedure TOCICommand.Execute(Iters: integer);
var
  E: Exception;
begin
  if GetCursorState = csExecuting then
    Exit;

  FIterCount := Iters;

  FExecuting := True;
  if FNonBlocking then begin
    if not FConnection.FThreadSafety then begin
      E := Exception.Create(SNeedThreadSafety);
      EndExecute(E);
      raise E;
    end;

  {$IFDEF MSWINDOWS}
    Assert(hExecThread = nil);
    hExecThread := FConnection.RunThread(DoExecute, EndExecute);
  {$ENDIF}
  end
  else begin
    try
      DoExecute;
    except
      on E: Exception do begin
        EndExecute(E);
        raise;
      end;
    end;
    EndExecute(nil);
  end;
end;

procedure TOCICommand.BreakExec;
begin
  if GetCursorState <> csInactive then
    FConnection.BreakExec;
end;

procedure TOCICommand.HardBreak;
{$IFDEF MSWINDOWS}
var
  E: Exception;
  Res: DWORD;
{$IFDEF CLR}
  ReturnValue: LongWord;
{$ENDIF}
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
  if GetCursorState <> csInactive {= csExecuting} then begin
    FConnection.BreakExec;

  {$IFDEF CLR}
    Res := 0;
    if hExecThread.WaitFor(3000, ReturnValue) then
      Res := WAIT_TIMEOUT;
  {$ELSE}
    Res := WaitForSingleObject(hExecThread.Handle, 3000);
  {$ENDIF}

    case Res of  // timeout 3 sec
      WAIT_TIMEOUT: begin
        if hExecThread <> nil then
          FConnection.StopThread(hExecThread);
        E := Exception.Create('HardBreak');
        try
          if GetCursorState = csExecuting then
            Finish;
        finally
          EndExecute(E);
          E.Free;
        end;
      end;
    end;
  end;
{$ENDIF}
end;

procedure TOCICommand.EndExecute(E: Exception);
var
  Fail: boolean;
begin
{$IFDEF MSWINDOWS}
  if hExecThread <> nil then begin
//    FConnection.StopThread(hExecThread);
    hExecThread := nil;
  end
  else
    if FNonBlocking then Exit;
{$ENDIF}

  FExecuting := False;  // Here for reexecute in AfterExecute

  if Assigned(FAfterExecute) then
    FAfterExecute(E = nil);

  if FNonBlocking and (E is EOraError) then begin
    Fail := True;
    FConnection.DoError(EOraError(E), Fail);
    if not Fail then
      Abort;
  end;
end;

{ Params }

function TOCICommand.AddParam: TParamDesc;
var
  Param: TOraParamDesc;
begin
  Param := TOraParamDesc.Create;
  Param.FOwner := Self;
  Result := Param;
  FParams.Add(Result);
end;

class function TOCICommand.GetSQLInfoClass: TSQLInfoClass;
begin
  Result := TOCISQLInfo;
end;

class function TOCICommand.GetParserClass: TSQLParserClass;
begin
  Result := TOraParser;
end;

{$IFNDEF LITE}
class function TOCICommand.GetMapRulesClass: TCRMapRulesClass;
begin
  Result := TOraMapRules;
end;
{$ENDIF}

function TOCICommand.ParseSQL(const SQL: string; Params: TParamDescs; ReplaceAll: boolean = True; const RenamePrefix: string = ''): string;
var
  Param: TOraParamDesc;
  Parser: TOraParser;
  Code: integer;
  St: string;
  SQLType: word;
  IsReturning: boolean;
  AllParams: TStringList;
begin
  if RenamePrefix <> '' then
    Result := inherited ParseSQL(SQL, Params, ReplaceAll, RenamePrefix)
  else
    Result := SQL;

  if not FScanParams or (Params = nil) then
    exit;

  Params.Clear;
  Parser := TOraParser.Create(SQL);
  Parser.DecSeparator := '.';
  Parser.OmitBlank := True;
  Parser.OmitComment := True;
  AllParams := TStringList.Create;
  AllParams.Sorted := True;
  try
    SQLType := 0;
    IsReturning := False;
    Parser.ToBegin;
    repeat
      Code := Parser.GetNext(St);
      while (Code <> lcEnd) and (Code <> 3) do begin // ':'
        if (Code = lxCREATE) or (Code = lxTRIGGER) then begin
          Code := lcEnd;
          break;
        end
        else if SQLType = 0 then
          case Code of
            lxSELECT, lxWITH:
              SQLType := OCI_STMT_SELECT;
            lxUPDATE:
              SQLType := OCI_STMT_UPDATE;
            lxDELETE:
              SQLType := OCI_STMT_DELETE;
            lxINSERT:
              SQLType := OCI_STMT_INSERT;
            lxBEGIN:
              SQLType := OCI_STMT_BEGIN;
            lxDECLARE:
              SQLType := OCI_STMT_DECLARE;
            lxEXPLAIN:
              SQLType := OCI_STMT_EXPLAIN;
          end
        else // if SQLType is already detected
          case Code of
            lxRETURNING:
              IsReturning := True;
            lxFROM, lxSET, lxWHERE:
              IsReturning := False;
          end;
        Code := Parser.GetNext(St);
      end;
      if Code = 3 then begin
        Code := Parser.GetNext(St);
        if (Code = lcIdent) or (Code = lcNumber) or (Code >= lxSQLFirst) then begin // PL/SQL reserved words is allowed
          if AllParams.IndexOf(St) < 0 then begin
            Param := TOraParamDesc.Create;
            Param.FOwner := Self;
            Param.SetName(St);
            Params.Add(Param);
            AllParams.Add(St);

            if SQLType in [OCI_STMT_INSERT, OCI_STMT_UPDATE] then
              if not IsReturning then
                Param.FCanBeOutput := False;
          end
          else begin
            if (SQLType in [OCI_STMT_INSERT, OCI_STMT_UPDATE]) and IsReturning then begin
              Param := TOraParamDesc(Params.FindParam(St));
              if Param <> nil then
                Param.FCanBeOutput := True;
            end;
          end;
        end;
      end;
    until Code = lcEnd;
  finally
    AllParams.Free;
    Parser.Free;
  end;
end;

procedure TOCICommand.BindParams;
var
  i: integer;
begin
  FConnection.BusyWait;
  try
    for i := 0 to FParams.Count - 1 do
      BindParam(TOraParamDesc(FParams[i]));
  finally
    FConnection.Release;
  end;

  SetCursorState(csBound);
end;

{procedure TOCICommand.DisconnectParams;
var
  Param: TOraParamDesc;
  i: integer;
begin
  for i := 0 to FParams.Count - 1 do begin
    Param := TOraParamDesc(FParams[i]);
    case Param.FDataType of
      dtOraBlob,dtOraClob:
        Param.GetAsOraBlob.FreeLob;
      dtObject,dtArray:
        TOraObject(Param.GetObject).FreeObject;
    end;
  end;
end;}

function TOCICommand.GetParam(Index: integer): TOraParamDesc;
begin
  Result := TOraParamDesc(FParams[Index]);
end;

{ Strored Proc }

function TOCICommand.CreateProcCall(const Name: string; NeedDescribe: boolean; IsQuery: boolean): string;
const
  STab = '  ';
var
  SPName: string;
  SPOverload: integer;
  PassByName: boolean;
  St, DeclSt, OutSt: string;
  i: integer;
  Added: boolean;
  ResParamDesc, ParamDesc: TOraParamDesc;

  function PrepareVariable(AParamDesc: TOraParamDesc): string;
  begin
    case AParamDesc.DataType of
      dtBoolean: begin
        DeclSt := DeclSt + STab + 'v_' + AParamDesc.Name + ' boolean';
        if AParamDesc.ParamType in [pdUnknown, pdInput, pdInputOutput] then begin
          DeclSt := DeclSt + ' := sys.DIUTIL.INT_TO_BOOL(:' + AParamDesc.GetName + ');' + DALineSeparator;
        end else
          DeclSt := DeclSt + ';' + DALineSeparator;
        if AParamDesc.ParamType in [pdUnknown, pdInputOutput, pdOutput, pdResult] then begin
          OutSt := OutSt + STab + ':' + AParamDesc.Name + ' := sys.DIUTIL.BOOL_TO_INT(v_' + AParamDesc.GetName + ');' + DALineSeparator;
        end;
        Result := 'v_' + AParamDesc.Name;
      end;
      else
        Result := ':' + AParamDesc.Name;
    end;
    if (AParamDesc.ParamType <> pdResult) and PassByName then
      Result := AParamDesc.Name + ' => ' + Result;
  end;

  function FindResultParam: TOraParamDesc;
  var
    i: integer;
  begin
    Result := nil;

    for i := 0 to FParams.Count - 1 do
      if (FParams[i] <> nil) then
        if TOraParamDesc(FParams[i]).ParamType = pdResult then begin
          Result := TOraParamDesc(FParams[i]);
          break;
        end;
  end;

begin
  TOCISQLInfo.ParseSPName(Name, SPName, SPOverload);

  if NeedDescribe then begin
    InitProcParams(SPName, SPOverload);
    FForceSPInit := False;
  end;

  ResParamDesc := FindResultParam;

  PassByName := False;
  Added := False;
  for i := FParams.Count - 1 downto 0 do begin
    ParamDesc := TOraParamDesc(FParams[i]);
    if not NeedBindParam(ParamDesc) then begin
      if Added then begin
        PassByName := True;
        break;
      end;
    end
    else
      if ParamDesc <> ResParamDesc then
        Added := True;
  end;

  St := 'begin' + DALineSeparator;
  St := St + STab;

  DeclSt := '';
  OutSt := '';

  if ResParamDesc <> nil then begin
    St := St + PrepareVariable(ResParamDesc) + ' := ';
  end;
  St := St + SPName;

  Added := False;
  for i := 0 to FParams.Count - 1 do begin
    ParamDesc := TOraParamDesc(FParams[i]);
    if (ParamDesc <> ResParamDesc) and NeedBindParam(ParamDesc) then begin
      if not Added then
        St := St + '('
      else
        St := St + ', ';
      St := St + PrepareVariable(ParamDesc);
      Added := True;
    end;
  end;

  if Added then
    St := St + ')';

  St := St + ';' + DALineSeparator;
  if DeclSt <> '' then
    St := 'declare' + DALineSeparator + DeclSt + St;
  if OutSt <> '' then
    St := St + OutSt;
  St := St + 'end;';

  Result := St;
  FSQL := St;
  FUserSQL := Result;
end;

function TOCICommand.ForceCreateSPParams: boolean;
begin
  Result := True;
end;

procedure TOCICommand.Busy;
begin
{$IFDEF MSWINDOWS}
  if FNonBlocking then
    WaitForSingleObject(hBusy, INFINITE);
{$ENDIF}
end;

procedure TOCICommand.Release;
begin
{$IFDEF MSWINDOWS}
  if FNonBlocking then
    ReleaseMutex(hBusy);
{$ENDIF}
end;

procedure TOCICommand.SetConnection(Value: TCRConnection);
begin
  if Value <> FConnection then begin
  {$IFDEF MSWINDOWS}
    if hExecThread <> nil then
      FConnection.StopThread(hExecThread, True);
  {$ENDIF}
    if GetActive then
      Close;

    inherited;

    FConnection := TOCIConnection(Value);
  end;
end;

function TOCICommand.GetCursorState: TCursorState;
begin
//  WAR Blocked
  Result := FCursorRef.State;
end;

procedure TOCICommand.SetCursorState(Value: TCursorState);
begin
  if FNonBlocking then begin
    Busy;
    FCursorRef.FState := Value;
    Release;
  end
  else
    FCursorRef.FState := Value;
end;

function TOCICommand.GetCursor: TCRCursor;
begin
  Result := FCursorRef;
end;

procedure TOCICommand.SetCursor(Value: TCRCursor);
begin
  if Value <> FCursorRef then begin
    if (FCursorRef <> nil) and (FCursorRef <> FCursor) then
      FCursorRef.Release;

    if (Value <> nil) and (Value <> FCursor) then begin
      FCursorRef := Value as TOraCursor;
      FCursorRef.AddRef;

      if (FCursorRef.OCISvcCtx <> nil) and (FOCISvcCtx = nil) then begin
        FOCISvcCtx :=  FCursorRef.OCISvcCtx;
      {$IFNDEF AUTOREFCOUNT}
        FOCISvcCtx.AddRef;
      {$ENDIF}
      end;
      FOCICallStyle := FCursorRef.FOCICallStyle;

      FFetchedRows := 0;
    end
    else
      FCursorRef := FCursor;
  end;
end;

function TOCICommand.GetNextCursor: TOraCursor;
var
  i: integer;
  Param: TOraParamDesc;
  Cursor: TOraCursor;
  Found: boolean;
begin
  Found := False;
  for i := 0 to FParams.Count - 1 do begin
    Param := TOraParamDesc(FParams[i]);
    if Param.GetDataType = dtCursor then begin
      Cursor := Param.GetAsCursor;
      if not Found then begin
        if Cursor = FCursorRef then
          Found := True;
      end
      else
      if Cursor.CanFetch then begin
        Result := Cursor;
        exit;
      end;
    end;
  end;
  Result := nil;
end;

function TOCICommand.GetRowId: string;
type
  TBuf = array [0..35] of byte;
  PBuf = ^TBuf;
var
  hRowId: pOCIRowid;
  Ptr: IntPtr;
  RowId81Ptr: pRowId81;
  Res: sword;
  PLen: IntPtr;
  Len: ub2;
begin
  if GetCursorState = csInactive then begin
    Result := FRowId;
    Exit;
  end;

  PLen := Marshal.AllocHGlobal(sizeof(Integer));
  try
    if FOCICallStyle = OCI73 then begin
      Result := RowId7ToString({$IFNDEF CLR}@{$ENDIF}FCursorRef.CDA.rid)
    end
    else
    if FOCICallStyle = OCI80 then begin
      Result := '';
      Check(OCISvcCtx.OCI8.OCIDescriptorAlloc(OCISvcCtx.hOCIEnv, Ptr, OCI_DTYPE_ROWID, 0, nil));
      Res := OCISvcCtx.OCI8.OCIAttrGet1(FCursorRef.OCIStmt, OCI_HTYPE_STMT, Ptr, PLen, OCI_ATTR_ROWID, OCISvcCtx.hOCIError);
      hRowId := Ptr;
      try
        if Res <> OCI_NO_DATA then begin
          Check(Res);
          if OCISvcCtx.Home.OCIVersion >= 9000 then begin
            Len := 4000;
            Ptr := Marshal.AllocHGlobal(Len);
            try
              Check(OCISvcCtx.OCI8.OCIRowidToChar(hRowId, Ptr, Len, OCISvcCtx.hOCIError));
              Result := string(Marshal.PtrToStringAnsi(Ptr, Len));
            finally
              Marshal.FreeHGlobal(Ptr);
            end;
          end
          else
          if OCISvcCtx.Home.OCIVersion >= 8100 then begin
            RowId81Ptr := pOCIRowid81(IntPtr(hRowId)).RowId;
            if IntPtr(RowId81Ptr) <> nil then begin
              if RowId81Ptr.filler = 2 then begin// UROWID
                Result := URowIdToString(RowId81Ptr, hRowId.RowId.ridfilenum)
              end
              else
                Result := RowId81ToString(RowId81Ptr);
            end;
          end
          else
            Result := RowId8ToString({$IFNDEF CLR}@{$ENDIF}hRowId.RowId);
        end;
      finally
        if not IsLibrary then
        /// We are forced to disable OCIDescriptorFree call in library because of
        /// strange bug on second DML execute with it under Windows XP,
        /// Windows 98 SE. Now memory will leak. :(
          Check(OCISvcCtx.OCI8.OCIDescriptorFree(hRowId, OCI_DTYPE_ROWID));
      end;
    end
    else
      CheckOCI;
  finally
    Marshal.FreeHGlobal(PLen);
  end;
end;

function TOCICommand.GetSQLType: integer;
begin
  Result := FLastSQLType;
end;

function TOCICommand.GetActive: boolean;
begin
  Result := GetCursorState <> csInactive;
end;

function TOCICommand.GetPrepared: boolean;
begin
  Result := GetCursorState >= csPrepared;
end;

procedure TOCICommand.SetOCICallStyle(Value: TOCICallStyle);
begin
  if Value <> FOCICallStyle then begin
    if GetActive then
      Close;

    FOCICallStyle := Value;
    FCursorRef.FOCICallStyle := FOCICallStyle;
  end;
end;

procedure TOCICommand.SetArrayLength(Value: integer);
var
  i : integer;
begin
  for i := 0 to FParams.Count - 1 do
    TOraParamDesc(FParams[i]).FLength := Value;
end;

function TOCICommand.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
  {$IFDEF MSWINDOWS}
    prNonBlocking:
      FNonBlocking := Boolean(Value);
  {$ELSE}
    prNonBlocking:
      FNonBlocking := False;  // doesn't support non blocking
  {$ENDIF}
    prFieldsAsString:
      FFieldsAsString := Boolean(Value);
    prCacheLobs:
      FCacheLobs := Boolean(Value);
    prScrollableCursor:
      FCursorRef.FScrollable := Boolean(Value);
    prStoreRowId:
      FStoreRowId := Boolean(Value);
    prRawAsString:
      FRawAsString := Boolean(Value);
    prNumberAsString:
      FNumberAsString := Boolean(Value);
    prSmallintPrecision:
      FSmallintPrecision := Value;
    prIntegerPrecision:
      FIntegerPrecision := Value;
    prFloatPrecision:
      FFloatPrecision := Value;
    prLargeintPrecision:
      FLargeIntPrecision := Value;
    prBCDPrecision:
      GetPrecAndScale(Value, FBCDPrecision, FBCDScale);
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    prFmtBCDPrecision:
      GetPrecAndScale(Value, FFmtBCDPrecision, FFmtBCDScale);
  {$ENDIF}
  {$ENDIF}
    prTemporaryLobUpdate:
      FTemporaryLobUpdate := Boolean(Value);
    prStatementCache:
      FStatementCache := Boolean(Value);
    prPrefetchRows:
      FCursor.FPrefetchRows := Value;
    prCheckParamHasDefault:
      FCheckParamHasDefault := Value;
    prUseDefaultDataTypes:
      FUseDefaultDataTypes := Value;
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TOCICommand.GetProp(Prop: integer; out Value: variant): boolean;
var
  Buf: integer;
begin
  Result := True;
  case Prop of
    prRowsProcessed:
      if FFetchedRows > 0 then
        Value := FFetchedRows
      else
        Value := FRowsProcessed;
    prSQLType:
      Value := FSQLType;
    prErrorOffset: begin
      Buf := FErrorOffset;
      RemoveCRSymbols(TrimRight(FSQL), Buf);
      Value := Buf;
    end;
    prStoreRowId:
      Value := FStoreRowId;
    prTemporaryLobUpdate:
      Value := FTemporaryLobUpdate;
    prFieldsAsString:
      Value := FFieldsAsString;
    prCacheLobs:
      Value := FCacheLobs;
    prRawAsString:
      Value := FRawAsString;
    prNumberAsString:
      Value := FNumberAsString;
  else
    Result := inherited GetProp(Prop, Value);
  end;
end;

{ TOCISQLInfo }

function TOCISQLInfo.NextCharQuotesNeed(Ch: Char; IdCase: TIdentCase): boolean;
begin
  case IdCase of
    icUpper:
      case Ch of
        'A'..'Z', '_', '0'..'9', '$', '#': Result := False;
      else
        Result := True;
      end;
    icLower:
      case Ch of
        'a'..'z', '_', '0'..'9', '$', '#': Result := False;
      else
        Result := True;
      end;
  else
    case Ch of
      'a'..'z', 'A'..'Z', '_', '0'..'9', '$', '#': Result := False;
    else
      Result := True;
    end;
  end;
end;

function TOCISQLInfo.HasAsLexem: boolean;
begin
  Result := False;
end;

procedure TOCISQLInfo.ParseExtTableInfo(Parser: TSQLParser; var CodeLexem: integer; var StLex: string; var Name: string);
var
  PriorLexem: integer;
  PriorStLex: string;
begin
  if StLex = '@' then begin
    CodeLexem := Parser.GetNext(StLex);
    if (CodeLexem = lcIdent) or (CodeLexem >= lxSQLFirst) then begin
      Name := Name + '@';
      repeat
        PriorLexem := CodeLexem;
        PriorStLex := StLex;
        Name := Name + StLex;
        CodeLexem := Parser.GetNext(StLex);
        if (StLex = '.') and
          ((PriorLexem = lcIdent) or (PriorLexem >= lxSQLFirst))
        then
          continue;
        if (PriorStLex = '.') and
          ((CodeLexem = lcIdent) or (CodeLexem >= lxSQLFirst))
        then
          continue;
        break;
      until False;
    end;
  end;

  if CodeLexem = lxPARTITION then begin
    CodeLexem := Parser.GetNext(StLex);
    if StLex = '(' then
      if Parser.ToLexem(')') then
        CodeLexem := Parser.GetNext(StLex);
  end;
end;

function TOCISQLInfo.IdentCase: TIdentCase;
begin
  Result := icUpper;
end;

function TOCISQLInfo.NormalizeName(const Value: string; const LeftQ: Char; const RightQ: Char; QuoteNames: boolean = False; UnQuoteNames: boolean = False): string;
var
  i,j: integer;
begin
  if IsQuoted(Value) then begin
    i := Pos(RightQ + '.', Value);
    j := Pos('@' + LeftQ, Value);
  end
  else begin
    i := Pos('.', Value) - 1;
    j := Pos('@', Value) - 1;
  end;
  if (i > 0) then
    Result := NormalizeName(Copy(Value, 1, i), LeftQ, RightQ, QuoteNames, UnQuoteNames) +
      '.' + NormalizeName(Copy(Value, i + 2, Length(Value) - i + 1), LeftQ, RightQ, QuoteNames, UnQuoteNames)
  else
  if (j > 0) then
    Result := NormalizeName(Copy(Value, 1, j), LeftQ, RightQ, QuoteNames, UnQuoteNames) +
      '@' + NormalizeName(Copy(Value, j + 2, Length(Value) - j + 1), LeftQ, RightQ, QuoteNames, UnQuoteNames)
  else begin
    if not IsQuoted(Value) and not QuoteNames then
      Result := AnsiUpperCase(Value)
    else
      Result := Value;

    if not UnQuoteNames and (QuoteNames or QuotesNeeded(Result)) then
      Result := Quote(Result, LeftQ, RightQ)
    else
      Result := UnQuote(Result)
  end;
end;

function TOCISQLInfo.NormalizeName(const Value: string; QuoteNames: boolean = False; UnQuoteNames: boolean = False): string;
begin
  Result := NormalizeName(Value, LeftQuote, RightQuote, QuoteNames, UnQuoteNames);
end;

procedure TOCISQLInfo.SplitObjectName(const Name: string; var Info: TSQLObjectInfo);
var
  i, p, Len: integer;
  InQuote: boolean;
begin
  Info.Name := '';
  Info.Schema := '';
  Info.Catalog := '';
  Info.DBLink := '';

  Len := Length(Name);
  p := 1;
  InQuote := False;

  for i := 1 to Len + 1 do begin
    if (i <= Len) and (Name[i] = '"') then
      InQuote := not InQuote;

    if (i = Len + 1) or (not InQuote and (Name[i] = '.')) then begin
      if p > 1 then
        Info.Schema := Info.Name;
      Info.Name := Copy(Name, p, i - p);
      p := i + 1;
    end;

    if (i <= Len) and not InQuote and (Name[i] = '@') then begin
      if p > 1 then
        Info.Schema := Info.Name;
      Info.Name := Copy(Name, p, i - p);
      Info.DBLink := Copy(Name, i + 1, MaxInt);
      break;
    end;
  end;
end;

class function TOCISQLInfo.ParseSPName(FullName: string; var Name: string; var Overload: integer): boolean;
var
  i: integer;
  str_index: integer;
begin
  Result := False;

  str_index := 0;
  for i := Length(FullName) downto 1 do begin
    if (FullName[i] = '"') or (FullName[i] = '.') then begin
      break;
    end;
    if FullName[i] = ':' then begin
      if str_index = 0 then begin
        Result := True;
        str_index := i;
      end
      // if more then one ":"
      else begin
        Result := False;
        break;
      end;
    end;
  end;

  if Result then begin
    if TryStrToInt(Trim(copy(FullName, str_index + 1, MaxInt)), Overload) then
      Name := Trim(copy(FullName, 1, str_index - 1))
    else begin
      Result := False;
      Name := FullName;
      Overload := 0;
    end;
  end
  else begin
    Name := FullName;
    Overload := 0;
  end;
end;

class function TOCISQLInfo.GetFinalSPName(Name: string; Overload: integer): string;
var
  SPOverload: integer;
begin
  if (Name <> '') and (Overload > 0) then begin
    if ParseSPName(Name, Result, SPOverload) then
      Result := Result + ':' + IntToStr(Overload)
    else
      Result := Name + ':' + IntToStr(Overload);
  end
  else
    Result := Name;
end;

{ TOCIFieldDesc }

procedure TOCIFieldDesc.SetDataType(Value: Word);
begin
  inherited;
  FIsConverted := TOCIRecordSet.IsConvertedFieldType(Value)
end;

procedure TOCIFieldDesc.SetSubDataType(Value: Word);
begin
  inherited;
  FIsBlobSubType := RecordSetClass.IsBlobDataType(Value);
  FIsNational := Value in [dtNString, dtNWideString, dtFixedNChar, dtFixedNWideChar, dtNClob];
end;

{ TOCIRecordSet }

constructor TOCIRecordSet.Create;
begin
  inherited Create;

  FRequireEmptyStrToNull := True;

  FFetchRows := 25;
{$IFDEF MSWINDOWS}
  hEvent := TEvent.Create(nil, True, True, '');
{$ENDIF}
  FHasObjectFields := False;

  FExpandedFields := TFieldDescs.Create;
end;

destructor TOCIRecordSet.Destroy;
begin
  Close;

{$IFDEF MSWINDOWS}
  if hExecFetchThread <> nil then begin
    FConnection.StopThread(hExecFetchThread, True);
  end;
  if hFetchAllThread <> nil then begin
    FConnection.StopThread(hFetchAllThread, True);
  end;
  hEvent.Free;
{$ENDIF}

  FreeFetchBlock;

  if FGCHandle <> nil then
    FreeGCHandle(FGCHandle);

  FExpandedFields.Free;

  inherited;
end;

procedure TOCIRecordSet.CreateCommand;
begin
  SetCommand(TOCICommand.Create);
end;

procedure TOCIRecordSet.SetCommand(Value: TCRCommand);
begin
  inherited;

  FCommand := TOCICommand(Value);
  if FCommand <> nil then
    FConnection := FCommand.FConnection;
end;

function TOCIRecordSet.GetFieldDescType: TFieldDescClass;
begin
  Result := TOCIFieldDesc;
end;

{ Open /Close }

procedure TOCIRecordSet.InternalPrepare;
begin
  if FCommand.NativeCursor then
    FCommand.Prepare;

  InitFetchCursor;

  SetCommandType;
end;

procedure TOCIRecordSet.SetCommandType;
begin
  case FCommand.FSQLType of
    SQL_UNKNOWN:
      FCommand.CommandType := ctUnknown;
    SQL_SELECT:
      FCommand.CommandType := ctCursor;
  else
    if FCommand.RowsReturn or (FCommand.FSQLType = SQL_PLSQL) and (FFetchCursor <> nil) then
      FCommand.CommandType := ctCursor
    else
      FCommand.CommandType := ctStatement;
  end;
end;

function TOCIRecordSet.CanFetchBack: boolean;
begin
  Result := (FCommand.FCursorRef <> nil) and FCommand.FCursorRef.FScrollable;
end;

function TOCIRecordSet.NeedInitFieldsOnPrepare: boolean;
begin
  Result := inherited NeedInitFieldsOnPrepare or HasCursorParams;
end;

procedure TOCIRecordSet.InternalUnPrepare;
begin
  if not FCommand.NativeCursor then begin
    try
      if FCommand.GetCursorState <> csInactive then
        FCommand.Close;
    finally
      FCommand.SetCursor(nil);
      FFetchCursor.FreeCursor; // ignore ref count
    end;
  end;

  if FCommand.GetCursorState <> csInactive then
    FCommand.Close;

  // CommandType & FCommand.FSQLType should be reset in any case
  // (even if FCommand.GetCursorState = csInactive)
  FCommand.CommandType := ctUnknown;
  FCommand.FSQLType := SQL_UNKNOWN;
end;

procedure TOCIRecordSet.InternalClose;
{$IFDEF MSWINDOWS}
var
  AMsg: TMSG;
{$ENDIF}
begin
  if (hExecFetchThread <> nil) or (hFetchAllThread <> nil) then begin
    if FCommand.Executing then // doesn't break if not Executing
      FCommand.BreakExec;
  {$IFDEF CLR}
    hEvent.WaitFor(INFINITE);
    hEvent.WaitFor(INFINITE);
  {$ENDIF}
  {$IFDEF WIN32_64}
    // Additional WaitForSingleObject is set to wait for event to pulse on case
    // if hExecFetchThread is in FetchArray or in FetchPiece function. This was
    // made to ensure that this thread will wait for for final SetEvent in
    // DoExecFetch procedure.
    WaitForSingleObject(THandle(hEvent.Handle), INFINITE);
    WaitForSingleObject(THandle(hEvent.Handle), INFINITE);
  {$ENDIF}
  {$IFDEF MSWINDOWS}
    while hExecFetchThread <> nil do begin
      if PeekMessage(AMsg, hODACWindow, 0, 0, PM_REMOVE) then
        DispatchMessage(AMsg);
    end;
  {$ENDIF}
  end;

  if GetNonBlocking and (hFetchAllThread <> nil) then begin
    FWaitForFetchBreak := True;
    while FFetching do sleep(0);
  {$IFDEF MSWINDOWS}
    if PeekMessage(AMsg, hODACWindow, WM_ENDTHREAD, WM_ENDTHREAD, PM_REMOVE) then
      DispatchMessage(AMsg);
  {$ENDIF}
  end;

  if not FCommand.NativeCursor then begin
    if FCommand.GetCursorState <> csInactive then
      if FCommand.FCursor.State <> csInactive then
        FCommand.Finish
      else
        FCommand.Close;
    FFetchCursor.FreeCursor; // ignore ref count
    FCommand.SetCursor(nil);
  end;

  if FCommand.GetCursorState > csPrepared then
    FCommand.SetCursorState(csPrepared);

  inherited;

  FreeFetchBlock;
  if not Prepared then
    InternalUnprepare;
end;

{ Edit }

procedure TOCIRecordSet.DoExecFetch;
var
  OldExecuted: boolean;
  CanExecuteFetch: boolean;
  i: integer;
  Field: TFieldDesc;
begin
{$IFDEF MSWINDOWS}
  PulseEvent(THandle(hEvent.Handle));
{$ENDIF}
  try
    CanExecuteFetch := (FCommand.GetCursorState = csPrepared) and (FCommand.FSQLType = SQL_SELECT) and
      (FCommand.FOCICallStyle = OCI80) and not (OCISvcCtx.Home.PossibleOCICallStyles = [OCI80]);
    OldExecuted := (FCommand.GetCursorState = csExecuted);

    if FCommand.NativeCursor and not OldExecuted then begin
      if not Prepared then
        InternalPrepare;
      FCommand.BindParams;
      if not CanExecuteFetch then
        FCommand.Exec;     //if DataSet is prepared(desribeonly) then execute and fetch can be combined
    end;

    if not FDisableInitFields then
      CheckFieldDescs // FetchCursor will be init inside InitFields
    else
      InitFetchCursor; // FetchCursor must be init in any case

    if not RowsReturn then
      RaiseError(SNotRows);

    if CanFetchBack then begin
      OCISvcCtx.Home.CheckOCI90;
      FPieceFetch := True;
      BlockMan.DefaultItemCount := FFetchRows;
    end
    else begin
      FPieceFetch := False;
      if FCommand.FOCICallStyle = OCI73 then // piece fetch is used with OCI7 only
        for i := 0 to FFields.Count - 1 do begin
          Field := FFields[i];
          if (Field.DataType in [dtBlob, dtMemo]) and (Field.Length = 0)
          then begin
            FPieceFetch := True;
            break;
          end;
        end;
    end;

    FCommand.SetCursor(FFetchCursor);

    if GetNonBlocking then begin
      Fetch;
      CurrentItem := FirstItem;
      FBOF := IntPtr(FirstItem) = nil;
    end;
  finally
{$IFDEF MSWINDOWS}
    hEvent.SetEvent;
{$ENDIF}
  end;
end;

procedure TOCIRecordSet.EndExecFetch(E: Exception);
var
  Fail: boolean;
begin
{$IFDEF MSWINDOWS}
  if hExecFetchThread <> nil then begin
//    FConnection.StopThread(hExecFetchThread);
    hExecFetchThread := nil;
  end
  else
    if (FCommand = nil) or GetNonBlocking then Exit;
{$ENDIF}

  try
    if Assigned(FAfterExecFetch) then //moved here to start exactly after execute
      FAfterExecFetch(E = nil);

    if (E = nil) and
      (FFetchAll or (GetNonBlocking and (Length(IndexFields) > 0)))
    then
      if FCommand.GetCursorState < csFetched then
        FetchAll
      else
        if GetNonBlocking and (Length(IndexFields) > 0) then
          SortItems;
    if (E = nil) and GetNonBlocking and (FTempFilterText <> '') then begin
      inherited SetFilterText(FTempFilterText);
      FTempFilterText := '';
      inherited FilterUpdated;
      if Assigned(FOnDataChanged) then
        FOnDataChanged;
    end;

    if FFetchAll and GetNonBlocking and (FCommand.GetCursorState <> csFetchingAll) then
      StopWait; //Reset screen cursor
  finally
    FCommand.Executing := False;
  end;

  if FCommand.FNonBlocking and (E is EOraError) then begin
    Fail := True;
    FConnection.DoError(EOraError(E), Fail);
    if not Fail then
      Abort;
  end;
end;

procedure TOCIRecordSet.ExecCommand; // Execute command
var
  NeedPrepare: boolean;
begin
  NeedPrepare := (FCommand.CommandType <> ctCursor) and not Prepared;

  if NeedPrepare then
    FCommand.Prepare;

  try
    inherited;

    InitFetchCursor;

    SetCommandType;

    FCommand.FForceUnprepare := FCommand.FNonBlocking and (FCommand.CommandType <> ctCursor);
  finally // for Unprepare on Exception
    if not FCommand.FNonBlocking and (FCommand.CommandType <> ctCursor) and NeedPrepare
      and FCommand.GetPrepared then //Disconnect mode collision (Unprepare occurs on Disconnect (AfterExecute))
      FCommand.Unprepare;
  end;
end;

procedure TOCIRecordSet.ExecFetch(DisableInitFields: boolean);
begin
  FCommand.Executing := True;
  if FCommand.FNonBlocking then begin
    if not FConnection.FThreadSafety then
      RaiseError(SNeedThreadSafety);

    // InitFields here for valid DataSet.CreateFieldDefs
    if not DisableInitFields then begin
      CheckFieldDescs;
      SetCommandType;
    end;
    FilterFunc := nil;
    inherited SetFilterText('');
  {$IFDEF MSWINDOWS}
    StringHeap.ThreadSafety := True;
    hEvent.ResetEvent;
    FDisableInitFields := True;
    hExecFetchThread := FConnection.RunThread(DoExecFetch, EndExecFetch);
  {$ENDIF}
  end
  else begin
    StringHeap.ThreadSafety := False;
    try
      FDisableInitFields := DisableInitFields;
      DoExecFetch;
    except
      on E: Exception do begin
        EndExecFetch(E);
        raise;
      end;
    end;
    EndExecFetch(nil);
  end;
end;

function TOCIRecordSet.IsFullReopen: boolean;
begin
  Result := not FCommand.NativeCursor;
end;

procedure TOCIRecordSet.Reopen;
{$IFDEF MSWINDOWS}
var
  Msg: TMsg;
{$ENDIF}
begin
  if FCommand.NativeCursor then begin
    //FCommand.BindParams;  // for reallocated Param

  {$IFDEF MSWINDOWS}
    if GetNonBlocking then begin
      while (hExecFetchThread <> nil) do
        PeekMessage(Msg, hODACWindow, 0, 0, PM_REMOVE);

      while (GetNonBlocking) and (hFetchAllThread <> nil) do begin
        FWaitForFetchBreak := True;
        PeekMessage(Msg, hODACWindow, 0, 0, PM_REMOVE);
      end;
    end;
  {$ENDIF}

    FreeData;
    InitData;
    if Assigned(FOnDataChanged) then
      // perform dataset resync to prevent AV if grid is repainted in BeforeFetch/AfterFetch events
      FOnDataChanged;

    InternalOpen(True);
  end
  else begin
    if FCommand.FSQLType = SQL_UNKNOWN then
      RaiseError(SReopenNotAllowed);

    Close;
    Open;
  end;
end;

procedure TOCIRecordSet.Disconnect;
begin
  GetDisconnectedMode;
  GetUseUnicode;
  GetCharLength;

  inherited;
end;

{ Fields}

function TOCIRecordSet.GetIndicatorSize: Integer;
begin
  Result := FFields.Count * sizeof(sb2);
end;

function TOCIRecordSet.HasCursorParams: boolean;
var
  i: integer;
begin
  Result := false;

  for i := 0 to FCommand.GetParamCount - 1 do
    if FCommand.GetParam(i).DataType = dtCursor then begin
      Result := true;
      exit;
    end;
end;

procedure TOCIRecordSet.InitFetchCursor;
var
  i: integer;
  Cur: TOraCursor;
  State: integer;
begin
  FFetchCursor := FCommand.FCursorRef;

  if FCommand.NativeCursor and (FCommand.FSQLType = SQL_PLSQL) then begin
    FFetchCursor := nil;

    for i := 0 to FCommand.GetParamCount - 1 do
      if FCommand.GetParam(i).DataType = dtCursor then begin
        Cur := FCommand.GetParam(i).GetAsCursor;

        // first cursor that executed (will return rows)
        if (Cur <> nil) and (Cur.hOCIStmt <> nil) then begin
          if OCISvcCtx.Home.OCIVersion >= 9100 then // supported starting with 9.1
            Check(OCI8.OCIAttrGet2(Cur.OCIStmt, OCI_HTYPE_STMT, State, nil, OCI_ATTR_STMT_STATE, OCISvcCtx.hOCIError))
          else
            State := OCI_STMT_STATE_EXECUTED;
          if State = OCI_STMT_STATE_EXECUTED then begin
            FFetchCursor := Cur;
            break;
          end;
        end;
      end;

    // redefine command type - depend on cursor: canbe executed or not
    if FFetchCursor = nil then
      FCommand.CommandType := ctStatement
    else
      FCommand.CommandType := ctCursor;
  end;
end;

class function TOCIRecordSet.GetBufferSize(DataType: Word; LengthInChars: integer): integer;
begin
  case DataType of
    dtDateTime:
      Result := 7;
    dtUndefined:
      Result := LengthInChars;
  else
    Result := inherited GetBufferSize(DataType, LengthInChars);
  end;
end;

procedure TOCIRecordSet.DetectIdentityField;
var
  FieldDesc: TCRFieldDesc;
  i: integer;
begin
  FIdentityField := nil;

  for i := 0 to FFields.Count - 1 do begin
    FieldDesc := TCRFieldDesc(FFields[i]);
    if CompareText(FieldDesc.ActualName, 'ROWID') = 0 then
      if FieldDesc.TableInfo = UpdatingTableInfo then begin
        FIdentityField := FieldDesc;
        Exit;
      end;
  end;
end;

procedure TOCIRecordSet.CreateFieldDescs;
var
  i: integer;
  Field: TCRFieldDesc;
  OldCursorState: TCursorState;
  OldCursor: TOraCursor;
  DescribeExecute: boolean;
begin
  OldCursorState := FCommand.GetCursorState;
  OldCursor := FCommand.FCursorRef;
  DescribeExecute := False;

  try
    if FCommand.NativeCursor then begin
      if FCommand.GetCursorState = csInactive then
        FCommand.Prepare;

      InitFetchCursor;

      if FCommand.FSQLType = SQL_SELECT then begin
        if (FCommand.FOCICallStyle = OCI80) and (FCommand.GetCursorState < csExecuted) then begin
          if FCommand.GetCursorState < csBound then  // to correct describe type of expression
            FCommand.BindParams;
          FCommand.InternalExecute(OCI_DESCRIBE_ONLY);
        end;
      end
      else if FCommand.FSQLType = SQL_PLSQL then begin
          if FCommand.GetCursorState < csBound then
            FCommand.BindParams;

          if FCommand.GetCursorState < csExecuted then begin
            FCommand.Exec;   // need for describe
            DescribeExecute := True;
            InitFetchCursor; // exit if all returned cursors are not in executed state
          end;

          if FCommand.CommandType <> ctCursor then
            Exit;

          FCommand.SetCursor(FFetchCursor);
        end
        else
          Exit;
    end
    else begin
      InitFetchCursor;

      FCommand.CheckActive;
    end;

    FHasConvertedFields := False;

    FConnection.BusyWait;
    try
      i := 1;
      while True do begin
        Field := CreateFieldDesc as TCRFieldDesc;
        try
          if GetFieldDesc(i, Field, FLongStrings, FFlatBuffers) then begin
            Field.ActualName := Field.Name;
            Field.FieldNo := FFields.Count + 1;
            FFields.Add(Field);
            Inc(i);

            FHasConvertedFields := FHasConvertedFields or TOCIFieldDesc(Field).IsConverted;

            if FConnection.FDisconnectMode then
              if Field.DataType in [dtObject, dtXML, dtReference, dtArray, dtTable] then
                Field.ReadOnly := True;
            if Field.DataType in [dtObject, dtArray] then
              InitObjectFields(Field.ObjectType, Field);
          end
          else begin
            Field.Free;
            break;
          end;
        except
          Field.Free;
          raise;
        end;
      end;
    finally
      FConnection.Release;
    end;
  {$IFNDEF LITE}
    FCommand.SQLInfo.ParseTablesInfo(FCommand.SQL, FTablesInfo);
    FTablesInfo.CaseSensitive := True;
  {$ENDIF}
    FHasObjectFields := HasFields([dtObject, dtXML, dtReference, dtArray, dtTable]);
  finally
    if not FCommand.NativeCursor then
      if FCommand.FCursorRef <> OldCursor then
        FCommand.SetCursor(OldCursor);

    if DescribeExecute then
      for i := 0 to FCommand.Params.Count - 1 do
        if FCommand.GetParam(i).DataType = dtCursor then
          FCommand.GetParam(i).GetAsCursor.FreeCursor;

    if (OldCursorState = csInactive) and (FCommand.GetCursorState <> csInactive) then
      FCommand.Finish
    else
      FCommand.SetCursorState(OldCursorState);
  end;
end;

procedure TOCIRecordSet.FillDataFieldDescs(out DataFieldDescs: TFieldDescArray; ForceUseAllKeyFields: boolean);
var
  FieldDesc: TCRFieldDesc;
  i: integer;
begin
  inherited FillDataFieldDescs(DataFieldDescs, ForceUseAllKeyFields);

  for i := 0 to FExpandedFields.Count - 1 do begin
    FieldDesc := TCRFieldDesc(FExpandedFields[i]);
    if (FieldDesc <> nil) and (FieldDesc.ParentField = nil) and not FieldDesc.ReadOnly then begin
      SetLength(DataFieldDescs, Length(DataFieldDescs) + 1);
      DataFieldDescs[High(DataFieldDescs)] := FieldDesc;
    end;
  end;
end;

function TOCIRecordSet.GetFieldDesc(FieldNo: integer; var Field: TCRFieldDesc;
  LongString: boolean; FlatBuffer: boolean): boolean;
begin
  if FCommand.FOCICallStyle = OCI73 then begin
    Result := GetFieldDesc7(FieldNo, Field, LongString, FlatBuffer);
  end
  else
  if FCommand.FOCICallStyle = OCI80 then begin
    Result := GetFieldDesc8(FieldNo, Field, LongString, FlatBuffer);
  end
  else begin
    Result := False;
    OCISvcCtx.Home.CheckOCI;
  end;
end;

function TOCIRecordSet.GetFieldDesc7(FieldNo: integer; var Field: TCRFieldDesc; LongString: boolean; FlatBuffer: boolean): boolean;
const
  MaxFieldNameSize = 50;
var
  dbsize: sb4;
  dbtype: sb2;
  cbuf: AnsiString;
  Ptr: IntPtr;
  cbufl: sb4;
  dsize: sb4;
  prec: sb2;
  scale: sb2;
  nullok: sb2;
  Res: sword;
  Len: Integer;
  Str: string;
begin
  cbufl := MaxFieldNameSize;

  Ptr := Marshal.AllocHGlobal(MaxFieldNameSize + 1);
  try
    Res := OCI7.odescr(FCommand.FCursorRef.CDA, FieldNo, dbsize, dbtype, Ptr,
      cbufl, dsize, prec, scale, nullok);
    if Res = 0 then
      cbuf := Marshal.PtrToStringAnsi(Ptr, cbufl);
  finally
    Marshal.FreeHGlobal(Ptr);
  end;

  if Res = 0 then begin
    Field.Name := string(cbuf);
    Field.ActualFieldNo := FieldNo;
    Field.Length := 0;
    Field.Scale := 0;
    Field.SubDataType := dtUnknown;

    case dbtype of
      VARCHAR2_TYPE, CHAR_TYPE: begin
        if (dbsize <= 255) or LongString then begin  // for IDSBase compatibility
          if (dbsize >= FlatBufferLimit) and not FlatBuffer then begin
            Field.DataType := dtExtString;
            Field.Size := sizeof(IntPtr);
          end
          else begin
            Field.DataType := dtString;
            Field.Size := dbsize + 1;  // for terminator
          end;
        end
        else begin
          Field.DataType := dtMemo;
          Field.SubDataType := dtString;
          Field.Size := sizeof(IntPtr);
        end;
        if dbtype = CHAR_TYPE then
          Field.SubDataType := dtFixedChar;
        Field.Length := dbsize; // !is used to differ from Memo
        Field.Fixed := dbtype = CHAR_TYPE;
      end;
      NUMBER_TYPE:
        if FCommand.FFieldsAsString or FCommand.FNumberAsString then begin
          Field.DataType := dtString;
          Field.SubDataType := dtNumber;
          if prec > 0 then
            Field.Length := prec
          else
            Field.Length := 38;
          Field.Scale := Abs(scale);
          Field.Size := Field.Length + 3;
        end
        else begin
          Field.Length := prec;
          Field.Scale := Abs(scale);
          if not FConnection.FEnableIntegers or (Abs(scale) > 0) or (prec > FCommand.GetIntegerPrecision)
            or (prec = 0)
          then begin
            Field.DataType := dtFloat;
            Field.Size := sizeof(Double);
          end
          else begin
            Field.DataType := dtInteger;
            Field.Size := sizeof(Integer);
          end;
        end;
      DATE_TYPE: begin
        if FCommand.FFieldsAsString then begin
          Str := UpperCase(FConnection.FNlsParams[nlsDateFormat].Value);
          Len := Length(Str);
          if Pos('MONTH', Str) > 0 then
            Len := Len + 7;
          if Pos('DAY', Str) > 0 then
            Len := Len + 9;
          Field.DataType := dtString;
          Field.Size := Len + 1;
          Field.Length := Len;
        end
        else begin
          Field.DataType := dtDateTime;
          Field.Size := 7;
        end;
      end;
      ROWID_TYPE: begin
        Field.DataType := dtString; //dtRowId;  //WAR
        Field.SubDataType := dtRowId;
        Field.Size := RowIdSize + 1; // for terminator //dbsize;
        Field.Length := RowIdSize;
      end;
      RAW_TYPE:
        if FCommand.FFieldsAsString or FCommand.FRawAsString then begin
          Field.DataType := dtString;
          Field.Size := dbsize*2 + 1;  // for terminator and heximal represent
          Field.Length := dbsize*2;
        end
        else begin
          Field.DataType := dtVarBytes;
          Field.Size := dbsize + SizeOf(Word);
          Field.Length := dbsize;
        end;
      LONG_TYPE: begin
        Field.DataType := dtMemo;
        Field.Size := sizeof(IntPtr);
      end;
      LONGRAW_TYPE: begin
        Field.DataType := dtBlob;
        Field.Size := sizeof(IntPtr);
      end;
      SQLT_OSL: begin
        Field.DataType := dtLabel;
        Field.Size := dbSize;
      end;
    else
      RaiseError(SDataTypeNotSupported);
      Field.DataType := dtUnknown;
    end;

    Field.Required := nullok = 0;
    Result := True;
  end
  else begin
    if Res <> OCI_VAR_NOT_IN_LIST then
      Check(Res);
    Result := False;
  end;
end;

function TOCIRecordSet.GetFieldDesc8(FieldNo: integer; var Field: TCRFieldDesc; LongString: boolean; FlatBuffer: boolean): boolean;
var
  hParam: pOCIParam;
  Len: integer;
  Name: string;
  Res: sword;
  OraType: sb2;
  IsNull: ub1;
  TypeName: string;
  SchemaName: string;
  Count: integer;
  ValueInt: Integer;
  Ptr, ValuePtr, StrPtr: IntPtr;
  NationalCharset : boolean;
  CharUsed: boolean;
{$IFNDEF LITE}
  FetchConverter: TFetchConverter;
{$ENDIF}

  function GetNlsFieldDesc(NlsType: TNlsParamType): Integer;
  var
    Str: string;
  begin
    if FConnection.FNlsParams[NlsType].Value = '' then
      FConnection.GetSessionParameters;

    Str := UpperCase(FConnection.FNlsParams[NlsType].Value);
    Len := Length(Str);
    if Pos('MONTH', Str) > 0 then
      Len := Len + 7
    else if Pos('MON', Str) > 0 then
      Len := Len + 3;
    if Pos('DAY', Str) > 0 then
      Len := Len + 9
    else if Pos('DY', Str) > 0 then
      Len := Len + 3;
    if Pos('DDSPTH', Str) > 0 then
      Len := Len + 14;
    if (NlsType in [nlsTimeStampFormat, nlsTimeStampTZFormat]) and (Pos('SSXFF', Str) > 0) then
      Len := Len + 4;
    Result := Len;
  end;

begin
  Result := False;

  Ptr := Marshal.AllocHGlobal(sizeof(integer));
  try
    Check(OCI8.OCIAttrGet2(FCommand.FCursorRef.OCIStmt, OCI_HTYPE_STMT, ValueInt, nil,
      OCI_ATTR_PARAM_COUNT, OCISvcCtx.hOCIError));
    Count := Integer(ValueInt);

    if FieldNo > Count then
      Exit;

    hParam := nil;
    Res := OCI8.OCIParamGet(FCommand.FCursorRef.OCIStmt, OCI_HTYPE_STMT, OCISvcCtx.hOCIError, hParam, FieldNo);

    (*if hParam = nil {Res = OCI_NO_DATA} then  //WAR  ORACLE BAG
      Exit;*)

    try
      Check(Res);

      StrPtr := nil;
      ValuePtr := OrdinalToPtr(StrPtr);
      try
        Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, Ptr, OCI_ATTR_NAME, OCISvcCtx.hOCIError));
      finally
        PtrToOrdinal(ValuePtr, StrPtr);
      end;
      Len := Marshal.ReadInt32(Ptr);
      Name := PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv);

      Field.Name := Name;
      Field.ActualFieldNo := FieldNo;
      Field.SubDataType := dtUnknown;

      // Oracle Type
      Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_DATA_TYPE, OCISvcCtx.hOCIError));
      OraType := sb2(ValueInt);

      // National
      if OraType in [SQLT_CHR, SQLT_AFC, SQLT_CLOB] then begin
        Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_CHARSET_FORM, OCISvcCtx.hOCIError));
        NationalCharset := ub1(ValueInt) = SQLCS_NCHAR;
      end
      else
        NationalCharset := False;

      // Char Used
      if (OraType in [SQLT_CHR, SQLT_AFC]) and (OCISvcCtx.Home.OCIVersion >= 9000) then begin
        Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_CHAR_USED, OCISvcCtx.hOCIError));
        CharUsed := ub1(ValueInt) = 1;
      end
      else
        CharUsed := False;

      // Fixed
      Field.Fixed := OraType = SQLT_AFC;

      // Length, Precision and Scale
      case OraType of
        SQLT_CHR, SQLT_AFC:  begin
          if CharUsed then begin
            Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_CHAR_SIZE, OCISvcCtx.hOCIError));
            Field.DBLength := sb2(ValueInt);
          end
          else begin
            Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_DATA_SIZE, OCISvcCtx.hOCIError));
            Field.DBLength := sb2(ValueInt);
          end;
        end;
        SQLT_NUM: begin
          Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_PRECISION, OCISvcCtx.hOCIError));
          Field.DBLength := sb2(ValueInt);

          Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_SCALE, OCISvcCtx.hOCIError));
          Field.DBScale := sb1(ValueInt);

          if (Field.DBScale = -127) and (Field.DBLength > 0) then //FLOAT
            Field.DBLength := Ceil(Field.DBLength * 0.30103)
          else if Field.DBLength = 0 then begin  // NUMBER without Prec and Scale
            Field.DBLength := 38;
            if Field.DBScale <= 0 then
              Field.DBScale := 38;
          end;

          Field.DBScale := Abs(Field.DBScale);
        end;
        SQLT_TIMESTAMP, SQLT_TIMESTAMP_TZ, SQLT_TIMESTAMP_LTZ: begin
          Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_FSPRECISION, OCISvcCtx.hOCIError));
          Field.DBLength := sb2(ValueInt);
        end;
        SQLT_INTERVAL_YM, SQLT_INTERVAL_DS: begin
          Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_PRECISION, OCISvcCtx.hOCIError));
          Field.DBLength := sb2(ValueInt);

          if OraType = SQLT_INTERVAL_DS then begin
            Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_SCALE, OCISvcCtx.hOCIError));
            Field.DBScale := sb1(ValueInt);
          end
          else
            Field.DBScale := 0;
        end;
        else begin
          Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_DATA_SIZE, OCISvcCtx.hOCIError));
          Field.DBLength := sb2(ValueInt);
        end;
      end;

      // Type Name for Oracle objects and references
      if OraType in [SQLT_NTY,SQLT_REF] then begin
        StrPtr := nil;
        ValuePtr := OrdinalToPtr(StrPtr);
        try
          Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, Ptr, OCI_ATTR_TYPE_NAME, OCISvcCtx.hOCIError));
        finally
          PtrToOrdinal(ValuePtr, StrPtr);
        end;
        Len := Marshal.ReadInt32(Ptr);
        TypeName := OCISQLInfo.QuoteIfNeed(PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv));

        StrPtr := nil;
        ValuePtr := OrdinalToPtr(StrPtr);
        try
          Check(OCI8.OCIAttrGet1(hParam, OCI_DTYPE_PARAM, ValuePtr, Ptr, OCI_ATTR_SCHEMA_NAME, OCISvcCtx.hOCIError));
        finally
          PtrToOrdinal(ValuePtr, StrPtr);
        end;
        Len := Marshal.ReadInt32(Ptr);
        SchemaName := OCISQLInfo.QuoteIfNeed(PtrToStringOCI(StrPtr, Len, OCISvcCtx.UnicodeEnv));

        if ObjectTypes <> nil then
          Field.ObjectType := ObjectTypes.FindType(OCISvcCtx, SchemaName + '.' + TypeName)
        else
          Field.ObjectType := nil;

        if Field.ObjectType = nil then begin
          Field.ObjectType := TOraType.Create(OCISvcCtx, SchemaName + '.' + TypeName);
          Field.ObjectType.Release;
        end;
      end;

      Field.SubDataType := FCommand.GetInternalType8(OraType, NationalCharset);
    {$IFNDEF LITE}
      Field.DBType := TOraConverterManager.GetDBType(OraType, NationalCharset);
      FetchConverter := GetMapFetchConverter(Field.Name, Field.DBType, Field.DBLength, Field.DBScale);
      if FetchConverter <> nil then
        Field.DataType := FetchConverter.InternalDataType
      else
    {$ENDIF}
      begin
        case OraType of
          SQLT_CHR,SQLT_AFC: begin
            if LongString or (Field.DBLength <= 255) then
              Field.DataType := dtString
            else
              Field.DataType := dtMemo;

            if FConnection.FUseUnicode then begin
              if Field.DataType = dtString then
                Field.DataType := dtWideString
              else if Field.DataType = dtMemo then
                Field.DataType := dtWideMemo;

              if Field.SubDataType = dtString then
                Field.SubDataType := dtWideString
              else if Field.SubDataType = dtNString then
                Field.SubDataType := dtNWideString
              else if Field.SubDataType = dtFixedChar then
                Field.SubDataType := dtFixedWideChar
              else if Field.SubDataType = dtFixedNChar then
                Field.SubDataType := dtFixedNWideChar;
            end;
          end;
          SQLT_NUM:
            if FCommand.FFieldsAsString or FCommand.FNumberAsString then
              if FConnection.FUseUnicode then
                Field.DataType := dtWideString
              else
                Field.DataType := dtString
            else begin
              if (FCommand.FUseDefaultDataTypes or FConnection.FEnableIntegers) and
                (Field.DBLength <= FCommand.GetSmallintPrecision) and (Field.DBScale = 0)
              then
                Field.DataType := dtSmallint
              else
              if (FCommand.FUseDefaultDataTypes or FConnection.FEnableIntegers) and
                (Field.DBLength <= FCommand.GetIntegerPrecision) and (Field.DBScale = 0)
              then
                Field.DataType := dtInteger
              else
              if (FCommand.FUseDefaultDataTypes or FConnection.FEnableIntegers) and
                (Field.DBLength <= FCommand.GetLargeIntPrecision) and (Field.DBScale = 0)
              then
                Field.DataType := dtLargeint
              else
              if not FCommand.FUseDefaultDataTypes and (FConnection.EnableBCD or FCommand.EnableBCD) and
                (Field.DBLength <= FCommand.GetBCDPrecision) and (Field.DBScale >= 0) and (Field.DBScale <= FCommand.GetBCDScale)
              then
                Field.DataType := dtBCD
              else
              if Field.DBLength <= FCommand.GetFloatPrecision then
                Field.DataType := dtFloat
            {$IFDEF VER6P}
            {$IFNDEF FPC}
              else
              if not FCommand.FUseDefaultDataTypes and (FConnection.EnableFMTBCD or FCommand.EnableFMTBCD) and
                (Field.DBLength <= FCommand.GetFmtBCDPrecision) and (Field.DBScale >= 0) and (Field.DBScale <= FCommand.GetFmtBCDScale)
              then
                Field.DataType := dtFMTBCD
            {$ENDIF}
            {$ENDIF}
              else
              if not FCommand.FUseDefaultDataTypes and FConnection.FEnableNumbers then
                Field.DataType := dtNumber
              else
                Field.DataType := dtFloat;
            end;
          SQLT_DAT:
            if FCommand.FFieldsAsString then
              if FConnection.FUseUnicode then
                Field.DataType := dtWideString
              else
                Field.DataType := dtString
            else
              Field.DataType := dtDateTime;
          SQLT_RID: // ROWID for Oracle 7
            if FConnection.FUseUnicode then
              Field.DataType := dtWideString
            else
              Field.DataType := dtString;
          SQLT_RDD: // ROWID is bound as string
            if FConnection.FUseUnicode then
              Field.DataType := dtWideString
            else
              Field.DataType := dtString;
          SQLT_BIN:
            if FCommand.FFieldsAsString or FCommand.FRawAsString then
              if FConnection.FUseUnicode then
                Field.DataType := dtWideString
              else
                Field.DataType := dtString
            else
              Field.DataType := dtVarBytes;
          SQLT_LNG:
            if FConnection.FUseUnicode then
              Field.DataType := dtWideMemo
            else
              Field.DataType := dtMemo;
          SQLT_LBI:
            Field.DataType := dtBlob;
          SQLT_CLOB: begin
            if FConnection.FUseUnicode and FConnection.FEnableWideOraClob then
              Field.DataType := dtWideOraClob
            else
              Field.DataType := dtOraClob;
          end;
          SQLT_BLOB:
            Field.DataType := dtOraBlob;
          SQLT_BFILEE:
            Field.DataType := dtBFILE;
          SQLT_CFILEE:
            Field.DataType := dtCFILE;
          SQLT_RSET:
            Field.DataType := dtCursor;
          SQLT_NTY: begin
            if (OCISvcCtx.Home.OCIVersion < 9200) and (TOraType(Field.ObjectType).DataType = dtXML) then
              RaiseError(SDataTypeNotSupported);
            Field.DataType := TOraType(Field.ObjectType).DataType;
          end;
          SQLT_REF: begin
            if (OCISvcCtx.Home.OCIVersion < 9200) and (TOraType(Field.ObjectType).DataType = dtXML) then
              RaiseError(SDataTypeNotSupported);
            Field.DataType := dtReference;
          end;
          SQLT_OSL:
            Field.DataType := dtLabel;
          SQLT_TIMESTAMP, SQLT_TIMESTAMP_TZ, SQLT_TIMESTAMP_LTZ,
          SQLT_INTERVAL_YM, SQLT_INTERVAL_DS:
          begin
            if OCISvcCtx.Home.OCIVersion < 9000 then
              RaiseError(SDataTypeNotSupported);

            if FCommand.FFieldsAsString
            {$IFDEF VER6P}
              or FConnection.FIntervalAsString and (OraType in [SQLT_INTERVAL_YM, SQLT_INTERVAL_DS])
            {$IFDEF FPC}
              or FConnection.FTimeStampAsString and (OraType in [SQLT_TIMESTAMP, SQLT_TIMESTAMP_TZ, SQLT_TIMESTAMP_LTZ])
            {$ENDIF}
            {$ENDIF}
            then
              if FConnection.FUseUnicode then
                Field.DataType := dtWideString
              else
                Field.DataType := dtString
            else begin
              case OraType of
                SQLT_INTERVAL_YM:
                  Field.DataType := dtIntervalYM;
                SQLT_INTERVAL_DS:
                  Field.DataType := dtIntervalDS;
                else begin
                {$IFDEF VER6P}
                {$IFNDEF FPC}
                  if FConnection.FEnableSQLTimeStamp then
                    Field.DataType := dtSQLTimeStamp
                  else
                {$ENDIF}
                {$ENDIF}
                    case OraType of
                      SQLT_TIMESTAMP:
                        Field.DataType := dtTimeStamp;
                      SQLT_TIMESTAMP_TZ:
                        Field.DataType := dtTimeStampTZ;
                      SQLT_TIMESTAMP_LTZ:
                        Field.DataType := dtTimeStampLTZ;
                    end;
                end;
              end;
            end;
          end;
          SQLT_UND:
            Field.DataType := dtUndefined;
          SQLT_IBFLOAT:
          //{$IFDEF VER14P}
          //  Field.DataType := dtSingle;
          //{$ELSE}
            Field.DataType := dtFloat;
          //{$ENDIF}
          SQLT_IBDOUBLE:
            Field.DataType := dtFloat;
          else
            RaiseError(SDataTypeNotSupported);
        end;
      end;

      if NationalCharset then begin
        if Field.DataType = dtString then
          if Field.SubDataType in [dtFixedChar, dtFixedNChar] then
            Field.SubDataType := dtFixedNChar
          else
            Field.SubDataType := dtNString
        else if Field.DataType = dtWideString then
          if Field.SubDataType in [dtFixedWideChar, dtFixedNWideChar] then
            Field.SubDataType := dtFixedNWideChar
          else
            Field.SubDataType := dtNWideString
        else if Field.DataType in [dtMemo, dtWideMemo, dtOraClob, dtWideOraClob] then
          Field.SubDataType := dtNClob;
      end;

      case Field.SubDataType of
        dtString, dtNString, dtFixedChar, dtFixedNChar,
        dtWideString, dtNWideString, dtFixedWideChar, dtFixedNWideChar:
        begin
          Field.Length := Field.DBLength;

          if CharUsed and (Field.SubDataType in [dtString, dtNString,  dtFixedChar, dtFixedNChar]) then begin
            // for NVARCAHR and FCharLength = 1 or 0 - each char has size 2 bytes
            // in non Unicode mode and CharLength > 1 size of field = length in chars * size of char in bytes
            if FConnection.FCharLength > 1 then
              Field.Length := Field.DBLength * FConnection.FCharLength;
          end;

          if FConnection.ConvertEOL then
            Field.Length := Field.Length * 3 div 2; // data can grow on ConvertEOL
        end;
        dtNumber: begin
          Field.Length := Field.DBLength;
          Field.Scale := Field.DBScale;

          if Field.DataType = dtString then begin// Number as string
            if Field.DBLength = 0 then
              // max scale = 130
              Field.Length := 132
            else if Field.DBScale < 127 then // NUMBER
              Field.Length := Field.DBlength + 2;
          end
          else if Field.DataType = dtBCD then begin
            if Field.Length > MaxBcdPrecision then
              Field.Length := MaxBcdPrecision;
            if Field.Scale > MaxBcdScale then
              Field.Scale := MaxBcdScale;
          end
        {$IFDEF VER6P}
        {$IFNDEF FPC}
          else if Field.DataType = dtFMTBCD then begin
            if Field.Length > MaxFMTBcdDigits then
              Field.Length := MaxFMTBcdDigits;
            if Field.Scale > Field.Length then // if length was reduced
              Field.Scale := Field.Length;
          end
        {$ENDIF}
        {$ENDIF}
        end;
        dtRowId:
          Field.Length := RowIdSize;
        dtURowId:  // ROWID is bound as string
          if Field.DBLength > SizeOf(IntPtr) then // UROWID has its actual datasize
            Field.Length := Ceil(Field.DBLength * 1.34) // for correct conversion into 64 base string
          else
            Field.Length := RowIdSize;
        dtVarBytes, dtExtVarBytes:
          if Field.DataType = dtWideString then
            Field.Length := Field.DBLength * 2
          else if Field.DataType = dtString then
            Field.Length := Field.DBLength * 2
          else
            Field.Length := Field.DBLength;
        dtDateTime:
          Field.Length := GetNlsFieldDesc(nlsDateFormat);
        dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ,
        dtIntervalYM, dtIntervalDS:
          if not (Field.DataType in [dtString, dtExtString, dtWideString, dtExtWideString]) then begin
            Field.Length := Field.DBLength;
            if Field.DataType = dtIntervalDS then
              Field.Scale := Field.DBScale;
          end
          else // FieldsAsString := True
            case Field.SubDataType of
              dtTimeStamp, dtTimeStampLTZ:
                Field.Length := GetNlsFieldDesc(nlsTimeStampFormat);
              dtTimeStampTZ:
                Field.Length := GetNlsFieldDesc(nlsTimeStampTZFormat);
              dtIntervalYM:
                  Field.Length := Field.DBLength + 4; // interval year to month form is +Prec-MM
              dtIntervalDS:
                  Field.Length := Field.DBLength + Field.DBScale + 11; // interval day to second form is +Prec HH:MM:SS.Scale
            end;
        dtBFloat: begin
          Field.Length := 38;
          Field.Scale := 127;
        end;
        dtBDouble: begin
          Field.Length := 38;
          Field.Scale := 127;
        end;
      end;

      if not FlatBuffer and (Field.Length >= FlatBufferLimit) then
        if Field.DataType = dtString then
          Field.DataType := dtExtString
        else if Field.DataType = dtWideString then
          Field.DataType := dtExtWideString
        else if Field.DataType = dtVarBytes then
          Field.DataType := dtExtVarBytes;

      Field.Size := GetBufferSize(Field.DataType, Field.Length);

      Check(OCI8.OCIAttrGet2(hParam, OCI_DTYPE_PARAM, ValueInt, nil, OCI_ATTR_IS_NULL, OCISvcCtx.hOCIError));
      IsNull := Byte(ValueInt);

    finally
      // free memory after OCIParamGet
      OCI8.OCIDescriptorFree(hParam, OCI_DTYPE_PARAM);
    end;

  finally
    Marshal.FreeHGlobal(Ptr);
  end;

  Field.Required := (IsNull = 0) and (Field.Name <> 'ROWID');
  Result := True;
end;

procedure TOCIRecordSet.GetDateFromBuf(Buf: IntPtr; Date: IntPtr; HasParent: boolean; Format: TDateFormat);
var
  DateTime: TDateTime;
begin
  if HasParent then begin
    inherited;
    exit;
  end;

  case Format of
    dfMSecs: begin
      try
        Marshal.WriteInt64(Date, BitConverter.DoubleToInt64Bits(OraDateToMSecs(Buf)));
      except
        on E: EConvertError do
          // 1 day - to prevent error on converting to TDateTime
          Marshal.WriteInt64(Date, BitConverter.DoubleToInt64Bits(MSecsPerDay));
      end;
    end;
    dfDateTime: begin
      try
        DateTime := OraDateToDateTime(Buf);
        Marshal.WriteInt64(Date, BitConverter.DoubleToInt64Bits(DateTime));
      except
        on E: EConvertError do
          Marshal.WriteInt64(Date, 0);
      end;
    end;
  else
    // for calc fields
    inherited;
  end;
end;

procedure TOCIRecordSet.PutDateToBuf(Buf: IntPtr; Date: IntPtr; HasParent: boolean; Format: TDateFormat);
begin
  if HasParent then begin
    inherited;
    exit;
  end;

  case Format of
    dfMSecs:
      MSecsToOraDate(BitConverter.Int64BitsToDouble(Marshal.ReadInt64(Date)), Buf);
    dfDateTime:
      DateTimeToOraDate(BitConverter.Int64BitsToDouble(Marshal.ReadInt64(Date)), Buf);
  else
    inherited;
  end;
end;

function TOCIRecordSet.GetNull(Field: TFieldDesc; RecBuf: IntPtr): boolean;
var
  Buf: IntPtr;
  OraObject: TOraObject;
begin
{$IFNDEF LITE}
  CheckFetched(RecBuf, Field);
{$ENDIF}

  if not Field.HasParent then begin
      case Field.DataType of
        dtObject, dtArray, dtTable: begin
          // indicator in record buffer is not synchronized with object state
          OraObject := TOraObject(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset)));
          Result := OraObject.IsNull;
        end;
        dtNumber:
          Result := TOraNumber(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset))).IsNull;
        dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ:
          Result := TOraTimeStamp(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset))).IsNull;
        dtIntervalYM, dtIntervalDS:
          Result := TOraInterval(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset))).IsNull;
      else
        Result :=
          Marshal.ReadInt16(RecBuf, DataSize + (Field.FieldNo - 1) * sizeof(sb2)) = -1;
      end;

      if not Result then begin
        case Field.DataType of
          dtDateTime: begin
            Buf := PtrOffset(RecBuf, Field.Offset);
            Result :=
          {$IFDEF CLR}
              (Marshal.ReadByte(Buf, 0) <= 100) or
          {$ELSE}
              ((Marshal.ReadByte(Buf, 0) = 100) and (Marshal.ReadInt32(Buf, 1) = 100)) or // only exclude year zero
          {$ENDIF}
              (Marshal.ReadInt16(Buf, 2) = 0) or
              (Marshal.ReadByte(Buf, 4) < 1) or (Marshal.ReadByte(Buf, 5) < 1) or (Marshal.ReadByte(Buf, 6) < 1) or
              (Marshal.ReadByte(Buf, 4) > 24) or (Marshal.ReadByte(Buf, 5) > 60) or
              (Marshal.ReadByte(Buf, 6) > 60);
          end;
        end;
      end;
    //end;
  end
  else
    Result := GetChildFieldIsNull(Field, RecBuf);
  if Result then
    Result := GetNullByBlob(Field, RecBuf);
end;

procedure TOCIRecordSet.SetNull(Field: TFieldDesc; RecBuf: IntPtr; Value: boolean);
var
  Blob: TBlob;
  Ind: OCIInd;
  OraTimeStamp: TOraTimeStamp;
  OraInterval: TOraInterval;
  OraNumber: TOraNumber;
  OraObject: TOraObject;
  ObjPtr: IntPtr;
begin
  if not Field.HasParent then begin
    if Value then
      Ind := -1
    else
      Ind := 0;

    Marshal.WriteInt16(
      RecBuf, DataSize + (Field.FieldNo - 1) * SizeOf(sb2), Ind);

    if Value and Field.IsBlob then begin // clear Blob value
      Blob := TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset)));
      if Blob <> nil then
        Blob.Clear;
    end;

    case Field.DataType of
      dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ: begin
        OraTimeStamp := TOraTimeStamp(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset)));
        if OraTimeStamp <> nil then
          Marshal.WriteInt16(OraTimeStamp.FIndicator, Ind);
      end;
      dtIntervalYM, dtIntervalDS: begin
        OraInterval := TOraInterval(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset)));
        if OraInterval <> nil then
          Marshal.WriteInt16(OraInterval.FIndicator, Ind);
      end;
      dtNumber: begin
        ObjPtr := Marshal.ReadIntPtr(RecBuf, Field.Offset);
        OraNumber := TOraNumber(GetGCHandleTarget(ObjPtr));
        if OraNumber <> nil then
          Marshal.WriteInt16(OraNumber.FIndicator, Ind);
      end;
      dtObject, dtArray, dtTable: begin
        OraObject := TOraObject(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset)));
        if OraObject <> nil then
          OraObject.IsNull := Value;
      end;
    end;
  end
  else
    PutChildField(Field, RecBuf, nil);

{$IFNDEF LITE}
  SetEncrypted(Field, RecBuf, not Value);
{$ENDIF}
end;

class function TOCIRecordSet.IsBlobDataType(DataType: word): boolean;
begin
  Result := DataType in [dtBlob, dtMemo, dtWideMemo, dtOraBlob, dtOraClob, dtWideOraClob, dtBFile, dtCFile];
end;

class function TOCIRecordSet.IsComplexDataType(DataType: word): boolean;
begin
  case DataType of
    dtCursor, dtObject, dtXML, dtReference, dtArray, dtTable, dtTimeStamp, dtTimeStampTZ,
    dtTimeStampLTZ, dtIntervalYM, dtIntervalDS, dtExtString, dtExtWideString, dtExtVarBytes,
    dtNumber:
      Result := True;
  else
    Result := IsBlobDataType(DataType);
  end;
end;

class function TOCIRecordSet.IsObjectDataType(DataType: word): boolean;
begin
  Result := (DataType = dtTable) or inherited IsObjectDataType(DataType);
end;

class function TOCIRecordSet.IsConvertedFieldType(DataType: word): boolean;
begin
  case DataType of
    dtLargeint, dtBCD{$IFDEF VER6P}{$IFNDEF FPC}, dtFMTBCD, dtSQLTimeStamp{$ENDIF}{$ENDIF}:
      Result := True;
  else
    Result := False;
  end;
end;

{ Records }

procedure TOCIRecordSet.CreateComplexField(RecBuf: IntPtr; Field: TFieldDesc);
var
  Ptr: IntPtr;
  Lob: TOraLob;
  Blob: TBlob;
  BFile: TOraFile;
  Cursor: TOraCursor;
  OraObject: TOraObject;
  OraRef: TOraRef;
  OraArray: TOraArray;
  OraNestTable: TOraNestTable;
  OraTimeStamp: TOraTimeStamp;
begin
  Ptr := PtrOffset(RecBuf, Field.Offset);
  case Field.DataType of
    dtBlob, dtMemo, dtWideMemo: begin
      inherited;

      if (FCommand.FOCICallStyle = OCI80) and
         (Field.SubDataType in [dtString, dtNString, dtWideString, dtNWideString,
                                dtFixedChar, dtFixedNChar, dtFixedWideChar, dtFixedNWideChar])
      then begin
        Blob := TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset)));
        Blob.IsUnicode := UseUnicode;
      end;
    end;
    dtOraBlob, dtOraClob, dtWideOraClob: begin
      Lob := TOraLob.Create(OCISvcCtx);
      if Field.DataType <> dtOraBlob then begin
        if Field.SubDataType = dtNClob then
          Lob.LobType := ltNClob
        else
          Lob.LobType := ltClob;
        Lob.IsUnicode := UseUnicode;
        Lob.FCharsetId := FConnection.FCharsetId;
        Lob.FCharLength := CharLength;
      end
      else
        Lob.LobType := ltBlob;
      Lob.AllocLob;
      Lob.Cached := FCommand.FCacheLobs;
      Lob.EnableRollback;
      Marshal.WriteIntPtr(Ptr, Lob.GCHandle);
    end;
    dtBFile, dtCFile: begin
      if (FConnection <> nil) and FConnection.GetConnected then
        BFile := TOraFile.Create(OCISvcCtx)
      else
        BFile := TOraFile.Create(OCISvcCtx);
      BFile.AllocLob;
      BFile.Cached := FCommand.FCacheLobs;
      BFile.EnableRollback;
      Marshal.WriteIntPtr(Ptr, BFile.GCHandle);
    end;
    dtCursor: begin
      Cursor := TOraCursor.Create;
      Cursor.Init(OCISvcCtx, FCommand.OCICallStyle);
      Marshal.WriteIntPtr(Ptr, Cursor.GCHandle);
    end;
    dtXML: begin
      if (FConnection = nil) or not FConnection.GetConnected then
        RaiseError('Unsupported Disconnected mode type');
      if not TOraType(Field.ObjectType).Valid then
        TOraType(Field.ObjectType).Describe(OCISvcCtx);

      OraObject := TOraXML.Create(OCISvcCtx, TOraType(Field.ObjectType));
      if ((OCISvcCtx.Home.OCIVersion > 9203) and (OCISvcCtx.Home.OCIVersion < 9206)) then    //Bug with memory
        OraObject.AllocObject;            //leak with 9204 client
      Marshal.WriteIntPtr(Ptr, OraObject.GCHandle);
    end;
    dtObject: begin
      if (FConnection = nil) or not FConnection.GetConnected then
        RaiseError('Unsupported Disconnected mode type');
      if not TOraType(Field.ObjectType).Valid then
        TOraType(Field.ObjectType).Describe(OCISvcCtx);

      OraObject := TOraObject.Create(TOraType(Field.ObjectType));
      //OraObject.AllocObject(FConnection.GetSvcCtx); // ??? Optim?
      OraObject.NativeInstance := True;
      Marshal.WriteIntPtr(Ptr, OraObject.GCHandle);
    end;
    dtReference: begin
      if (FConnection = nil) or not FConnection.GetConnected then
        RaiseError('Unsupported Disconnected mode type');
      if not TOraType(Field.ObjectType).Valid then
        TOraType(Field.ObjectType).Describe(OCISvcCtx);

      OraRef := TOraRef.Create(TOraType(Field.ObjectType));
      Marshal.WriteIntPtr(Ptr, OraRef.GCHandle);
    end;
    dtArray: begin
      if (FConnection = nil) or not FConnection.GetConnected then
        RaiseError('Unsupported Disconnected mode type');
      if not TOraType(Field.ObjectType).Valid then
        TOraType(Field.ObjectType).Describe(OCISvcCtx);

      OraArray := TOraArray.Create(TOraType(Field.ObjectType));
      OraArray.AllocObject(OCISvcCtx); // ??? Optim?
      Marshal.WriteIntPtr(Ptr, OraArray.GCHandle);
    end;
    dtTable: begin
      if (FConnection = nil) or not FConnection.GetConnected then
        RaiseError('Unsupported Disconnected mode type');
      if not TOraType(Field.ObjectType).Valid then
        TOraType(Field.ObjectType).Describe(OCISvcCtx);

      OraNestTable := TOraNestTable.Create(TOraType(Field.ObjectType));
      OraNestTable.AllocObject(OCISvcCtx); // ??? Optim?
      Marshal.WriteIntPtr(Ptr, OraNestTable.GCHandle);
    end;
    dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ: begin
      OraTimeStamp := TOraTimeStamp.Create(OCISvcCtx, Field.DataType);
      OraTimeStamp.Precision := Field.Length;
      Marshal.WriteIntPtr(Ptr, OraTimeStamp.GCHandle);
    end;
    dtIntervalYM, dtIntervalDS: begin
      Marshal.WriteIntPtr(Ptr, TOraInterval.Create(OCISvcCtx, Field.DataType).GCHandle);
    end;
    dtNumber:
      Marshal.WriteIntPtr(Ptr, TOraNumber.Create(OCISvcCtx).GCHandle);
    else
      inherited;
  end;
end;

procedure TOCIRecordSet.FreeComplexField(RecBuf: IntPtr; Field: TFieldDesc);
var
  ObjPtr: IntPtr;
  SharedObject: TSharedObject;
begin
  case Field.DataType of
    dtOraBlob, dtOraClob, dtWideOraClob,
    dtBFile, dtCFile,
    dtCursor,
    dtObject, dtXML, dtReference, dtArray, dtTable,
    dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ, dtIntervalYM, dtIntervalDS,
    dtNumber: begin
      ObjPtr := Marshal.ReadIntPtr(RecBuf, Field.Offset);
      if ObjPtr <> nil then begin
        SharedObject := TSharedObject(GetGCHandleTarget(ObjPtr));
        SharedObject.Free;
        Marshal.WriteIntPtr(RecBuf, Field.Offset, nil)
      end;
    end;
  else
    inherited;
  end;
end;

procedure TOCIRecordSet.CopyComplexField(Source: IntPtr; Dest: IntPtr; Field: TFieldDesc);
var
  SrcPtr: IntPtr;
  DestPtr: IntPtr;
  OraObjectSrc: TOraObject;
  OraObjectDest: TOraObject;
begin
  SrcPtr := Marshal.ReadIntPtr(Source, Field.Offset);
  DestPtr := Marshal.ReadIntPtr(Dest, Field.Offset);
  case Field.DataType of
    dtObject,dtXML,dtReference,dtArray,dtTable: begin
      OraObjectSrc := TOraObject(GetGCHandleTarget(SrcPtr));
      OraObjectDest := TOraObject(GetGCHandleTarget(DestPtr));
      OraObjectDest.Assign(OraObjectSrc);
      if DisconnectedMode then
        OraObjectDest.CacheObject;
    end;
    dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ:
      TOraTimeStamp(GetGCHandleTarget(SrcPtr)).AssignTo(TOraTimeStamp(GetGCHandleTarget(DestPtr)));
    dtIntervalYM, dtIntervalDS:
      TOraInterval(GetGCHandleTarget(SrcPtr)).AssignTo(TOraInterval(GetGCHandleTarget(DestPtr)));
    dtNumber:
      TOraNumber(GetGCHandleTarget(SrcPtr)).AssignTo(TOraNumber(GetGCHandleTarget(DestPtr)));
  else
    inherited;
  end;
end;

function TOCIRecordSet.InternalCompareFieldValue(ValuePtr: IntPtr; ValueType: Word; FieldBuf: IntPtr; FieldType: Word; FieldLength: Integer; HasParent: boolean; IsFixed: boolean; const Options: TCompareOptions): integer;
var
  OraNumber: TOraNumber;
  OraTimeStamp: TOraTimeStamp;
  OraInterval: TOraInterval;
begin
  Result := 0;
  case FieldType of
    dtNumber:
      if ValueType in [dtFloat, dtSingle, dtInt32, dtString, dtLargeint] then begin
        OraNumber := TOraNumber.Create(OCISvcCtx);
        try
          case ValueType of
            dtFloat:
              OraNumber.AsFloat := BitConverter.Int64BitsToDouble(Marshal.ReadInt64(ValuePtr));
            dtSingle:
              OraNumber.AsFloat := CRBitConverter.Int32BitsToSingle(Marshal.ReadInt32(ValuePtr));
            dtInt32:
              OraNumber.AsInteger := Marshal.ReadInt32(ValuePtr);
            dtString:
              OraNumber.AsString := string(Marshal.PtrToStringAnsi(ValuePtr));
            dtLargeint:
              OraNumber.AsLargeInt := Marshal.ReadInt64(ValuePtr);
          end;
          Result := OraNumber.Compare(TOraNumber(GetGCHandleTarget(Marshal.ReadIntPtr(FieldBuf))));
        finally
          OraNumber.Free;
        end;
      end
      else
      if ValueType = dtNumber then begin
        OraNumber := TOraNumber(GetGCHandleTarget(Marshal.ReadIntPtr(ValuePtr)));
        Result := OraNumber.Compare(TOraNumber(GetGCHandleTarget(Marshal.ReadIntPtr(FieldBuf))));
      end
      else
        Assert(False);
    dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ: // TODO: SQLTimeStamp support
      if ValueType in [dtDateTime, dtString] then begin
        OraTimeStamp := TOraTimeStamp.Create(OCISvcCtx, FieldType);
        try
          case ValueType of
            dtDateTime:
              OraTimeStamp.AsDateTime := BitConverter.Int64BitsToDouble(Marshal.ReadInt64(ValuePtr));
            dtString:
              OraTimeStamp.AsString := string(Marshal.PtrToStringAnsi(ValuePtr));
          end;
          Result := OraTimeStamp.Compare(TOraTimeStamp(GetGCHandleTarget(Marshal.ReadIntPtr(FieldBuf))));
        finally
          OraTimeStamp.Free;
        end;
      end
      else
      if ValueType in [dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ] then begin
        OraTimeStamp := TOraTimeStamp(GetGCHandleTarget(Marshal.ReadIntPtr(ValuePtr)));
        Result := OraTimeStamp.Compare(TOraTimeStamp(GetGCHandleTarget(Marshal.ReadIntPtr(FieldBuf))));
      end
      else
        Assert(False);
    dtIntervalYM, dtIntervalDS:
      if ValueType = dtString then begin
        OraInterval := TOraInterval.Create(OCISvcCtx, FieldType);
        try
          OraInterval.AsString := string(Marshal.PtrToStringAnsi(ValuePtr));
          Result := OraInterval.Compare(TOraInterval(GetGCHandleTarget(Marshal.ReadIntPtr(FieldBuf))));
        finally
          OraInterval.Free;
        end;
      end
      else
      if ValueType in [dtIntervalYM, dtIntervalDS] then begin
        OraInterval := TOraInterval(GetGCHandleTarget(Marshal.ReadIntPtr(ValuePtr)));
        Result := OraInterval.Compare(TOraInterval(GetGCHandleTarget(Marshal.ReadIntPtr(FieldBuf))));
      end
      else
        Assert(False);
  else
    Result := inherited InternalCompareFieldValue(ValuePtr, ValueType, FieldBuf, FieldType, FieldLength, HasParent, IsFixed, Options);
  end;
end;

function TOCIRecordSet.GetEOF: boolean;
begin
  if (IntPtr(CurrentItem )= nil) or (IntPtr(CurrentItem.Next) = nil) then begin
    if hExecFetchThread = nil then
    {$IFDEF CLR}
      hEvent.WaitFor(INFINITE)
    {$ENDIF}
    {$IFDEF WIN32_64}
      WaitForSingleObject(THandle(hEvent.Handle), INFINITE)
    {$ENDIF}
    else begin
      Result := True;
      Exit;
    end;
  end;

  Result := inherited GetEOF;
end;

procedure TOCIRecordSet.SortItems;
begin
  // SortItems can be called during the command is executing or fetching
  if not GetNonBlocking or (FCommand.GetCursorState = csFetched) or
    ((FCommand.GetCursorState = csInactive) and not FCommand.Executing) // for AutoClose
  then
    inherited;
end;

procedure TOCIRecordSet.SetFilterText(const Value: string);
begin
  if not GetNonBlocking or (FCommand.GetCursorState = csFetched) or
    ((FCommand.GetCursorState = csInactive) and not FCommand.Executing) // for AutoClose
  then
    inherited
  else
    FTempFilterText := Value;
end;

procedure TOCIRecordSet.FilterUpdated;
begin
  // FilterUpdated can be called during the command is executing or fetching
  if not GetNonBlocking or (FCommand.GetCursorState = csFetched) or
    ((FCommand.GetCursorState = csInactive) and not FCommand.Executing) // for AutoClose
  then
    inherited;
end;

{ Fetch }

procedure TOCIRecordSet.AllocFetchBlock;
var
  i: integer;
  RefFieldCount : integer;
  FieldDesc: TFieldDesc;
begin
  if FFetchBlock <> nil then
    FreeFetchBlock;
  RefFieldCount := 0;
  FFetchBlockItemSize := 0;
  for i := 0 to FFields.Count - 1 do begin
    FieldDesc := FFields[i];
    if not FieldDesc.HasParent and
       (FieldDesc.IsComplex or TOCIFieldDesc(FieldDesc).IsConverted) and
       (FieldDesc.ActualFieldNo > -1)
    then begin
      if (FieldDesc.DataType in [dtExtString, dtMemo]) and
         (not TOCIFieldDesc(FieldDesc).IsBlobSubType)
      then // String as memo
        Inc(FFetchBlockItemSize, FieldDesc.Length + 1) // for terminator
      else
      if (FieldDesc.DataType in [dtExtWideString, dtWideMemo]) and
         (not TOCIFieldDesc(FieldDesc).IsBlobSubType) 
      then // WideString
        Inc(FFetchBlockItemSize, FieldDesc.Length * 2 + 2) // for terminator
      else
        case FieldDesc.DataType of
          dtExtVarBytes:
            Inc(FFetchBlockItemSize, FieldDesc.Length + SizeOf(Word));
          dtNumber, dtLargeint, dtBCD{$IFDEF VER6P}{$IFNDEF FPC}, dtFMTBCD{$ENDIF}{$ENDIF}:
            Inc(FFetchBlockItemSize, OCI_NUMBER_SIZE);
          dtXML:
            Inc(FFetchBlockItemSize, 2 * sizeof(IntPtr));
          dtReference: begin
            Inc(FFetchBlockItemSize, sizeof(IntPtr));
            Inc(RefFieldCount);
          end;
        else
          Inc(FFetchBlockItemSize, sizeof(IntPtr));
        end;

      FFetchBlockItemSize := (FFetchBlockItemSize + 1) and $FFFFFFFE; // align to 2
    end;
  end;
  if FFetchBlockItemSize > 0 then
    FFetchBlock := Marshal.AllocHGlobal(FFetchBlockItemSize * FFetchRows + RefFieldCount * FFetchRows * sizeof(sb2));
end;

procedure TOCIRecordSet.FreeFetchBlock;
begin
  if FFetchBlock <> nil then
    Marshal.FreeHGlobal(FFetchBlock);
  FFetchBlock := nil;
  FFetchBlockItemSize := 0;
end;

function TOCIRecordSet.CallbackDefine(Define: pOCIDefine; Iter: cardinal; var Buf: IntPtr;
  var BufLen: pub4; var PieceStatus: ub1; var Ind: IntPtr): sb4;
var
  i: word;
  Blob: TBlob;
  Piece: PPieceHeader;
  Len: cardinal;
begin
  i := 0;
  while (i < FFields.Count) and (FFields[i].Handle <> Define) do
    Inc(i);

  Assert(i < FFields.Count);

  Blob := TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(FFetchItems,
    (RecordSize + sizeof(TItemHeader)) * Integer(Iter) + sizeof(TItemHeader) + FFields[i].Offset)));

  Len := Blob.PieceSize;
  Blob.AllocPiece(Piece, Len);
  Blob.AppendPiece(Piece);

  Buf := PieceData(Piece);
  Piece.Used := Len;
  BufLen := PieceUsedPtr(Piece);

  Ind := PtrOffset(FFetchItems,
    (RecordSize + sizeof(TItemHeader)) * Integer(Iter) + sizeof(TItemHeader) + DataSize + i * sizeof(sb2));

  if (OCISvcCtx.Home.OCIVersion >= 8160) and (OCISvcCtx.Home.OCIVersion < 9000) then begin
  // WAR fix Oracle bug that increments IntPtr to indicator; occurs on 8.1.6,8.1.7
    Ind := PtrOffset(Ind, - Integer(Iter) * sizeof(sb2));
  end;

  PieceStatus := OCI_NEXT_PIECE;

  Result := OCI_CONTINUE;
end;

function OCICallbackDefine(octxp: IntPtr; defnp: pOCIDefine; iter: ub4; var bufp: IntPtr;
  var alenp: pub4; var piece: ub1; var indp: IntPtr; var rcodep: pub2): sb4; {$IFNDEF CLR} cdecl; {$ENDIF}
begin
  Result := TOCIRecordSet(GetGCHandleTarget(octxp)).CallbackDefine(defnp, iter, bufp,
    alenp, piece, indp);
  rcodep := nil;
end;

function TOCIRecordSet.NeedUnPrepareAfterFetch: boolean;
begin
  Result := FAutoClose;
end;

function TOCIRecordSet.InternalFetch(FetchBack: boolean = False): boolean;
begin
  if FPieceFetch or {$IFNDEF UNIDACPRO}OraCall{$ELSE}OraCallUni{$ENDIF}.OCILite then  // Lite don't supports array fetch
    Result := FetchPiece(FetchBack)
  else
    Result := FetchArray(FetchBack);
end;

procedure TOCIRecordSet.DoBeforeFetch(out Cancel: boolean);
begin
  Cancel := FWaitForFetchBreak;

  if Assigned(FOnBeforeFetch) then
    FOnBeforeFetch(Cancel);

  if Cancel then begin
    if FAutoClose then
      FCommand.InternalCancel
    else
      // reset cursor state for FetchAll
      if (FCommand.GetCursorState = csFetchingAll) then
        FCommand.SetCursorState(csFetching);
  end;
end;

procedure TOCIRecordSet.DoAfterFetch;
{$IFDEF MSWINDOWS}
var
  InThread: boolean;
{$ENDIF}
begin
  if Assigned(FOnAfterFetch) then begin
  {$IFDEF MSWINDOWS}
  {$IFDEF CLR}
    InThread := (hFetchAllThread <> nil) and (hFetchAllThread.Handle = Thread.CurrentThread)
      or (hExecFetchThread <> nil) and (hExecFetchThread.Handle = Thread.CurrentThread);
  {$ELSE}
    InThread := (hFetchAllThread <> nil) and (hFetchAllThread.ThreadID = GetCurrentThreadId)
      or (hExecFetchThread <> nil) and (hExecFetchThread.ThreadID = GetCurrentThreadId);
  {$ENDIF}

    if InThread then begin
      if not FFetchAll or (FCommand.GetCursorState = csFetched) then
        PostMessage(hODACWindow, WM_AFTERFETCH, WPARAM(GCHandle), 0);
    end
    else
  {$ENDIF}
      FOnAfterFetch();
  end;
end;

{$IFNDEF LITE}
function TOCIRecordSet.GetSmartFetchMetaInfoSQL(const BaseSQL: string): string;
begin
  Result := BaseSQL;
end;
{$ENDIF}

procedure TOCIRecordSet.FreeAllItems;
var
  Item: PItemHeader;
begin
  while IntPtr(FirstItem) <> nil do begin
    Item := FirstItem;
    FirstItem := Item.Next;
    if Item.Flag = flUsed then begin
      if FPieceFetch then
        BlockMan.FreeItem(Item);
    end;
  end;
  LastItem := nil;
end;

procedure TOCIRecordSet.InitFetchedBlock(Block: PBlockHeader; RowsObtained: Integer; FetchBack: boolean);
begin
  if Filtered and not (FFetchAll or (GetNonBlocking and (Length(IndexFields) > 0))) then begin
    if FetchBack then
      InitFetchedItems(PtrOffset(Block, sizeof(TBlockHeader) + (RowsObtained - 1) * (sizeof(TItemHeader) + RecordSize)), FNoData, FetchBack)
    else
      InitFetchedItems(PtrOffset(Block, sizeof(TBlockHeader)), FNoData, FetchBack);
  end
  else
    if not (FetchBack or FNoData) then
      Inc(FRecordCount, RowsObtained);

{$IFDEF MSWINDOWS}
  // in the thread only
  if (hExecFetchThread <> nil) or (hFetchAllThread <> nil) then
    PulseEvent(THandle(hEvent.Handle));
{$ENDIF}
end;

function TOCIRecordSet.FetchArray(FetchBack: boolean = False): boolean;
var
  i,j: integer;
  pRec, pInd: IntPtr;
  Fetched: word;
  Block: PBlockHeader;
  TempBlock: PBlockHeader;
  Item: IntPtr;
  ItemSize: integer;
  NewBlock: boolean;
  BufferPtr: IntPtr;
  ComplexFieldOffset: integer;
  RefFieldCount: integer;
  BufSkip: integer;
  IndSkip: integer;
  ObjPtr: IntPtr;
  OraFile: TOraFile;
  OraRef: TOraRef;
  IndPtr: IntPtr;
  OldFirstItem: PItemHeader;
  OldLastItem: PItemHeader;
  OldFetchStart: integer;
  OldFetchEnd: integer;
  CharsetID: word;
  FieldDesc: TOCIFieldDesc;
  SharedPiece: PPieceHeader;
{$IFNDEF LITE}
  StandAloneBlock: boolean;
{$ENDIF}

  procedure InitBlock;
  var
    i,j: integer;
    Ptr: IntPtr;
    ObjPtr: IntPtr;
    FieldPtr: IntPtr;
    FieldDesc: TOCIFieldDesc;
  {$IFDEF VER6P}
    OraTimeStamp: TOraTimeStamp;
  {$ENDIF}
  begin
  // Create complex filds
    ComplexFieldOffset := 0;
    if not (HasComplexFields or FHasConvertedFields) then
      Exit;
    for i := 0 to FFetchRows - 1 do begin
      Ptr := PtrOffset(Block, sizeof(TBlockHeader) + i * ItemSize + sizeof(TItemHeader));
      CreateComplexFields(Ptr, True);
      for j := 0 to FFields.Count - 1 do begin
        FieldDesc := TOCIFieldDesc(FFields[j]);
        if not FieldDesc.HasParent and (FieldDesc.IsComplex or TOCIFieldDesc(FieldDesc).IsConverted)
           and (FieldDesc.ActualFieldNo > -1) {KeyOnly SmartFetchState}
        then begin
          ObjPtr := Marshal.ReadIntPtr(Ptr, FieldDesc.Offset);
          FieldPtr := PtrOffset(FFetchBlock, ComplexFieldOffset);
          case FieldDesc.DataType of
            dtCursor: begin
              TOraCursor(GetGCHandleTarget(ObjPtr)).FState := csExecuted;
              Marshal.WriteIntPtr(FieldPtr, TOraCursor(GetGCHandleTarget(ObjPtr)).OCIStmt);
            end;
            dtOraBlob,dtOraClob,dtWideOraClob,dtBFile,dtCFile:
              Marshal.WriteIntPtr(FieldPtr, TOraLob(GetGCHandleTarget(ObjPtr)).OCILobLocator);
            dtObject,dtArray,dtTable:
              Marshal.WriteIntPtr(FieldPtr, TOraObject(GetGCHandleTarget(ObjPtr)).Instance);
            dtXML:begin
              Marshal.WriteIntPtr(FieldPtr, TOraXML(GetGCHandleTarget(ObjPtr)).Instance);
              Marshal.WriteIntPtr(FieldPtr, sizeof(IntPtr), nil);
            end;
            dtReference:
              Marshal.WriteIntPtr(FieldPtr, TOraRef(GetGCHandleTarget(ObjPtr)).OCIRef);
            dtMemo:
              if FieldDesc.SubDataType in [dtString, dtNString, dtFixedChar, dtFixedNChar] then // String as memo
                Marshal.WriteByte(FieldPtr, 0);
            dtWideMemo:
              if FieldDesc.SubDataType in [dtWideString, dtNWideString, dtFixedWideChar, dtFixedNWideChar] then // WideString as memo
                Marshal.WriteInt16(FieldPtr, 0);
            dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ:
              Marshal.WriteIntPtr(FieldPtr, TOraTimeStamp(GetGCHandleTarget(ObjPtr)).OCIDateTime);
          {$IFDEF VER6P}
          {$IFNDEF FPC}
            dtSQLTimeStamp: begin
              OraTimeStamp := TOraTimeStamp.Create(OCISvcCtx, FieldDesc.DataType);
              OraTimeStamp.Precision := FieldDesc.Length;
              Marshal.WriteIntPtr(Ptr, FieldDesc.Offset, OraTimeStamp.GCHandle);
              Marshal.WriteIntPtr(FieldPtr, OraTimeStamp.OCIDateTime);
            end;
          {$ENDIF}
          {$ENDIF}
            dtIntervalYM, dtIntervalDS:
              Marshal.WriteIntPtr(FieldPtr, TOraInterval(GetGCHandleTarget(ObjPtr)).OCIInterval);
            dtExtString:
              Marshal.WriteIntPtr(FieldPtr, nil);
            dtExtWideString:
              Marshal.WriteIntPtr(FieldPtr, nil);
            dtExtVarBytes:
              Marshal.WriteIntPtr(FieldPtr, nil);
          end;
          if (FieldDesc.DataType in [dtExtString, dtMemo]) and
             (not TOCIFieldDesc(FieldDesc).IsBlobSubType)
          then // String as memo
            Inc(ComplexFieldOffset, FieldDesc.Length + 1) // for terminator
          else
          if (FieldDesc.DataType in [dtExtWideString, dtWideMemo]) and
             (not TOCIFieldDesc(FieldDesc).IsBlobSubType)
          then // String as memo
            Inc(ComplexFieldOffset, FieldDesc.Length * 2 + 2) // for terminator
          else
            case FieldDesc.DataType of
              dtExtVarBytes:
                Inc(ComplexFieldOffset, FieldDesc.Length + SizeOf(Word));
              dtNumber, dtLargeint, dtBCD{$IFDEF VER6P}{$IFNDEF FPC}, dtFMTBCD{$ENDIF}{$ENDIF}:
                Inc(ComplexFieldOffset, OCI_NUMBER_SIZE);
              dtXML:
                Inc(ComplexFieldOffset, 2 * sizeof(IntPtr));
            else
              Inc(ComplexFieldOffset, sizeof(IntPtr));
            end;

          ComplexFieldOffset := (ComplexFieldOffset + 1) and $FFFFFFFE; // align to 2
        end;
      end;
    end;
  end;

  procedure PrepareBlock(Fetched: integer);
  var
    i,j: integer;
    Ptr: IntPtr;
    ObjPtr: IntPtr;
    Piece: PPieceHeader;
    Len: integer;
    Source: IntPtr;
    Dest: IntPtr;
    FieldDesc: TOCIFieldDesc;
    OraNumber: TOraNumber;
    Curr: currency;
    i64: int64;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    BcdValue: TBCD;
    OraTS: TOraTimeStamp;
    SQLTS: TSQLTimeStamp;
  {$IFDEF CLR}
    Temp: TBytes;
  {$ENDIF}
  {$ENDIF}
  {$ENDIF}
  begin
    ComplexFieldOffset := 0;

    if FHasConvertedFields then
      OraNumber := TOraNumber.Create(OCISvcCtx)
    else
      OraNumber := nil;
    try
      for i := 0 to Fetched - 1 do begin
        RefFieldCount := 0;
        Ptr := PtrOffset(Block, sizeof(TBlockHeader) + i * ItemSize + sizeof(TItemHeader));
        for j := 0 to FFields.Count - 1 do begin
          FieldDesc := TOCIFieldDesc(FFields[j]);
          if not FieldDesc.HasParent and (FieldDesc.IsComplex or TOCIFieldDesc(FieldDesc).IsConverted)
             and (FieldDesc.ActualFieldNo > -1) {KeyOnly SmartFetchState}
          then begin
            ObjPtr := Marshal.ReadIntPtr(Ptr, FieldDesc.Offset);
            Source := PtrOffset(FFetchBlock, ComplexFieldOffset);
            case FieldDesc.DataType of
              dtReference: begin
                with TOraRef(GetGCHandleTarget(ObjPtr)) do begin
                  Indicator := PtrOffset(Ptr, DataSize + j * SizeOf(SB2));
                  Marshal.WriteInt16(Indicator, Marshal.ReadInt16(FFetchBlock, FFetchRows * FFetchBlockItemSize +
                                                      RefFieldCount * FFetchRows * SizeOf(SB2)), i * SizeOf(SB2));
                  OCIRef := Marshal.ReadIntPtr(IntPtr(Source));
                end;
                Inc(RefFieldCount)
              end;
              dtMemo:
                if FieldDesc.SubDataType in [dtString, dtNString, dtFixedChar, dtFixedNChar] then begin // String as memo
                  Len := StrLen(PAChar(PtrOffset(FFetchBlock, ComplexFieldOffset)));
                  if Len > 0 then begin
                    TBlob(GetGCHandleTarget(ObjPtr)).AllocPiece(Piece, Len); // for term
                    TBlob(GetGCHandleTarget(ObjPtr)).AppendPiece(Piece);
                    CopyBuffer(Source, PtrOffset(TBlob(GetGCHandleTarget(ObjPtr)).FirstPiece, sizeof(TPieceHeader)), Len);
                    TBlob(GetGCHandleTarget(ObjPtr)).FirstPiece.Used := Len;
                  end;
                end;
              dtWideMemo:
                if FieldDesc.SubDataType in [dtWideString, dtNWideString, dtFixedWideChar, dtFixedNWideChar] then begin // String as memo
                  Len := StrLenW(PWChar(PtrOffset(FFetchBlock, ComplexFieldOffset))) * sizeof(WideChar);
                  if Len > 0 then begin
                    TBlob(GetGCHandleTarget(ObjPtr)).AllocPiece(Piece, Len); // for term
                    TBlob(GetGCHandleTarget(ObjPtr)).AppendPiece(Piece);
                    CopyBuffer(Source, PtrOffset(TBlob(GetGCHandleTarget(ObjPtr)).FirstPiece, sizeof(TPieceHeader)), Len);
                    TBlob(GetGCHandleTarget(ObjPtr)).FirstPiece.Used := Len;
                  end;
                end;
              dtExtString: begin
                // Oracle doesn't return Null terminator for CHAR
                if FieldDesc.SubDataType in [dtFixedChar, dtFixedNChar] then
                  Len := FieldDesc.Length
                else
                  Len := -1;
                Marshal.WriteIntPtr(Ptr, FieldDesc.Offset,
                  StringHeap.AllocStr(Source, FieldDesc.Fixed and TrimFixedChar, Len));
              end;
              dtExtWideString: begin
                // Oracle doesn't return Null terminator for CHAR
                if FieldDesc.SubDataType in [dtFixedWideChar, dtFixedNWideChar] then
                  Len := FieldDesc.Length
                else
                  Len := -1;
                Marshal.WriteIntPtr(Ptr, FieldDesc.Offset,
                  StringHeap.AllocWideStr(Source, FieldDesc.Fixed and TrimFixedChar, Len));
              end;
              dtExtVarBytes: begin
                Dest := StringHeap.NewBuf(Marshal.ReadInt16(Source) + SizeOf(Word));
                Marshal.WriteIntPtr(Ptr, FieldDesc.Offset, Dest);
                CopyBuffer(Source, Dest, Marshal.ReadInt16(Source) + SizeOf(Word));
              end;
              dtNumber:
                CopyBuffer(Source, TOraNumber(GetGCHandleTarget(ObjPtr)).OCINumberPtr, OCI_NUMBER_SIZE);
              dtLargeint: begin
                // Calculated Fields has SubDataType = dtUnknown
                if FieldDesc.SubDataType <> dtUnknown then begin
                  OraNumber.OCINumberPtr := Source;
                  Marshal.WriteInt16(OraNumber.FIndicator, Marshal.ReadInt16(Ptr, DataSize + j * sizeof(sb2)));
                  Marshal.WriteInt64(Ptr, FieldDesc.Offset, OraNumber.AsLargeInt);
                end;
              end;
              dtBCD: begin
                // Calculated Fields has SubDataType = dtUnknown
                if FieldDesc.SubDataType <> dtUnknown then begin
                  OraNumber.OCINumberPtr := Source;
                  Marshal.WriteInt16(OraNumber.FIndicator, Marshal.ReadInt16(Ptr, DataSize + j * sizeof(sb2)));
                  if OraNumber.IsNull then
                    Curr := 0
                  else
                    Curr := StrToCurr(OraNumber.AsString);
                {$IFDEF CLR}
                  i64 := Decimal.ToOACurrency(Curr);
                {$ELSE}
                  i64 := PInt64(@Curr)^;
                {$ENDIF}
                  Marshal.WriteInt64(Ptr, FieldDesc.Offset, i64);
                end;
              end;
            {$IFDEF VER6P}
            {$IFNDEF FPC}
              dtFMTBCD: begin
                // Calculated Fields has SubDataType = dtUnknown
                if FieldDesc.SubDataType <> dtUnknown then begin
                  OraNumber.OCINumberPtr := Source;
                  Marshal.WriteInt16(OraNumber.FIndicator, Marshal.ReadInt16(Ptr, DataSize + j * sizeof(sb2)));
                  BcdValue := OraNumber.AsBCD;
                {$IFDEF CLR}
                  Temp := TBcd.ToBytes(BcdValue);
                  Marshal.Copy(Temp, 0, PtrOffset(Ptr, FieldDesc.Offset), SizeOfTBcd);
                {$ELSE}
                  PBcd(PtrOffset(Ptr, FieldDesc.Offset))^ := BcdValue;
                {$ENDIF}
                end;
              end;
              dtSQLTimeStamp: begin
              // Calculated Fields has SubDataType = dtUnknown
                if FieldDesc.SubDataType <> dtUnknown then begin
                  OraTS := TOraTimeStamp(GetGCHandleTarget(ObjPtr));
                  Marshal.WriteInt16(OraTS.FIndicator, Marshal.ReadInt16(Ptr, DataSize + j * sizeof(sb2)));
                  OraTimeStampToSQLTimeStamp(OraTS, SQLTS);
                  OraTS.Free;
                {$IFDEF CLR}
                  Temp := TSQLTimeStamp.ToBytes(SQLTS);
                  Marshal.Copy(Temp, 0, PtrOffset(Ptr, FieldDesc.Offset), SizeOf(TSQLTimeStamp));
                {$ELSE}
                  PSQLTimeStamp(PtrOffset(Ptr, FieldDesc.Offset))^ := SQLTS;
                {$ENDIF}
                end;
              end;
            {$ENDIF}
            {$ENDIF}
              dtObject:
                TOraObject(GetGCHandleTarget(ObjPtr)).Instance := Marshal.ReadIntPtr(Source);
              dtXML: begin
                TOraXML(GetGCHandleTarget(ObjPtr)).Instance := Marshal.ReadIntPtr(Source);
                //TOraXML(GetGCHandleTarget(ObjPtr)).Indicator := Marshal.ReadIntPtr(Source, sizeof(IntPtr));
                TOraXML(GetGCHandleTarget(ObjPtr)).ReadXML;
              end;
            end;
            if (FieldDesc.DataType in [dtExtString, dtMemo]) and
               (not TOCIFieldDesc(FieldDesc).IsBlobSubType)
            then // String as memo
              Inc(ComplexFieldOffset, FieldDesc.Length + 1) // for terminator
            else
            if (FieldDesc.DataType in [dtExtWideString, dtWideMemo]) and
               (not TOCIFieldDesc(FieldDesc).IsBlobSubType)
            then
              Inc(ComplexFieldOffset, FieldDesc.Length * 2 + 2) // for terminator
            else
              case FieldDesc.DataType of
                dtExtVarBytes:
                  Inc(ComplexFieldOffset, FieldDesc.Length + SizeOf(Word));
                dtNumber, dtLargeint, dtBCD{$IFDEF VER6P}{$IFNDEF FPC}, dtFMTBCD{$ENDIF}{$ENDIF}:
                  Inc(ComplexFieldOffset, OCI_NUMBER_SIZE);
                dtXML:
                  Inc(ComplexFieldOffset, 2 * sizeof(IntPtr));
              else
                Inc(ComplexFieldOffset, sizeof(IntPtr));
              end;

            ComplexFieldOffset := (ComplexFieldOffset + 1) and $FFFFFFFE; // align to 2
          end
          else begin
            if (FieldDesc.DataType = dtString) and
               (FieldDesc.SubDataType in [dtFixedChar, dtFixedNChar])
            then
              Marshal.WriteByte(Ptr, FieldDesc.Offset + FieldDesc.Length, 0)
            else if (FieldDesc.DataType = dtWideString) and
                    (FieldDesc.SubDataType in [dtFixedWideChar, dtFixedNWideChar])
            then
              Marshal.WriteInt16(Ptr, FieldDesc.Offset + FieldDesc.Length * 2, 0);
          end;
        end;
      end;
    finally
      OraNumber.Free;
    end;
  end;

  procedure ClearBlockUnused;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
  var
    i, j: integer;
    Ptr, ObjPtr: IntPtr;
    FieldDesc: TOCIFieldDesc;
    Obj: TSharedObject;
  {$ENDIF}
  {$ENDIF}
  begin
    // Free OraTimeStamps
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    if FHasConvertedFields then
      for i := Fetched to FFetchRows - 1 do begin
        Ptr := PtrOffset(Block, sizeof(TBlockHeader) + i * ItemSize + sizeof(TItemHeader));
        for j := 0 to FFields.Count - 1 do begin
          FieldDesc := TOCIFieldDesc(FFields[j]);
          if not FieldDesc.HasParent and (FieldDesc.ActualFieldNo > -1) then {KeyOnly SmartFetchState}
            case FieldDesc.DataType of
              dtSQLTimeStamp: begin
                if FieldDesc.SubDataType <> dtUnknown then begin
                  ObjPtr := Marshal.ReadIntPtr(Ptr, FieldDesc.Offset);
                  if ObjPtr <> nil then begin
                    Obj := TOraTimeStamp(GetGCHandleTarget(ObjPtr));
                    Obj.Free;
                    Marshal.WriteIntPtr(Ptr, FieldDesc.Offset, nil);
                  end;
                end;
              end;
            end;
        end;
      end;
  {$ENDIF}
  {$ENDIF}
  end;

  procedure SwapBlocks(Block1, Block2: PBlockHeader);
  begin
    Block1.Prev := nil;
    Block1.Next := Block2;
    Block2.Next := nil;
    Block2.Prev := Block1;
  end;

begin
  Result := False;

  if FetchBack and (FFetchStart = 0) and not FEOF or not FetchBack and
    (FFetchEnd = FCommand.FFetchedRows) and FNoData and not FBOF
  then
    Exit;

  FCommand.Busy; // Ok !!!
  // for close in time fetch all
  if FCommand.GetCursorState < csBound then begin // For Non Blocking
    FCommand.Release;
    Exit;
  end;

{$IFNDEF LITE}
  StandAloneBlock := FSmartFetchState = sfDataByKey;
{$ENDIF}
  try // For Busy
    ItemSize := RecordSize + sizeof(TItemHeader);
    NewBlock := (IntPtr(BlockMan.FirstBlock) = nil) or not (FUniDirectional or CanFetchBack and
      ((IntPtr(BlockMan.FirstBlock.Next) <> nil) or FBOF or FEOF)) {$IFNDEF LITE}or StandAloneBlock{$ENDIF};
    if NewBlock then begin
      BlockMan.AllocBlock(Block, FFetchRows {$IFNDEF LITE},StandAloneBlock{$ENDIF});
      if FetchBack then begin
        SwapBlocks(Block.Next, Block);
        BlockMan.FirstBlock := Block.Prev;
      end;

      if HasComplexFields or FHasConvertedFields then begin
        if IntPtr(FFetchBlock) = nil then
          AllocFetchBlock;
        InitBlock;
      end;
    end
    else begin
      if IntPtr(BlockMan.FirstBlock.Next) <> nil then begin // more then one block
        NewBlock := True; // for redefine data
        if FEOF or FBOF then
          Block := BlockMan.FirstBlock
        else begin
          // BlockMan.FirstBlock.Next always present FFetchStart position
          TempBlock := BlockMan.FirstBlock;
          Block := TempBlock.Next;
          if FetchBack then begin
            // if more then one block used
            if not ((IntPtr(FirstItem) <> nil) and (IntPtr(LastItem) <> nil) and (FirstItem.Block = LastItem.Block)) then begin
              SwapBlocks(Block, TempBlock);
              BlockMan.FirstBlock := Block;
              if IntPtr(LastItem) <> nil then begin
                LastItem := PtrOffset(Block, sizeof(TBlockHeader) + (Block.UsedItems - 1) * ItemSize);
                Dec(FFetchEnd, TempBlock.UsedItems);
              end;
              Block := TempBlock;
            end;
          end
          else begin
            SwapBlocks(Block, TempBlock);
            BlockMan.FirstBlock := Block;
            if (IntPtr(FirstItem) <> nil) and ((IntPtr(LastItem) = nil) or (IntPtr(FirstItem.Block) <> IntPtr(LastItem.Block))) then begin
              FirstItem := PtrOffset(TempBlock, sizeof(TBlockHeader));
              Inc(FFetchStart, Block.UsedItems);
            end;
          end;
        end
      end
      else
        Block := BlockMan.FirstBlock;
    // Refresh block: drop values of blobs
      ClearBlock(Block);
      InitBlock;
    end;

    if CanFetchBack then begin
      if FBOF then begin
        FFetchStart := FFetchEnd;
        LastItem := nil;
      end;
      if FEOF then begin
        FFetchEnd := FFetchStart;
        FirstItem := nil;
      end;
    end;

    // remeber first item and last item on case of exception
    OldFirstItem := FirstItem;
    OldLastItem := LastItem;
    OldFetchStart := FFetchStart;
    OldFetchEnd := FFetchEnd;
    try     // For free memory
      if NewBlock then begin
        pRec := PtrOffset(Block, sizeof(TBlockHeader) + sizeof(TItemHeader));
        pInd := PtrOffset(pRec, DataSize);

        FConnection.BusyWait;
        try  // For FConnection.Busy
        { DefineData }
          ComplexFieldOffset := 0;
          RefFieldCount := 0;
          for i := 0 to FFields.Count - 1 do begin
            FieldDesc := TOCIFieldDesc(FFields[i]);
            if not FieldDesc.HasParent and (FieldDesc.FieldDescKind = fdkData)
               and (FieldDesc.ActualFieldNo > -1) {KeyOnly SmartFetchState}
            then
              if (FieldDesc.DataType in [dtBlob, dtMemo, dtWideMemo]) and
                 (not (FieldDesc.SubDataType in [dtString, dtNString, dtWideString, dtNWideString,
                                                 dtFixedChar, dtFixedNChar, dtFixedWideChar, dtFixedNWideChar]))
              then begin
                ObjPtr := Marshal.ReadIntPtr(pRec, FieldDesc.Offset);
                if TBlob(GetGCHandleTarget(ObjPtr)).IsUnicode then
                  CharsetId := OCI_UTF16ID
                else
                  CharsetId := FConnection.FCharsetId;
              {$IFDEF CLR}
                if OCISvcCtx.Home.PossibleOCICallStyles = [OCI80] then
                  FCommand.DefineDynamic8(FieldDesc, GCHandle, IntPtr(HOCICallbackDefine), CharsetId)
                else
              {$ENDIF}
                  FCommand.DefineDynamic8(FieldDesc, GCHandle, OCICallbackDefinePtr, CharsetId);
                Inc(ComplexFieldOffset, sizeof(IntPtr));
              end
              else begin
                if FieldDesc.IsComplex or TOCIFieldDesc(FieldDesc).IsConverted then begin
                  BufferPtr := PtrOffset(FFetchBlock, ComplexFieldOffset);
                  BufSkip := FFetchBlockItemSize;
                  if (FieldDesc.DataType in [dtExtString, dtMemo]) and
                     (not TOCIFieldDesc(FieldDesc).IsBlobSubType)
                  then // String as memo
                    Inc(ComplexFieldOffset, FieldDesc.Length + 1) // for termimator
                  else
                  if (FieldDesc.DataType in [dtExtWideString, dtWideMemo]) and
                     (not TOCIFieldDesc(FieldDesc).IsBlobSubType)
                  then
                    Inc(ComplexFieldOffset, FieldDesc.Length * 2 + 2) // for termimator
                  else
                    case FieldDesc.DataType of
                      dtExtVarBytes:
                        Inc(ComplexFieldOffset, FieldDesc.Length + SizeOf(Word));
                      dtNumber, dtLargeint, dtBCD{$IFDEF VER6P}{$IFNDEF FPC}, dtFMTBCD{$ENDIF}{$ENDIF}:
                        Inc(ComplexFieldOffset, OCI_NUMBER_SIZE);
                      dtXML:
                        Inc(ComplexFieldOffset, 2 * sizeof(IntPtr));
                    else
                      Inc(ComplexFieldOffset, sizeof(IntPtr));
                    end;

                  ComplexFieldOffset := (ComplexFieldOffset + 1) and $FFFFFFFE; // align to 2
                end
                else begin
                  BufferPtr := PtrOffset(pRec, FieldDesc.Offset);
                  BufSkip := ItemSize;
                end;

                if FieldDesc.DataType in [dtObject, dtArray, dtTable] then begin
                  Marshal.WriteInt16(pInd, i * sizeof(sb2), 0);
                  IndPtr := nil; // WAR Oracle bug - indicator skip is ignored for Objects
                  IndSkip := ItemSize;
                end
                else
                if FieldDesc.DataType = dtReference then begin
                  IndPtr := PtrOffset(FFetchBlock, FFetchRows * FFetchBlockItemSize + RefFieldCount * FFetchRows * SizeOf(SB2));
                  IndSkip := SizeOf(SB2); // WAR Oracle bug - indicator skip is ignored for REFs
                  inc(RefFieldCount);
                end
                else
                if FieldDesc.DataType = dtXML then begin
                  IndPtr := PtrOffset(BufferPtr, sizeof(IntPtr));
                  IndSkip := FFetchBlockItemSize;
                end
                else begin
                  IndPtr := PtrOffset(pInd, i * sizeof(sb2));
                  IndSkip := ItemSize;
                end;

                FCommand.DefineData(FieldDesc, BufferPtr, IndPtr, BufSkip, IndSkip);
              end;
          end;
        finally
          FConnection.Release;
        end;
      end;

      FFetchItems := PtrOffset(Block, sizeof(TBlockHeader));

      if FetchBack then begin
        if FFetchStart < FFetchRows then
          Fetched := FFetchStart
        else
          Fetched := FFetchRows;
        Fetched := FCommand.InternalFetch(Fetched, OCI_FETCH_ABSOLUTE, FFetchStart - Fetched + 1);
        Dec(FFetchStart, Fetched);
      end
      else begin
        if FNoData and (FCommand.FFetchedRows > FFetchEnd) then begin
          Fetched := FCommand.FFetchedRows - FFetchEnd;
          if Fetched > FFetchRows then
            Fetched := FFetchRows;
        end
        else
          Fetched := FFetchRows;
        if FFetchAbsolute then
          Fetched := FCommand.InternalFetch(Fetched, OCI_FETCH_ABSOLUTE, FFetchEnd + 1)
        else
          Fetched := FCommand.InternalFetch(Fetched);
        Inc(FFetchEnd, Fetched);
      end;

      FFetchAbsolute := FetchBack;

      Result := Fetched > 0;
      if Result then begin
        if HasFields([dtMemo, dtWideMemo, dtReference,
          dtString, dtWideString, dtExtString, dtExtWideString,
          dtExtVarBytes, dtNumber, dtLargeint, dtBCD, dtXML, dtObject
          {$IFDEF VER6P}{$IFNDEF FPC}, dtFMTBCD, dtSQLTimeStamp{$ENDIF}{$ENDIF}])
        then
          PrepareBlock(Fetched);

        // Prepare comlex field
        Item := PtrOffset(Block, sizeof(TBlockHeader));
        SharedPiece := nil;
        for i := 1 to Fetched do begin
        // Prepare comlex field
          if HasComplexFields then
            for j := 0 to FFields.Count - 1 do begin
              FieldDesc := TOCIFieldDesc(FFields[j]);
              if not FieldDesc.HasParent and (FieldDesc.FieldDescKind = fdkData)
                and (FieldDesc.ActualFieldNo > -1) {KeyOnly SmartFetchState}
              then begin
                ObjPtr := Marshal.ReadIntPtr(Item, sizeof(TItemHeader) + FieldDesc.Offset);
                case FieldDesc.DataType of
                  dtBlob, dtMemo, dtWideMemo:
                    if not (FieldDesc.SubDataType in [dtString, dtNString, dtWideString, dtNWideString,
                                                      dtFixedChar, dtFixedNChar, dtFixedWideChar, dtFixedNWideChar])
                    then
                      TBlob(GetGCHandleTarget(ObjPtr)).Compress;
                  dtOraBlob, dtOraClob, dtWideOraClob: begin
                    TOraLob(GetGCHandleTarget(ObjPtr)).FNeedReadLob := True;
                    if not FDeferredLobRead and FCommand.FCacheLobs then begin
                      if IntPtr(SharedPiece) = nil then
                        TBlob.AllocPiece(SharedPiece, DefaultPieceSize);
                      TOraLob(GetGCHandleTarget(ObjPtr)).ReadLob(SharedPiece);
                    {$IFDEF HAVE_COMPRESS}
                      if (FieldDesc.DataType = dtOraBlob) and
                        (FCommand.FCompressBlob in [cbClient, cbClientServer])
                      then
                        TOraLob(GetGCHandleTarget(ObjPtr)).Compressed := True
                      else
                        TOraLob(GetGCHandleTarget(ObjPtr)).Compressed := False;
                    {$ENDIF}
                    end;
                    // sync indicator ???
                    //if TOraLob(GetGCHandleTarget(ObjPtr)).Size = 0 then
                    //  psb2(IntPtr(PChar(Item) + sizeof(TItemHeader) + DataSize + j * sizeof(sb2)))^ := -1;
                  end;
                  dtBFile, dtCFile: begin
                    TOraFile(GetGCHandleTarget(ObjPtr)).FNeedReadLob := True;
                    if not FDeferredLobRead and FCommand.FCacheLobs then begin
                      OraFile := TOraFile(GetGCHandleTarget(ObjPtr));
                      if OraFile.Exists then begin
                        OraFile.Open;
                        try
                          OraFile.ReadLob;
                        finally
                          OraFile.Close;
                        end;
                      end;
                    end;
                  end;
                  dtObject, dtArray, dtTable, dtXML: begin
                    if FConnection.FDisconnectMode then
                      TOraObject(GetGCHandleTarget(ObjPtr)).CacheObject;
                  end;
                  dtReference: begin
                    OraRef := TOraRef(GetGCHandleTarget(ObjPtr));
                    if not OraRef.IsNull then
                      OraRef.Pin;
                    if FConnection.FDisconnectMode then
                      TOraRef(GetGCHandleTarget(ObjPtr)).CacheObject;
                  end;
                  dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ:
                    Marshal.WriteInt16(
                      TOraTimeStamp(GetGCHandleTarget(ObjPtr)).FIndicator,
                      Marshal.ReadInt16(Item, sizeof(TItemHeader) + DataSize + j * sizeof(sb2))
                    );
                  dtIntervalYM, dtIntervalDS:
                    Marshal.WriteInt16(
                      TOraInterval(GetGCHandleTarget(ObjPtr)).FIndicator,
                      Marshal.ReadInt16(Item, sizeof(TItemHeader) + DataSize + j * sizeof(sb2))
                    );
                  dtNumber:
                    Marshal.WriteInt16(
                      TOraNumber(GetGCHandleTarget(ObjPtr)).FIndicator,
                      Marshal.ReadInt16(Item, sizeof(TItemHeader) + DataSize + j * sizeof(sb2))
                    );
                end;
              end;
            end;
          Item := PtrOffset(Item, ItemSize);
        end;
        if IntPtr(SharedPiece) <> nil then
          Marshal.FreeHGlobal(SharedPiece);

        CreateBlockStruct(Block, Fetched, FetchBack {$IFNDEF LITE},StandAloneBlock{$ENDIF});

      {$IFNDEF LITE}
        if StandAloneBlock then begin
          SyncWithCurrentBlock(Block);
          ClearBlock(Block);
          BlockMan.FreeBlock(Block, StandAloneBlock);
        end;
      {$ENDIF}

        if (HasComplexFields or FHasConvertedFields) and (FCommand.GetCursorState in [csFetched, csInactive]) then begin
          FreeFetchBlock;
          ClearBlockUnused;
        end;
      end // if Result then begin
      else begin
      {$IFNDEF LITE}
        if StandAloneBlock then
          SyncWithCurrentBlock(nil);
      {$ENDIF}

        if not CanFetchBack then begin
          if HasComplexFields or FHasConvertedFields then begin
            FreeFetchBlock;
            ClearBlockUnused;
          end;

          if NewBlock then begin
            ClearBlock(Block);
            BlockMan.FreeBlock(Block {$IFNDEF LITE},StandAloneBlock{$ENDIF});
          end;
        end else
          FirstItem.Prev := nil;
      end;
    except
      if NewBlock then begin
        ClearBlock(Block); // !!! Possible AV on fatal error
        // BlockMan.FirstBlock = nil means that dataset was closed after some
        // fatal error and all blocks are already freed.
        if IntPtr(BlockMan.FirstBlock) <> nil then begin
          BlockMan.FreeBlock(Block {$IFNDEF LITE},StandAloneBlock{$ENDIF});
          // restore first and last items
          FirstItem := OldFirstItem;
          LastItem := OldLastItem;
          if IntPtr(FirstItem) <> nil then
            FirstItem.Prev := nil;
          if IntPtr(LastItem) <> nil then
            LastItem.Next := nil;
          // restore fetch origins
          FFetchStart := OldFetchStart;
          FFetchEnd := OldFetchEnd;
        end;
      end;
      raise;
    end;  // try
  finally
    FCommand.Release;
  end;
end;

var
  GlobalBuf: IntPtr = nil; // static as odefinps writes data to it

function TOCIRecordSet.FetchPiece(FetchBack: boolean = False): boolean;
var
  i: word;
  pRec, pInd: IntPtr;
  Res: integer;
  Item: PItemHeader;
  PieceStatus: ub1;
  Blob: TBlob;
  Piece: PPieceHeader;
  Ptr: IntPtr;
  ATemp: IntPtr;
  BufLen: ub4;
  Iteration: ub4;
  Index: ub4;
  NeedData: integer;
  NoData: integer;
  hDefine: pOCIHandle;
  BufferPtr: IntPtr;
  OraFile: TOraFile;
  OraRef: TOraRef;
  ObjPtr: IntPtr;
  Mode: TParamDirection;
  IndPtr: IntPtr;
  CharsetId: word;
  FieldDesc: TFieldDesc;
begin
  Result := False;

  FCommand.Busy;
  if FCommand.GetCursorState < csBound then begin   // For Non Blocking
    FCommand.Release;
    Exit;
  end;

  try  // For Busy
    if FUniDirectional and (IntPtr(FirstItem) <> nil) then begin
      Item := FirstItem;
      FreeComplexFields(PtrOffset(Item, sizeof(TItemHeader)), True);

      FirstItem := nil;
      LastItem := nil;
      CurrentItem := nil;
    end
    else begin
      if CanFetchBack and (IntPtr(BlockMan.FirstFree) = nil) and (IntPtr(BlockMan.FirstBlock) <> nil) then begin
        if FetchBack then begin
          if IntPtr(LastItem) <> nil then begin
            Item := LastItem.Prev;
            FreeComplexFields(PtrOffset(LastItem, sizeof(TItemHeader)), True);
            BlockMan.FreeItem(LastItem);
            LastItem := Item;
            if IntPtr(Item) <> nil then
              Item.Next := nil;
            Dec(FFetchEnd);
          end
        end
        else begin
          if IntPtr(FirstItem) <> nil then begin
            Item := FirstItem.Next;
            FreeComplexFields(PtrOffset(FirstItem, sizeof(TItemHeader)), True);
            BlockMan.FreeItem(FirstItem);
            FirstItem := Item;
            if IntPtr(Item) <> nil then
              Item.Prev := nil;
            Inc(FFetchStart);
          end;
        end;
      end;
      BlockMan.AllocItem(Item);
    end;

    if CanFetchBack then begin
      if FBOF then begin
        FFetchStart := FFetchEnd;
        LastItem := nil;
      end;
      if FEOF then begin
        FFetchEnd := FFetchStart;
        FirstItem := nil;
      end;
    end;

    CreateComplexFields(PtrOffset(Item, sizeof(TItemHeader)), True);

    try     // For free memory
      pRec := PtrOffset(Item, sizeof(TItemHeader));
      pInd := PtrOffset(pRec, DataSize);
      BufLen := MaxBlobSize;
      FConnection.BusyWait;
      try  // For FConnection.Busy
           // Picewise fetch as one operation

      { DefineData } // OPTIM - Once
        for i := 0 to FFields.Count - 1 do begin
          FieldDesc := FFields[i];
          if not FieldDesc.HasParent and (FieldDesc.FieldDescKind = fdkData) then begin
            BufferPtr := PtrOffset(pRec, FieldDesc.Offset);

            if FieldDesc.DataType = dtXML then begin
              ObjPtr := Marshal.ReadIntPtr(BufferPtr);
              IndPtr := TOraObject(GetGCHandleTarget(ObjPtr)).IndicatorPtr;
              Marshal.WriteIntPtr(IndPtr, nil);
            end
            else
              IndPtr := PtrOffset(pInd, i * sizeof(sb2));

            case FieldDesc.DataType of
              dtCursor: begin
                ObjPtr := Marshal.ReadIntPtr(BufferPtr);
                TOraCursor(GetGCHandleTarget(ObjPtr)).FState := csExecuted;
                BufferPtr := TOraCursor(GetGCHandleTarget(ObjPtr)).OCIStmtPtr;
              end;
              dtOraBlob,dtOraClob,dtWideOraClob,dtBFile,dtCFile:
                BufferPtr := TOraLob(GetGCHandleTarget(Marshal.ReadIntPtr(BufferPtr))).OCILobLocatorPtr;
              dtObject,dtXML,dtArray,dtTable:
                BufferPtr := TOraObject(GetGCHandleTarget(Marshal.ReadIntPtr(BufferPtr))).InstancePtr;
              dtReference:
                BufferPtr := TOraRef(GetGCHandleTarget(Marshal.ReadIntPtr(BufferPtr))).OCIRefPtr;
              dtMemo:
                if FieldDesc.SubDataType in [dtString, dtNString, dtFixedChar, dtFixedNChar] then begin
                  TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(BufferPtr))).AllocPiece(Piece, FieldDesc.Length + 1); // for term
                  TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(BufferPtr))).AppendPiece(Piece);
                  BufferPtr := PtrOffset(Piece, sizeof(TPieceHeader));
                end;
              dtWideMemo:
                if FieldDesc.SubDataType in [dtWideString, dtNWideString, dtFixedWideChar, dtFixedNWideChar] then begin
                  TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(BufferPtr))).AllocPiece(Piece, FieldDesc.Length * 2 + sizeof(WideChar)); // for term
                  TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(BufferPtr))).AppendPiece(Piece);
                  BufferPtr := PtrOffset(Piece, sizeof(TPieceHeader));
                end;
              dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ:
                BufferPtr := TOraTimeStamp(GetGCHandleTarget(Marshal.ReadIntPtr(BufferPtr))).OCIDateTimePtr;
              dtIntervalYM, dtIntervalDS:
                BufferPtr := TOraInterval(GetGCHandleTarget(Marshal.ReadIntPtr(BufferPtr))).OCIIntervalPtr;
              dtExtString: begin
                ObjPtr := StringHeap.NewBuf(FieldDesc.Length + 1);
                Marshal.WriteIntPtr(BufferPtr, ObjPtr);
                BufferPtr := ObjPtr;
              end;
              dtExtWideString: begin
                ObjPtr := StringHeap.NewBuf(FieldDesc.Length * 2 + 2);
                Marshal.WriteIntPtr(BufferPtr, ObjPtr);
                BufferPtr := ObjPtr;
              end;
              dtExtVarBytes: begin
                ObjPtr := StringHeap.NewBuf(FieldDesc.Length + SizeOf(Word));
                Marshal.WriteIntPtr(BufferPtr, ObjPtr);
                BufferPtr := ObjPtr;
              end;
              dtNumber: begin
                ObjPtr := Marshal.ReadIntPtr(BufferPtr);
                BufferPtr := TOraNumber(GetGCHandleTarget(ObjPtr)).OCINumberPtr;
              end;
            end;

            if (FieldDesc.DataType in [dtBlob,dtMemo,dtWideMemo]) and
               (not (FieldDesc.SubDataType in [dtString, dtNString, dtWideString, dtNWideString,
                                               dtFixedChar, dtFixedNChar, dtFixedWideChar, dtFixedNWideChar]))
            then
              if FCommand.FOCICallStyle = OCI73 then
                FCommand.DefineDynamic7(FieldDesc, nil, IndPtr)
              else begin
                ObjPtr := Marshal.ReadIntPtr(BufferPtr);
                if TBlob(GetGCHandleTarget(ObjPtr)).IsUnicode then
                  CharsetId := OCI_UTF16ID
                else
                  CharsetId := FConnection.FCharsetId;
                FCommand.DefineDynamic8(FieldDesc, GCHandle, OCICallbackDefinePtr, CharsetId);
              end
            else
              FCommand.DefineData(FieldDesc, BufferPtr, IndPtr, 0, 0);
          end;
        end;

        FFetchItems := Item;

        if FetchBack then
          Res := FCommand.InternalFetchPiece(OCI_FETCH_ABSOLUTE, FFetchStart)
        else begin
          if FFetchAbsolute then
            Res := FCommand.InternalFetchPiece(OCI_FETCH_ABSOLUTE, FFetchEnd + 1)
          else
            Res := FCommand.InternalFetchPiece;
        end;

        FFetchAbsolute := FetchBack;

        if FCommand.FOCICallStyle = OCI73 then begin
          NeedData := OCI_STILL_IS_PIECE;
          NoData := OCI_NO_DATA_FOUND;
        end
        else
        if FCommand.FOCICallStyle = OCI80 then begin
          NeedData := OCI_NEED_DATA;
          NoData := OCI_NO_DATA;
        end
        else begin
          FConnection.CheckOCI;
          NeedData := 0;
          NoData := 0;
        end;

        if Res = NeedData then begin
          if GlobalBuf = nil then
            GlobalBuf := Marshal.AllocHGlobal(sizeof(IntPtr));
          Marshal.WriteIntPtr(GlobalBuf, nil);
          for i := 0 to FFields.Count - 1 do begin
            FieldDesc := FFields[i];
            if FieldDesc.FieldDescKind <> fdkData then
              continue;
            if (FieldDesc.DataType in [dtBlob, dtMemo, dtWideMemo]) and
               (not (FieldDesc.SubDataType in [dtString, dtNString, dtWideString, dtNWideString,
                                               dtFixedChar, dtFixedNChar, dtFixedWideChar, dtFixedNWideChar]))
            then begin
              if Res <> NeedData then
                Assert(False);            // DEBUG

              FCommand.GetPI(hDefine, PieceStatus, Ptr, Iteration, Index, Mode);

              Blob := nil; // anti warning
              if (PieceStatus = OCI_FIRST_PIECE) or
                 (PieceStatus = OCI_ONE_PIECE)
              then begin
                ObjPtr := Marshal.ReadIntPtr(Item, sizeof(TItemHeader) + FieldDesc.Offset);
                Blob := TBlob(GetGCHandleTarget(ObjPtr));
              end
              else
                Assert(False); // DEBUG

              repeat
                BufLen := Blob.PieceSize;
                Blob.AllocPiece(Piece, BufLen);

                FCommand.SetPI(hDefine, OCI_HTYPE_DEFINE, PieceStatus, PtrOffset(Piece, Sizeof(TPieceHeader)),
                  BufLen, PtrOffset(pInd, i * sizeof(sb2)));

                Res := FCommand.InternalFetchPiece;

                if BufLen > 0 then begin
                  Piece.Used := BufLen;
                  if BufLen < Cardinal(Blob.PieceSize) then
                    Blob.ReallocPiece(Piece, BufLen);
                  Blob.AppendPiece(Piece);
                end
                else
                  Blob.FreePiece(Piece);

                FCommand.GetPI(hDefine, PieceStatus, Ptr, Iteration, Index, Mode);

                if PieceStatus = OCI_FIRST_PIECE then begin
                  BufLen := sizeof(integer);
                  FCommand.SetPI(hDefine, OCI_HTYPE_DEFINE, PieceStatus, GlobalBuf, BufLen, nil);  // ???
                end;
              until (Res = 0) or (Res = NoData) or (PieceStatus = OCI_FIRST_PIECE);
            end
            else
            if FieldDesc.DataType = dtExtString then begin
              ObjPtr := PtrOffset(Item, sizeof(TItemHeader) + FieldDesc.Offset);
              Ptr := Marshal.ReadIntPtr(ObjPtr);
              Marshal.WriteIntPtr(ObjPtr, StringHeap.ReAllocStr(Ptr, FieldDesc.Fixed and TrimFixedChar));
            end
            else
            if FieldDesc.DataType = dtExtWideString then begin
              ObjPtr := PtrOffset(Item, sizeof(TItemHeader) + FieldDesc.Offset);
              Ptr := Marshal.ReadIntPtr(ObjPtr);
              Marshal.WriteIntPtr(ObjPtr, StringHeap.ReAllocStr(Ptr, FieldDesc.Fixed and TrimFixedChar));
            end
            else
            if FieldDesc.DataType = dtExtVarBytes then begin
              Ptr := PtrOffset(Item, sizeof(TItemHeader) + FieldDesc.Offset);
              ATemp := StringHeap.NewBuf(Marshal.ReadInt16(Marshal.ReadIntPtr(Ptr)) + SizeOf(Word));
              CopyBuffer(Marshal.ReadIntPtr(Ptr), ATemp, Marshal.ReadInt16(Marshal.ReadIntPtr(Ptr)) + SizeOf(Word));
              StringHeap.DisposeBuf(Marshal.ReadIntPtr(Ptr));
              Marshal.WriteIntPtr(Ptr, ATemp);
            end;
          end;
          Marshal.WriteInt32(GlobalBuf, $FFFFFF); // DEBUG
        end // if Res = NeedData then begin
        else
          if (FCommand.FOCICallStyle = OCI73) and (Res <> NoData) then
            Assert(False); // DEBUG
      finally
        FConnection.Release;
      end;

      Result := Res = 0;

      if Result then begin
        // Prepare comlex field
        if HasComplexFields then
          for i := 0 to FFields.Count - 1 do begin
            FieldDesc := FFields[i];
            if not FieldDesc.HasParent and (FieldDesc.FieldDescKind = fdkData) then begin
              ObjPtr := Marshal.ReadIntPtr(Item, sizeof(TItemHeader) + FieldDesc.Offset);
              case FieldDesc.DataType of
                dtBlob, dtMemo:
                  if FieldDesc.SubDataType in [dtString, dtNString, dtFixedChar, dtFixedNChar] then
                    TBlob(GetGCHandleTarget(ObjPtr)).FirstPiece.Used :=
                      StrLen(PAChar(PtrOffset(TBlob(GetGCHandleTarget(ObjPtr)).FirstPiece, sizeof(TPieceHeader))))
                  else
                    TBlob(GetGCHandleTarget(ObjPtr)).Compress;
                dtWideMemo:
                  if FieldDesc.SubDataType in [dtWideString, dtNWideString, dtFixedWideChar, dtFixedNWideChar] then
                    TBlob(GetGCHandleTarget(ObjPtr)).FirstPiece.Used :=
                      StrLenW(PWChar(PtrOffset(TBlob(GetGCHandleTarget(ObjPtr)).FirstPiece, sizeof(TPieceHeader)))) * sizeof(WideChar)
                  else
                    TBlob(GetGCHandleTarget(ObjPtr)).Compress;
                dtOraBlob, dtOraClob, dtWideOraClob: begin
                  TOraLob(GetGCHandleTarget(ObjPtr)).FNeedReadLob := True;
                  if not FDeferredLobRead and FCommand.FCacheLobs then
                    TOraLob(GetGCHandleTarget(ObjPtr)).ReadLob;
                {$IFDEF HAVE_COMPRESS}
                  if (FieldDesc.DataType = dtOraBlob) and
                    (FCommand.FCompressBlob in [cbClient, cbClientServer])
                  then
                    TOraLob(GetGCHandleTarget(ObjPtr)).Compressed := True
                  else
                    TOraLob(GetGCHandleTarget(ObjPtr)).Compressed := False;
                {$ENDIF}
                end;
                dtBFile, dtCFile: begin
                  TOraFile(GetGCHandleTarget(ObjPtr)).FNeedReadLob := True;
                  if not FDeferredLobRead and FCommand.FCacheLobs then begin
                    OraFile := TOraFile(GetGCHandleTarget(ObjPtr));
                    if OraFile.Exists then begin
                      OraFile.Open;
                      try
                        OraFile.ReadLob;
                      finally
                        OraFile.Close;
                      end;
                    end;
                  end;
                end;
                dtReference: begin
                  OraRef := TOraRef(GetGCHandleTarget(ObjPtr));
                  if OraRef.OCIRef <> nil then
                    OraRef.Pin;
                end;
                dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ:
                  Marshal.WriteInt16(
                    TOraTimeStamp(GetGCHandleTarget(ObjPtr)).FIndicator,
                    Marshal.ReadInt16(Item, sizeof(TItemHeader) + DataSize + i * sizeof(sb2))
                  );
                dtIntervalYM, dtIntervalDS:
                  Marshal.WriteInt16(
                    TOraInterval(GetGCHandleTarget(ObjPtr)).FIndicator,
                    Marshal.ReadInt16(Item, sizeof(TItemHeader) + DataSize + i * sizeof(sb2))
                  );
                dtNumber:
                  Marshal.WriteInt16(
                    TOraNumber(GetGCHandleTarget(ObjPtr)).FIndicator,
                    Marshal.ReadInt16(Item, sizeof(TItemHeader) + DataSize + i * sizeof(sb2))
                  );
                dtXML:
                  TOraXML(GetGCHandleTarget(ObjPtr)).ReadXML;
              end;
            end;
          end;

        // Create Items
        if FetchBack then begin
          if IntPtr(LastItem) = nil then
            LastItem := Item;

          Item.Prev := nil;
          Item.Next := FirstItem;

          if IntPtr(FirstItem) <> nil then begin
            FirstItem.Prev := Item;
            Item.Order := FirstItem.Order - 1;
          end
          else
            Item.Order := FRecordCount;

          FirstItem := Item;
          Dec(FFetchStart);
        end
        else begin
          if IntPtr(FirstItem) = nil then
            FirstItem := Item;

          Item.Prev := LastItem;
          Item.Next := nil;

          if IntPtr(LastItem) <> nil then begin
            LastItem.Next := Item;
            Item.Order := LastItem.Order + 1;
          end
          else
            Item.Order := 1;

          LastItem := Item;

          Inc(FRecordCount);
          Inc(FFetchEnd);
        end;
        Item.Flag := flUsed;
        Item.Rollback := nil;
        Item.Status := isUnmodified;
        Item.UpdateResult := urNone;
        Item.FilterResult := fsNotChecked;

        UpdateCachedBuffer(Item, Item);
        // update fetched rows for correct TDataSet.RecordCount calculation
        FCommand.FFetchedRows := RecordCount;

      {$IFDEF MSWINDOWS}
        // in the thread only
        if (hExecFetchThread <> nil) or (hFetchAllThread <> nil) then
          PulseEvent(THandle(hEvent.Handle));
      {$ENDIF}
      end // if Result then begin
      else begin
        FreeComplexFields(PtrOffset(Item, sizeof(TItemHeader)), True);
        BlockMan.FreeItem(Item);
      end;
    except
      FreeComplexFields(PtrOffset(Item, sizeof(TItemHeader)), True); // !!! Possible AV on fatal error
      // BlockMan.FirstBlock = nil means that dataset was closed after some
      // fatal error and all blocks are already freed.
      if IntPtr(BlockMan.FirstBlock) <> nil then
        BlockMan.FreeItem(Item);
      raise;
    end;
  finally
    FCommand.Release;
  end;
end;

procedure TOCIRecordSet.DoFetchAll;
begin
  try
    FWaitForFetchBreak := False;
    FFetching := True;
    try
      if CanFetchBack then begin
        SetToEnd;
        Fetch(True);
      end
      else
        while True do begin
          if FWaitForFetchBreak then begin
            FCommand.InternalCancel;
            break;
          end;
          if not Fetch then
            break;
        end;
    finally
      FFetching := False;
    end;
  except
    // earlier we used to restore old cursor state but it does not lead to
    // any positive results
    FCommand.SetCursorState(csInactive);
    raise;
  end;
end;

procedure TOCIRecordSet.DoFetchAllPulse;
begin
{$IFDEF MSWINDOWS}
  PulseEvent(THandle(hEvent.Handle));
  try
{$ENDIF}
    DoFetchAll;
{$IFDEF MSWINDOWS}
  finally
    hEvent.SetEvent;
  end;
{$ENDIF}
end;

procedure TOCIRecordSet.EndFetchAll(E: Exception);
var
  Fail: boolean;
begin
{$IFDEF MSWINDOWS}
  if hFetchAllThread <> nil then begin
//    FConnection.StopThread(hFetchAllThread);
    hFetchAllThread := nil;
  end
  else
    if (FCommand = nil) or GetNonBlocking then Exit;
{$ENDIF}
  if GetNonBlocking and (Length(IndexFields) > 0) then
    SortItems;

  if Assigned(FAfterFetchAll) then
    FAfterFetchAll(E = nil);

  if FCommand.FNonBlocking and (E is EOraError) then begin
    Fail := True;
    FConnection.DoError(EOraError(E), Fail);
    if not Fail then
      Abort;
  end;
end;

procedure TOCIRecordSet.FetchAll;
begin
  if (FCommand.GetCursorState < csFetchingAll) and FCommand.GetActive then begin
    if (FCommand.GetCursorState < csExecuting) then
      FCommand.SetCursorState(csExecuteFetchAll)
    else
      FCommand.SetCursorState(csFetchingAll);

    FWaitForFetchBreak := False;

    if FCommand.FNonBlocking then begin
      if not FConnection.FThreadSafety then
        raise Exception.Create(SNeedThreadSafety);
    {$IFDEF MSWINDOWS}
      hEvent.ResetEvent;
      hFetchAllThread := FConnection.RunThread(DoFetchAllPulse, EndFetchAll);
    {$ENDIF}
    end
    else
      DoFetchAll;
  end;
end;

function TOCIRecordSet.RowsReturn: boolean;
begin
  if FCommand.CommandType <> ctUnknown then
    Result := inherited RowsReturn
  else                              //we need to know this info even if CommandType is not set(TCustomDADataSet.DoAfterExecute)
    Result := FCommand.RowsReturn;
end;

{$IFNDEF LITE}
function TOCIRecordSet.IsEncryptableDataType(DataType: Word): boolean;
begin
  Result := (DataType in [dtOraBlob, dtOraClob, dtWideOraClob]) or
    inherited IsEncryptableDataType(DataType);
end;

function TOCIRecordSet.GetDecryptDataType(DataType: Word): Word;
begin
  case DataType of
    dtOraBlob:
      Result := dtBlob;
    dtOraClob:
      Result := dtMemo;
    dtWideOraClob:
      Result := dtWideMemo;
    else
      Result := inherited GetDecryptDataType(DataType);
  end;
end;
{$ENDIF}

{ Navigation }

procedure TOCIRecordSet.SetToBegin;
begin
  inherited;

  if CanFetchBack and (FFetchStart <> 0) then begin
    FFetchAbsolute := True;
//    FirstItem := nil;
    FreeAllItems;
    FFetchEnd := 0;
  end;
end;

procedure TOCIRecordSet.SetToEnd;
begin
  StartWait;
  try
    if GetNonBlocking and FFetchAll then begin
      while FCommand.GetCursorState = csFetchingAll do sleep(0);
    end
    else
      if FCommand.GetCursorState < csFetched then
        if CanFetchBack then begin
          if not ((FFetchEnd = FCommand.FFetchedRows) and FNoData) then begin
            FCommand.InternalFetch(1, OCI_FETCH_LAST);
            FNoData := True;
  //          LastItem := nil;
            FreeAllItems;
            FFetchStart := FCommand.FFetchedRows;
          end;
        end
        else begin
          FetchAll;
          while FCommand.GetCursorState = csFetchingAll do sleep(0);
        end;
  finally
    StopWait;
  end;

  inherited;
end;

procedure TOCIRecordSet.SetConnection(Value: TCRConnection);
begin
  inherited;

  FConnection := TOCIConnection(Value);
end;

function TOCIRecordSet.GetNonBlocking: boolean;
begin
  Result := FCommand.FNonBlocking;
end;

function TOCIRecordSet.GetGCHandle: IntPtr;
begin
  if FGCHandle = nil then
    FGCHandle := AllocGCHandle(Self);
  Result := FGCHandle;
end;

function TOCIRecordSet.GetDisconnectedMode: boolean;
begin
  if FConnection <> nil then
    FDisconnectedMode := FConnection.DisconnectedMode;
  Result := FDisconnectedMode;
end;

function TOCIRecordSet.GetUseUnicode: boolean;
begin
  if FConnection <> nil then
    FUseUnicode := FConnection.FUseUnicode;
  Result := FUseUnicode;
end;

function TOCIRecordSet.GetCharLength: integer;
begin
  if FConnection <> nil then
    FCharLength := FConnection.FCharLength;
  Result := FCharLength;
end;

procedure TOCIRecordSet.Check(Status: Word);
begin
  OCI8.Check(Status, OCISvcCtx)
end;

function TOCIRecordSet.GetOCISvcCtx: TOCISvcCtx;
begin
  Result := FCommand.OCISvcCtx;
end;

function TOCIRecordSet.GetOCI7: TOCI7API;
begin
  Result := FCommand.OCI7;
end;

function TOCIRecordSet.GetOCI8: TOCI8API;
begin
  Result := FCommand.OCI8;
end;

function TOCIRecordSet.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prFetchRows: begin
      FreeFetchBlock;
      Result := inherited SetProp(Prop, Value);
    end;
    prAutoClose:
      FAutoClose := Boolean(Value);
    prDeferredLobRead:
      FDeferredLobRead := Boolean(Value);
    prFieldsAsString:
      FCommand.FFieldsAsString := Boolean(Value);
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TOCIRecordSet.GetProp(Prop: integer; out Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prHasObjectFields:
      Value := FHasObjectFields;
    prRowsFetched:
      Value := FCommand.FFetchedRows;
    prAutoClose:
      Value := FAutoClose;
    prDeferredLobRead:
      Value := FDeferredLobRead;
  else
    Result := inherited GetProp(Prop, Value);
  end;
end;

procedure TOCIRecordSet.GetFieldData(Field: TFieldDesc; FieldBuf: IntPtr; Dest: IntPtr; NeedConvert: boolean);
begin
  case Field.DataType of
    dtFixedChar:
      if NeedConvertEOL then
        AddCRString(FieldBuf, Dest, Field.Size)
      else
        CopyBuffer(FieldBuf, Dest, Field.Size);
    dtFixedWideChar:
      if NeedConvertEOL then
        AddCRUnicode(FieldBuf, Dest, Field.Size div 2)
      else
        CopyBuffer(FieldBuf, Dest, Field.Size);
  else
    inherited GetFieldData(Field, FieldBuf, Dest, NeedConvert);
  end;
end;

procedure TOCIRecordSet.GetDataAsVariant(DataBuf: IntPtr; DataType: Word; SubDataType: Word; FieldLength: Integer; HasParent: boolean; IsFixed: boolean; var Value: variant);
var
  ObjPtr: IntPtr;
{$IFDEF CLR}
  Temp: TBytes;
{$ENDIF}
begin
  ObjPtr := Marshal.ReadIntPtr(DataBuf);
  case DataType of
    dtOraClob: begin
      Value := TBlob(GetGCHandleTarget(ObjPtr)).AsString;
    end;
    dtWideOraClob:
      Value := TBlob(GetGCHandleTarget(ObjPtr)).AsWideString;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    dtSQLTimeStamp: begin
    {$IFDEF CLR}
      SetLength(Temp, SizeOf(TSQLTimeStamp));
      Marshal.Copy(DataBuf, Temp, 0, SizeOf(TSQLTimeStamp));
      Value := VarSQLTimeStampCreate(TSQLTimeStamp.FromBytes(temp));
    {$ELSE}
      Value := VarSQLTimeStampCreate(PSQLTimeStamp(DataBuf)^);
    {$ENDIF}
    end;
  {$ENDIF}
  {$ENDIF}
    dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ:
      Value := TOraTimeStamp(GetGCHandleTarget(ObjPtr)).AsDateTime;
    dtIntervalYM, dtIntervalDS:
      Value := TOraInterval(GetGCHandleTarget(ObjPtr)).AsString;
    dtNumber:
      Value := TOraNumber(GetGCHandleTarget(ObjPtr)).AsFloat;
    dtXML:
      Value := TOraXML(GetGCHandleTarget(ObjPtr)).AsString;
  else
    inherited;
  end
end;

procedure TOCIRecordSet.PutDataAsVariant(DataBuf: IntPtr; DataType: Word; DataSize: Integer; Length, Scale: Word; HasParent: boolean; const Value: variant; IsDatabaseValue: boolean);
var
  ObjPtr: IntPtr;
begin
  case DataType of
    dtNumber: begin
      ObjPtr := Marshal.ReadIntPtr(DataBuf);
      case VarType(Value) of
        varSmallint, varInteger, varByte:
          TOraNumber(GetGCHandleTarget(ObjPtr)).AsInteger := Value;
        varSingle, varDouble{$IFDEF WIN32_64}, varCurrency{$ENDIF}:
          TOraNumber(GetGCHandleTarget(ObjPtr)).AsString := Value;
      else
        if VarIsStr(Value) then
          TOraNumber(GetGCHandleTarget(ObjPtr)).AsString := Value
        else
          raise EConvertError.Create(SCannotConvertType);
      end;
    end;
  else
    inherited;
  end
end;

function TOCIRecordSet.FieldListDependsOnParams: boolean;
begin
  Result := (FCommand <> nil) and (FCommand.FSQLType = SQL_PLSQL) and HasCursorParams;
end;

procedure TOCIRecordSet.GetBookmark(Bookmark: PRecBookmark);
var
  ItemSize: integer;
begin
  if CanFetchBack then
//    with Bookmark^ do
    begin
      Bookmark.Item := CurrentItem;
      if IntPtr(CurrentItem) <> nil then begin
        if FPieceFetch then
          Bookmark.Order := GetItemFetchPos(CurrentItem)
        else begin
          Bookmark.RefreshIteration := GetBlockFetchPos(CurrentItem.Block);
          ItemSize := RecordSize + sizeof(TItemHeader);
          Bookmark.Order := (PtrSubstract(CurrentItem, CurrentItem.Block) - SizeOf(TBlockHeader)) div ItemSize;
        end;
      end;
    end
  else
    inherited;
end;

procedure TOCIRecordSet.SetToBookmark(Bookmark: PRecBookmark);
var
  AFetchStart: integer;
  i: integer;

  function SetCurrentItem(Block: PBlockHeader; ABlockFetchStart: integer): boolean;
  var
    ItemSize: integer;
  begin
    if IntPtr(Block) <> nil then
      Result := (AFetchStart >= ABlockFetchStart) and (AFetchStart < ABlockFetchStart + Block.UsedItems)
    else
      Result := False;
    if Result then begin
      ItemSize := RecordSize + sizeof(TItemHeader);
      CurrentItem := PtrOffset(Block, SizeOf(TBlockHeader) +
        (AFetchStart - ABlockFetchStart) * ItemSize);
      Assert(CurrentItem.Flag = flUsed);
    end
  end;

begin
  if CanFetchBack then
//    with Bookmark^ do
      if IntPtr(Bookmark.Item) <> nil then begin
        FBOF := False;
        FEOF := False;
        if FPieceFetch then begin
          if (Bookmark.Item.Flag = flUsed) and (Bookmark.Order = GetItemFetchPos(Bookmark.Item)) then
            CurrentItem := Bookmark.Item
          else begin
            if (Bookmark.Order >= FFetchStart - BlockMan.DefaultItemCount div 2) and
              (Bookmark.Order < FFetchEnd + BlockMan.DefaultItemCount div 2)
            then begin
              if Bookmark.Order < FFetchStart then begin
                for i := FFetchStart + 1 downto Bookmark.Order do
                  Fetch(True);
                CurrentItem := FirstItem;
              end
              else
              if Bookmark.Order > FFetchEnd then begin
                for i := FFetchEnd to Bookmark.Order do
                  Fetch;
                CurrentItem := LastItem;
              end
            end
            else begin
              FreeAllItems;
              FFetchAbsolute := True;
              FFetchStart := AFetchStart;
              FFetchEnd := AFetchStart;
              FirstItem := nil;
              LastItem := nil;
              Fetch;
              CurrentItem := FirstItem;
            end
          end
        end
        else begin
          if (Bookmark.Item.Flag = flUsed) and (Bookmark.RefreshIteration = GetBlockFetchPos(Bookmark.Item.Block)) then
            CurrentItem := Bookmark.Item
          else begin
            AFetchStart := Bookmark.RefreshIteration + Bookmark.Order;
            if (AFetchStart >= FFetchStart - FFetchRows) and (AFetchStart < FFetchEnd + FFetchRows) then begin
              if AFetchStart < FFetchStart then
                Fetch(True)
              else
              if AFetchStart > FFetchEnd then
                Fetch;

              if not SetCurrentItem(BlockMan.FirstBlock, FFetchEnd - BlockMan.FirstBlock.UsedItems) then
                SetCurrentItem(BlockMan.FirstBlock.Next, FFetchStart);
            end
            else begin
              FreeAllItems;
              FFetchAbsolute := True;
              FFetchStart := AFetchStart;
              FFetchEnd := AFetchStart;
              FirstItem := nil;
              LastItem := nil;
              Fetch;
              CurrentItem := FirstItem;
            end;
            if IntPtr(FirstItem) <> nil then
              FirstItem.Prev := nil;  // remove cycle link
            if IntPtr(LastItem) <> nil then
              LastItem.Next := nil;
          end;
        end;
      end
      else
        CurrentItem := nil
  else
    inherited;
end;

function TOCIRecordSet.GetBlockFetchPos(Block: PBlockHeader): integer;
begin
  if Block = BlockMan.FirstBlock then
    Result := FFetchEnd - BlockMan.FirstBlock.UsedItems
  else
    Result := FFetchStart
end;

function TOCIRecordSet.GetItemFetchPos(Item: PItemHeader): integer;
begin
  Result := FFetchStart;
  while (IntPtr(Item) <> nil) and (IntPtr(Item) <> IntPtr(FirstItem)) do begin
    Item := Item.Prev;
    Inc(Result);
  end;
end;

{ TOraLob }

constructor TOraLob.Create(AOCISvcCtx: TOCISvcCtx);
begin
  inherited Create;

  FOCISvcCtx := AOCISvcCtx;
  phLobLocator := Marshal.AllocHGlobal(sizeof(IntPtr));
  Marshal.WriteIntPtr(phLobLocator, nil);
  FCached := True;
  FCharsetID := 0;
  FCharsetForm := 0;
end;

destructor TOraLob.Destroy;
begin
  FreeLob;
  Marshal.FreeHGlobal(phLobLocator);

  inherited;
end;

procedure TOraLob.SetOCISvcCtx(const Value: TOCISvcCtx);
begin
  FOCISvcCtx := Value;
end;

function TOraLob.GetOCI8: TOCI8API;
begin
  Result := FOCISvcCtx.OCI8;
end;

procedure TOraLob.AllocLob;
var
  LOBLocator: pOCILOBLocator;
begin
  if hLOBLocator = nil then begin
    LOBLocator := hLOBLocator;
    Check(OCI8.OCIDescriptorAlloc(OCISvcCtx.hOCIEnv, LOBLocator, OCI_DTYPE_LOB, 0, nil));
    hLOBLocator := LOBLocator;
    FNativeHandle := True;
  end;
end;

procedure TOraLob.FreeLob;
begin
  FreeBlob;
end;

procedure TOraLob.Disconnect;
begin
  FreeBlob;
end;

function TOraLob.CreateClone: TBlob;
begin
  Result := TOraLob.Create(FOCISvcCtx);

  TOraLob(Result).LobType := LobType;
  TOraLob(Result).FCharLength := FCharLength;
  TOraLob(Result).FCharsetId := FCharsetId;
  TOraLob(Result).FCharsetForm := FCharsetForm;
  TOraLob(Result).IsUnicode := IsUnicode;
end;

procedure TOraLob.FreeBlob;
begin
  if IntPtr(hLOBLocator) <> nil then
    if FNativeHandle then
      if IsTemporary and IsInit then
        Check(OCI8.OCILobFreeTemporary(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLOBLocator));
  if IntPtr(hLOBLocator) <> nil then begin
    if FNativeHandle then
      Check(OCI8.OCIDescriptorFree(hLOBLocator, OCI_DTYPE_LOB));
    hLOBLocator := nil;
    FCharsetForm := 0;
    FNativeHandle := False;
  end;
end;

procedure TOraLob.Check(Status: sword);
begin
  if Status <> OCI_SUCCESS then
    FOCISvcCtx.OCI8.DoOraError(Status, FOCISvcCtx);
end;

procedure TOraLob.CheckValue;
begin
  if FNeedReadLob then
    ReadLob;
end;

function TOraLob.GetSize: Cardinal;
begin
  if FNeedReadLob and (FCharLength > 1) and not FIsUnicode then
    ReadLob; // for multibyte charset LengthLob * CharSize is incorrect

  if FNeedReadLob then
    Result := LengthLob * CharSize
  else
    Result := inherited GetSize;
end;

function TOraLob.GetSizeAnsi: Cardinal;
begin
  Assert(FIsUnicode);
  if FNeedReadLob then begin
    if {$IFNDEF CLR}not SysLocale.FarEast{$ELSE}(LeadBytes = []){$ENDIF} then begin
      Result := LengthLob;
      Exit;
    end;
    ReadLob;
  end;

  Result := inherited GetSizeAnsi;
end;

function TOraLob.GetSizeUni: Cardinal;
begin
  Assert(not FIsUnicode);
  if FNeedReadLob then begin
    if {$IFNDEF CLR}not SysLocale.FarEast{$ELSE}(LeadBytes = []){$ENDIF} then begin
      Result := LengthLob;
      Exit;
    end;
    ReadLob;
  end;

  Result := inherited GetSizeUni;
end;

procedure TOraLob.CheckAlloc;
begin
  if hLOBLocator = nil then
    RaiseError(SLobNotAllocatted);
end;

procedure TOraLob.CheckSession;
begin
  if FOCISvcCtx = nil then
    RaiseError(SSvcCtxNotDefined);
end;

procedure TOraLob.CheckInit;
begin
  if not IsInit then
    RaiseError(SLobNotInited);
end;

procedure TOraLob.Init;
var
  Value: Integer;
begin
  Value := 0;
  Check(OCI8.OCIAttrSet2(hLOBLocator, OCI_DTYPE_LOB, Value, 0, OCI_ATTR_LOBEMPTY, OCISvcCtx.hOCIError));
end;

procedure TOraLob.CreateTemporary(LobType: TLobType);

//  // OCILobCreateTemporary can not create NCLOB locator
//  procedure PLSQLCreateTemporary;
//  var
//    Connection: TOCIConnection;
//    Command: TOCICommand;
//    TempLob: TOraLob;
//  begin
//    Connection := TOCIConnection.Create;
//    try
//      Connection.SetOCISvcCtx(FOCISvcCtx);
//      Command := TOCICommand.Create;
//      try
//        Command.SetConnection(Connection);
//        Command.SetProp(prAutoCommit, False);
//        Command.SetSQL('begin dbms_lob.createtemporary(:TempClob, False); end;');
//        with Command.Params[0] as TOraParamDesc do begin
//          SetDataType(dtOraClob);
//          SetParamType(pdInput);
//          SetNational(True);
//          TempLob := TOraLob.Create(OCISvcCtx);
//          SetObject(TempLob);
//          TempLob.Release;
//        end;
//        Command.Execute();
//
//        OCILobLocator := TempLob.hLobLocator;
//        TempLob.FNativeHandle := False;
//        FNativeHandle := True;
//      finally
//        Command.Free;
//      end;
//    finally
//      Connection.Free;
//    end;
//  end;

var
  OCIlobType: byte;
  CharsetForm: Integer;
begin
  OCISvcCtx.Home.CheckOCI81;
  FreeLob;

  FLobType := LobType;
  case FLobType of
    ltBlob: begin
      OCIlobType := OCI_TEMP_BLOB;
      FCharsetForm := SQLCS_IMPLICIT      
    end;
    ltClob: begin
      OCIlobType := OCI_TEMP_CLOB;
      FCharsetForm := SQLCS_IMPLICIT;      
    end;
    ltNClob: begin
      OCIlobType := OCI_TEMP_CLOB;
      FCharsetForm := SQLCS_NCHAR;
    end;
  else
    raise Exception.Create('Invalid LOB type.');  
  end;

  if OCISvcCtx.Home.OCIVersion >= 9000 then
    CharsetForm := FCharsetForm  
  else  
    CharsetForm := OCI_DEFAULT;
  
//  if (LobType = ltNClob) and (FOCISvcCtx <> nil) then
//    PLSQLCreateTemporary
//  else begin
    AllocLob;
    Check(OCI8.OCILobCreateTemporary(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLOBLocator, OCI_DEFAULT, CharsetForm, OCIlobType,
        0, OCI_DURATION_SESSION))
//  end;
end;

procedure TOraLob.FreeTemporary;
begin
  FreeBlob;
end;

function TOraLob.IsTemporary: LongBool;
begin
  // OCILobIsTemporary is supported in Oracle 8.1.7
  if OCISvcCtx.Home.OCIVersion >= 8100 then
    Check(OCI8.OCILobIsTemporary(OCISvcCtx.hOCIEnv, OCISvcCtx.hOCIError, hLOBLocator, Result))
  else
    Result := False;
end;

function TOraLob.IsInit: boolean;
var
  Res: tbool;
begin
  CheckAlloc;
  Check(OCI8.OCILobLocatorIsInit(OCISvcCtx.hOCIEnv, OCISvcCtx.hOCIError, hLOBLOcator, Res));
  Result := Res <> 0;
end;

function TOraLob.LengthLob: Cardinal;
var
  Res: Cardinal;
begin
  CheckAlloc;
  CheckSession;
  if IsInit then begin
    Check(OCI8.OCILobGetLength(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLOBLocator, Res));
    Result := Res;
    // reset FNeedReadLob to avoid multiple LengthLob calls on empty LOB
    if Result = 0 then
      FNeedReadLob := False;
  end
  else begin
    Result := 0;
    FNeedReadLob := False;
  end;
end;

procedure TOraLob.CheckCharSetForm;
var
  CharsetForm: ub1;
begin
  if FCharsetForm = 0 then begin
    Check(OCI8.OCILobCharSetForm(OCISvcCtx.hOCIEnv, OCISvcCtx.hOCIError, hLOBLocator, CharsetForm));
    FCharsetForm := CharsetForm;
    if CharsetForm = SQLCS_NCHAR then
      FLobType := ltNClob;
  end;
end;

function TOraLob.CharSize: Byte;
begin
  Result := 1;
  if FISUnicode then Result := 2;
end;

procedure TOraLob.ReadLob;
var
  Piece: PPieceHeader;
begin
  Piece := nil;
  ReadLob(Piece);
end;

procedure TOraLob.ReadLob(var SharedPiece: PPieceHeader);
var
  Piece, Piece2: PPieceHeader;
  BufLen: cardinal;
  Buflen_Bytes: Int64;
  Buflen_Chars: Int64;
  Res: integer;
  CharsetId: word;
  StartBufLen: longint;
  PieceState: Byte;
begin
  CheckAlloc;
  CheckSession;

  FData.Clear;
  PieceState := OCI_FIRST_PIECE;
  if IsInit then begin
    StartBufLen := 0;
    CheckCharSetForm;
    if IntPtr(SharedPiece) = nil then
      AllocPiece(Piece, PieceSize)
    else
      Piece := SharedPiece;
    repeat
      try
        BufLen := StartBufLen;

        if FIsUnicode then
          CharsetId := OCI_UTF16ID
        else
          CharsetId := FCharsetId;

        if (OCISvcCtx.Home.OCIVersion >= 10000) then begin
          Buflen_Bytes := BufLen;
          Buflen_Chars := BufLen;
          Res := OCI8.OCILobRead2(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLOBLocator, Buflen_Bytes, Buflen_Chars, 1,
            PtrOffset(Piece, Sizeof(TPieceHeader)), PieceSize, PieceState, nil, nil, CharsetId, FCharsetForm);
          PieceState := OCI_NEXT_PIECE;
          Piece.Used :=  Buflen_Bytes;
          BufLen := Buflen_Bytes;
        end
        else begin
          Res := OCI8.OCILobRead(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLOBLocator, BufLen, 1,
            PtrOffset(Piece, Sizeof(TPieceHeader)), PieceSize, nil, nil, CharsetId, FCharsetForm);
          if FLobType = ltBlob then
            Piece.Used := BufLen
          else
            Piece.Used := BufLen * CharSize;
        end;

        if Res <> OCI_NEED_DATA then
          Check(Res);
      except
        if IntPtr(Piece) <> IntPtr(SharedPiece) then
          FreePiece(Piece);
        raise;
      end;

      if BufLen = 0 then begin  // 804 server and any another client
        if IntPtr(Piece) <> IntPtr(SharedPiece) then
          FreePiece(Piece);
        FNeedReadLob := False;
        Exit;
      end;

      if Piece = SharedPiece then begin
        if Piece.Used < Piece.Size div 2 then begin
          AllocPiece(Piece2, Piece.Used);
          CopyBuffer(PtrOffset(Piece, SizeOf(TPieceHeader)),
            PtrOffset(Piece2, SizeOf(TPieceHeader)), Piece.Used);
          Piece2.Used := Piece.Used;
          Piece := Piece2;
        end
        else
          SharedPiece := nil;
      end
      else
        if Piece.Used < Piece.Size div 2 then
          CompressPiece(Piece);

      AppendPiece(Piece);

      if Res = OCI_SUCCESS then
        break
      else
        AllocPiece(Piece, PieceSize);
    until False;
  end;
  FNeedReadLob := False;
  FCached := True;
end;

procedure TOraLob.WriteLob;
var
  Piece: PPieceHeader;
  BufLen: cardinal;
  Offset: cardinal;
  CharsetId: word;
  CharCount: ub4;
  EndChar: byte;
begin
  CheckAlloc;
  CheckSession;
  CheckInit;
  CheckCharSetForm;

  Check(OCI8.OCILobTrim(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLOBLocator, 0));

  Piece := FirstPiece;
  Offset := 1;
  while IntPtr(Piece) <> nil do begin
    BufLen := Piece.Used;

    if (OCISvcCtx.Home.PossibleOCICallStyles = [OCI80]) and (FLobType <> ltBlob) and not FIsUnicode then begin
      EndChar := Marshal.ReadByte(IntPtr(Piece), Sizeof(TPieceHeader) + BufLen - 1);
      if EndChar = 0 then
        Dec(BufLen);
    end;

    if FIsUnicode then begin
      CharsetId := OCI_UTF16ID;
      if FLobType <> ltBlob then
        CharCount := BufLen div CharSize
      else
        CharCount := BufLen;
    end
    else begin
      if (FLobType <> ltBlob) and OCISvcCtx.UnicodeEnv then
        raise Exception.Create(SClobMustBeUnicode);
      CharsetId := FCharsetId;
      CharCount := BufLen;
    end;
    Check(OCI8.OCILobWrite(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLOBLocator, CharCount, Offset,
      PtrOffset(Piece, Sizeof(TPieceHeader)), BufLen, OCI_ONE_PIECE, nil, nil, CharsetId, FCharsetForm));

    Piece := Piece.Next;
    Inc(Offset, CharCount);
  end;
end;

function TOraLob.Read(Position, Count: cardinal; Dest: IntPtr): cardinal;
var
  BytesRead: cardinal;
  BytesRead64: Int64;
  CharsRead: Int64;
  Res: integer;
  CharsetId: word;
begin
  Result := 0;
  if not Cached then begin
    CheckAlloc;
    CheckSession;
    if IsInit then begin
      BytesRead := Count; // to avoid OCI_NEED_DATA error
      CheckCharSetForm;

      if BytesRead = 0 then
        BytesRead := LengthLob;

      if Count = 0 then
        Count := Size;

      if FIsUnicode then
        CharsetId := OCI_UTF16ID
      else
        CharsetId := 0;

      if (OCISvcCtx.Home.OCIVersion >= 10000) then begin
        BytesRead64 := BytesRead;
        CharsRead := BytesRead;

        Res := OCI8.OCILobRead2(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLOBLocator, BytesRead64, CharsRead, Position + 1,
          Dest, Count, OCI_FIRST_PIECE, nil, nil, CharsetId, FCharsetForm);
        BytesRead := CharsRead;
        Result := BytesRead64;
      end else begin
        Res := OCI8.OCILobRead(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLOBLocator, BytesRead, Position + 1,
          Dest, Count, nil, nil, CharsetId, FCharsetForm);
        Result := BytesRead * CharSize;
      end;

      if Res <> OCI_NEED_DATA then
        Check(Res);
    end;
  end
  else
    Result := inherited Read(Position, Count, Dest);
end;

procedure TOraLob.Write(Position, Count: cardinal; Source: IntPtr);
begin
  Cached := True;

  inherited Write(Position, Count, Source);
end;

procedure TOraLob.Clear;
begin
  FNeedReadLob := False;

  inherited Clear;
end;

procedure TOraLob.Truncate(NewSize: cardinal);
begin
  if NewSize = 0 then
    FNeedReadLob := False
  else
    CheckValue;

  inherited Truncate(NewSize);
end;

{procedure TLOBLocator.TrimLob(Size:longint);
begin
  CheckAlloc;

  EnableBuffering;
  Check(OCI8.OCILobTrim(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLOBLOcator, Size));
  DisableBuffering;
end;}

procedure TOraLob.EnableBuffering;
begin
  CheckAlloc;
  CheckSession;

  Check(OCI8.OCILobEnableBuffering(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLOBLOcator));
end;

procedure TOraLob.DisableBuffering;
begin
  CheckAlloc;
  CheckSession;

  Check(OCI8.OCILobDisableBuffering(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLOBLOcator));
end;

function TOraLob.GethOCILobLocator: pOCIStmt;
begin
  Result := Marshal.ReadIntPtr(phLobLocator);
end;

procedure TOraLob.SethOCILobLocator(Value: pOCIStmt);
begin
  Marshal.WriteIntPtr(phLobLocator, Value);
end;

function TOraLob.GetOCILobLocator: pOCILobLocator;
begin
  if hLobLocator = nil then
    AllocLob;

  Result := hLobLocator;
end;

procedure TOraLob.SetOCILobLocator(Value: pOCILobLocator);
begin
  FreeLob;
  hLobLocator := Value;
  if IntPtr(hLobLocator) <> nil then
    FNativeHandle := False;
end;

function TOraLob.GetOCILobLocatorPtr: ppOCILobLocator;
begin
  if hLobLocator = nil then
    AllocLob;

  Result := phLobLocator;
end;

procedure TOraLob.SetCached(const Value: boolean);
begin
  if FCached <> Value then begin
    if not Value and (IntPtr(FirstPiece) <> nil) then begin
      FData.Clear;
      FNeedReadLob := True;
    end;
    FCached := Value;
  end;
end;

{ TOraFile }

destructor TOraFile.Destroy;
begin
{  if IsOpen then
    Close;}

  inherited;
end;

procedure TOraFile.AllocLob;
var
  LOBLocator: pOCILOBLocator;
begin
  if hLOBLocator = nil then begin
    LOBLocator := hLOBLocator;
    Check(OCI8.OCIDescriptorAlloc(OCISvcCtx.hOCIEnv, LOBLocator, OCI_DTYPE_FILE, 0, nil));
    hLOBLocator := LOBLocator;
    FNativeHandle := True;
  end;
end;

procedure TOraFile.FreeBlob;
begin
  if IntPtr(hLOBLocator) <> nil then begin
    if FNativeHandle then
      Check(OCI8.OCIDescriptorFree(hLOBLocator, OCI_DTYPE_FILE));
    hLOBLocator := nil;
    FNativeHandle := False;
  end;
end;

procedure TOraFile.Open;
begin
  CheckAlloc;
  CheckSession;

  if IsInit then
    Check(OCI8.OCILobFileOpen(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLobLocator, OCI_FILE_READONLY));
end;

procedure TOraFile.Close;
begin
  CheckAlloc;
  CheckSession;

  if IsInit then
    Check(OCI8.OCILobFileClose(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLobLocator));
end;

procedure TOraFile.EnableRollback;
begin
  FNeedRollback := True;
end;

procedure TOraFile.SaveToRollback;
begin
  FRollbackFileDir := GetFileDir;
  FRollbackFileName := GetFileName;

  CanRollback := True;
end;

procedure TOraFile.Commit;
begin
  CanRollback := False;
  FNeedRollback := False;
end;

procedure TOraFile.Cancel;
begin
  if CanRollback then begin
    FileName := FRollbackFileName;
    FileDir := FRollbackFileDir;
    if Cached then
      Refresh
    else begin
      Clear;
      FNeedReadLob := True;
    end;
  end;
  CanRollback := False;
  FNeedRollback := False;
end;

procedure TOraFile.Refresh;
begin
  CheckAlloc;
  CheckSession;

  FData.Clear;

  if Exists then begin
    Open;
    try
      ReadLob;
    finally
      Close;
    end;
  end;
end;

function TOraFile.IsOpen: boolean;
var
  Res: tbool;
begin
  Result := False;
  if (IntPtr(hLobLocator) <> nil) and IsInit then begin
    CheckSession;
    Check(OCI8.OCILobFileIsOpen(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLobLocator, Res));
    Result := Res <> 0;
  end;
end;

function TOraFile.Exists: boolean;
var
  Val: tbool;
  Res: sword;
begin
  Result := False;
  if (IntPtr(hLobLocator) <> nil) and IsInit then begin
    CheckSession;

    if FileName = '' then
      Exit;

    Res := OCI8.OCILobFileExists(OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError, hLobLocator, Val);
    if Res = OCI_SUCCESS then
      Result := Val <> 0
    else
      if OCI8.GetOraError(Res, FOCISvcCtx) <> 22285 then  // dir or file not exist
        OCI8.DoOraError(Res, FOCISvcCtx);
  end;
end;

function TOraFile.GetFileDir: string;
var
  Len: ub2;
  hLen, Handle: IntPtr;
begin
  if (hLobLocator <> nil) and IsInit then begin
    Len := 255 * SizeOfCharOCI(OCISvcCtx.UnicodeEnv);
    Handle := Marshal.AllocHGlobal(Len);
    hLen := OrdinalToPtr(Len);
    try
      Check(OCI8.OCILobFileGetName(OCISvcCtx.hOCIEnv, OCISvcCtx.hOCIError, hLobLocator, Handle, hLen, nil, nil));
    finally
      PtrToOrdinal(hLen, Len);
      Result := PtrToStringOCI(Handle, Len, OCISvcCtx.UnicodeEnv);
      Marshal.FreeHGlobal(Handle);
    end;
    if Result = #0 then
      Result := '';
  end
  else
    Result := '';
end;

procedure TOraFile.SetFileDir(const Value: string);
begin
  SetFileDirAndName(AnsiUpperCase(Value), FileName);
end;

function TOraFile.GetFileName: string;
var
  Len: ub2;
  hLen: IntPtr;
  Handle: IntPtr;
begin
  if (IntPtr(hLobLocator) <> nil) and IsInit then begin
    Len := 255 * SizeOfCharOCI(OCISvcCtx.UnicodeEnv);
    Handle := Marshal.AllocHGlobal(Len);
    hLen := OrdinalToPtr(Len);
    try
      Check(OCI8.OCILobFileGetName(OCISvcCtx.hOCIEnv, OCISvcCtx.hOCIError, hLobLocator, nil, nil, Handle, hLen));
    finally
      PtrToOrdinal(hLen, Len);
      Result := PtrToStringOCI(Handle, Len, OCISvcCtx.UnicodeEnv);
      Marshal.FreeHGlobal(Handle);
    end;
    if Result = #0 then
      Result := '';
  end
  else
    Result := '';
end;

procedure TOraFile.SetFileName(const Value: string);
begin
  SetFileDirAndName(FileDir, Value);
end;

procedure TOraFile.SetFileDirAndName(const FileDir, FileName: string);
var
  DSize, NSize, Res: integer;
  p1, p2: IntPtr;
begin
  CheckAlloc;

  if FNeedRollback and not CanRollback then
    SaveToRollback;

  p1 := StringToHGlobalOCI(FileDir, DSize, OCISvcCtx.UnicodeEnv);
  if DSize = 0 then
    DSize := SizeOfCharOCI(OCISvcCtx.UnicodeEnv);
  p2 := StringToHGlobalOCI(FileName, NSize, OCISvcCtx.UnicodeEnv);
  if NSize = 0 then
    NSize := SizeOfCharOCI(OCISvcCtx.UnicodeEnv);

  Res := OCI8.OCILobFileSetName(OCISvcCtx.hOCIEnv, OCISvcCtx.hOCIError, phLobLocator, p1, DSize, p2, NSize);
  FreeStringOCI(p1, OCISvcCtx.UnicodeEnv);
  FreeStringOCI(p2, OCISvcCtx.UnicodeEnv);
  Check(Res);
end;

procedure TOraFile.CheckValue;
begin
  if FNeedReadLob and Exists then begin
    Open;
    try
      ReadLob;
    finally
      Close;
    end;
  end;
end;

function TOraFile.CharSize: Byte;
begin
  Result := 1;
end;

{ TOraTimeStamp }

constructor TOraTimeStamp.Create(ADataType: word);
begin
  inherited Create;

  FEnvironment := nil;
  FHandleType := htLocal;

  Init(ADataType);
end;

constructor TOraTimeStamp.Create(AOCIEnvironment: TOCIEnvironment; ADataType: word);
begin
  inherited Create;

  FEnvironment := AOCIEnvironment;
  if FEnvironment = nil then
    FHandleType := htLocal
  else begin
    FHandleType := htNative;
  {$IFNDEF AUTOREFCOUNT}
    FEnvironment.AddRef;
  {$ENDIF}
  end;

  Init(ADataType);
end;

constructor TOraTimeStamp.Create(AOCISvcCtx: TOCISvcCtx; ADataType: word);
begin
  inherited Create;

  if AOCISvcCtx <> nil then
    FEnvironment := AOCISvcCtx.Environment
  else
    FEnvironment := nil;
  if FEnvironment = nil then
    FHandleType := htLocal
  else begin
    FHandleType := htNative;
  {$IFNDEF AUTOREFCOUNT}
    FEnvironment.AddRef;
  {$ENDIF}
  end;

  Init(ADataType);
end;

destructor TOraTimeStamp.Destroy;
begin
  FreeDateTime;
  Marshal.FreeHGlobal(phOCIDateTime);
  Marshal.FreeHGlobal(FIndicator);

  if FEnvironment <> nil then begin
  {$IFNDEF AUTOREFCOUNT}
    FEnvironment.ReleaseRef;
  {$ENDIF}
    FEnvironment := nil;
  end;

  inherited;
end;

procedure TOraTimeStamp.Init(ADataType: word);
begin
  phOCIDateTime := Marshal.AllocHGlobal(sizeof(IntPtr));
  Marshal.WriteIntPtr(phOCIDateTime, nil);
  FIndicator := Marshal.AllocHGlobal(sizeof(OCIInd));
  Marshal.WriteInt16(FIndicator, OCI_IND_NULL);
  FPrecision := 6;
  hOCIDateTime := nil;

  case ADataType of
    dtTimeStamp{$IFDEF VER6P}{$IFNDEF FPC}, dtSQLTimeStamp{$ENDIF}{$ENDIF}:
      FDescriptorType := OCI_DTYPE_TIMESTAMP;
    dtTimeStampTZ:
      FDescriptorType := OCI_DTYPE_TIMESTAMP_TZ;
    dtTimeStampLTZ:
      FDescriptorType := OCI_DTYPE_TIMESTAMP;
  else
    Assert(False);
  end;
end;

procedure TOraTimeStamp.SetEnvironment(AEnvironment: TOCIEnvironment);
var
  TempIsNull: boolean;
  TempValue: TOCIDateTime;
begin
  if FEnvironment <> AEnvironment then begin
    TempIsNull := GetIsNull;
    if not TempIsNull then
      TempValue := ToLocalDateTime
    else
      TempValue := nil;

    try
      FreeDateTime;

    {$IFNDEF AUTOREFCOUNT}
      if FEnvironment <> nil then
        FEnvironment.ReleaseRef;
    {$ENDIF}
      FEnvironment := AEnvironment;
      if FEnvironment <> nil then begin
        FHandleType := htNative;
      {$IFNDEF AUTOREFCOUNT}
        FEnvironment.AddRef;
      {$ENDIF}
      end
      else
        FHandleType := htLocal;

      SetIsNull(TempIsNull);
      if not TempIsNull then
        FromLocalDateTime(TempValue);
    finally
      TempValue.Free
    end;
  end;
end;

procedure TOraTimeStamp.AllocDateTime;
var
  OCIDateTime: pOCIDateTime;
begin
  if FHandleType = htLocal then begin
    if FLocalDateTime = nil then
      FLocalDateTime := TOCIDateTime.Create(FDescriptorType);
  end
  else if hOCIDateTime = nil then begin
    OCIDateTime := hOCIDateTime;
    Check(FEnvironment.Home.OCI8.OCIDescriptorAlloc(FEnvironment.hOCIEnv, OCIDateTime, FDescriptorType, 0, nil));
    hOCIDateTime := OCIDateTime;
    FHandleType := htNative;
  end;
end;

procedure TOraTimeStamp.FreeDateTime;
begin
  if FHandleType = htLocal then
    FreeAndNil(FLocalDateTime)
  else if IntPtr(hOCIDateTime) <> nil then begin
    if FHandleType = htNative then
      Check(FEnvironment.Home.OCI8.OCIDescriptorFree(hOCIDateTime, FDescriptorType));
    hOCIDateTime := nil;
    Marshal.WriteInt16(FIndicator, OCI_IND_NULL);
    FHandleType := htNative;
  end;
end;

function TOraTimeStamp.ToLocalDateTime: TOCIDateTime;
var
  Year: Smallint;
  Month, Day: Byte;
  Hour, Min, Sec: byte;
  FSec: cardinal;
  TZ: string;
begin
  Result := TOCIDateTime.Create(FDescriptorType);

  GetDate(Year, Month, Day);
  GetTime(Hour, Min, Sec, FSec);
  if FDescriptorType = OCI_DTYPE_TIMESTAMP_TZ then
    TZ := GetTimeZone
  else
    TZ := '';

  Result.Construct(Year, Month, Day, Hour, Min, Sec, FSec, TZ);
end;

procedure TOraTimeStamp.FromLocalDateTime(Value: TOCIDateTime);
var
  Year: Smallint;
  Month, Day: Byte;
  Hour, Min, Sec: byte;
  FSec: cardinal;
  TZ: string;
begin
  Value.GetDate(Year, Month, Day);
  Value.GetTime(Hour, Min, Sec, FSec);
  if Value.DescriptorType = OCI_DTYPE_TIMESTAMP_TZ then
    TZ := GetTimeZone
  else
    TZ := '';

  Construct(Year, Month, Day, Hour, Min, Sec, FSec, TZ);
end;

procedure TOraTimeStamp.Disconnect;
begin
  SetEnvironment(nil);
end;

function TOraTimeStamp.GetIsNull: boolean;
var
  Indicator: OCIInd;
begin
  Indicator := Marshal.ReadInt16(FIndicator);
  Result := Indicator = OCI_IND_NULL;
end;

procedure TOraTimeStamp.SetIsNull(Value: boolean);
begin
  if Value then
    Marshal.WriteInt16(FIndicator, OCI_IND_NULL)
  else
    Marshal.WriteInt16(FIndicator, OCI_IND_NOTNULL);
end;

procedure TOraTimeStamp.Assign(Source: TOraTimeStamp);
begin
  Source.AssignTo(Self);
end;

procedure TOraTimeStamp.AssignTo(Dest: TOraTimeStamp);

  procedure LocalAssign;
  var
    Temp: TOCIDateTime;
  begin
    Temp := ToLocalDateTime;
    try
      Dest.FromLocalDateTime(Temp);
    finally
      Temp.Free;
    end;
  end;

begin
  Dest.DescriptorType := DescriptorType;
  Dest.AllocDateTime;
  Dest.Format := Format;
  Dest.Precision := Precision;
  Marshal.WriteInt16(Dest.FIndicator, Marshal.ReadInt16(FIndicator));

  if not IsNull then
    if (Dest.FEnvironment = nil) and (FEnvironment = nil) then
      Dest.LocalDateTime.Assign(LocalDateTime)
    else if Dest.FEnvironment = FEnvironment then
      Check(FEnvironment.Home.OCI8.OCIDateTimeAssign(FEnvironment.hOCIEnv, FEnvironment.hOCIError, OCIDateTime, Dest.OCIDateTime))
    else
      LocalAssign;
end;

function TOraTimeStamp.Compare(Dest: TOraTimeStamp): integer;

  function LocalCompare: Integer;
  var
    DateTime1, DateTime2: TOCIDateTime;
  begin
    DateTime1 := ToLocalDateTime;
    try
      DateTime2 := Dest.ToLocalDateTime;
      try
        Result := DateTime1.Compare(DateTime2);
      finally
        DateTime2.Free;
      end;
    finally
      DateTime1.Free;
    end;
  end;

begin
  if (Dest.FEnvironment = nil) and (FEnvironment = nil) then
    if Dest.IsNull or IsNull then
      raise Exception.Create(SDatetimesIncomparable)
    else
      Result := LocalDateTime.Compare(Dest.LocalDateTime)
  else if Dest.FEnvironment = FEnvironment then
    Check(FEnvironment.Home.OCI8.OCIDateTimeCompare(FEnvironment.hOCIEnv, FEnvironment.hOCIError, OCIDateTime, Dest.OCIDateTime, Result))
  else
    if Dest.IsNull or IsNull then
      raise Exception.Create(SDatetimesIncomparable)
    else
      Result := LocalCompare;
end;

procedure TOraTimeStamp.SetDescriptorType(const Value: cardinal);
begin
  if FDescriptorType <> Value then begin
    FreeDateTime;
    FDescriptorType := Value;
  end;
end;

function TOraTimeStamp.GethOCIDateTime: pOCIDateTime;
begin
  Result := Marshal.ReadIntPtr(phOCIDateTime);
end;

procedure TOraTimeStamp.SethOCIDateTime(Value: pOCIDateTime);
begin
  Marshal.WriteIntPtr(phOCIDateTime, Value);
end;

function TOraTimeStamp.GetOCIDateTime: pOCIDateTime;
begin
  AllocDateTime;
  Result := hOCIDateTime;
end;

procedure TOraTimeStamp.SetOCIDateTime(const Value: pOCIDateTime);
begin
  FreeDateTime;
  hOCIDateTime := Value;
  if IntPtr(Value) <> nil then begin
    FHandleType := htShared;
    IsNull := False;
  end;
end;

function TOraTimeStamp.GetOCIDateTimePtr: ppOCIDateTime;
begin
  AllocDateTime;
  Result := phOCIDateTime;
end;

function TOraTimeStamp.GetLocalDateTime: TOCIDateTime;
begin
  AllocDateTime;
  Result := FLocalDateTime;
end;

procedure TOraTimeStamp.Construct(Year: smallint; Month, Day, Hour, Min,
  Sec: byte; FSec: cardinal; TimeZone: string);
var
  Res, BufSize: integer;
  p: IntPtr;
begin
  if TimeZone <> '' then
    p := StringToHGlobalOCI(TimeZone, BufSize, FEnvironment.UnicodeEnv)
  else begin
    p := nil; // PChar('') means UTC
    BufSize := 0;
  end;

  if FHandleType = htLocal then
    LocalDateTime.Construct(Year, Month, Day, Hour, Min, Sec, FSec, TimeZone)
  else begin
    Res := FEnvironment.Home.OCI8.OCIDateTimeConstruct(FEnvironment.hOCIEnv, FEnvironment.hOCIError, OCIDateTime, Year, Month,
      Day, Hour, Min, Sec, FSec, p, BufSize);
    FreeStringOCI(p, FEnvironment.UnicodeEnv);
    Check(Res);
  end;

  Marshal.WriteInt16(FIndicator, OCI_IND_NOTNULL);
end;

function TOraTimeStamp.GetAsString: string;
var
  BufSize: ub4;
  FmtSize: integer;
  Ptr, FmtPtr: IntPtr;
begin
  if IsNull then begin // to avoid error on OCI function call
    Result := '';
    Exit;
  end;

  if FFormat = '' then
    SetFormat('');

  if FHandleType = htLocal then
    Result := LocalDateTime.ToString(format, Precision)
  else begin
    BufSize := 255 * SizeOfCharOCI(FEnvironment.UnicodeEnv);
    Ptr := Marshal.AllocHGlobal(BufSize);
    FmtPtr := StringToHGlobalOCI(FFormat, FmtSize, FEnvironment.UnicodeEnv);
    try
      try
        Check(FEnvironment.Home.OCI8.OCIDateTimeToText(FEnvironment.hOCIEnv, FEnvironment.hOCIError,
          OCIDateTime, FmtPtr, FmtSize, Precision, nil, 0, BufSize, Ptr));
        Result := PtrToStringOCI(Ptr, BufSize, FEnvironment.UnicodeEnv);
      except
        // Timestamp value is corrupted by a trigger and RETURNING INTO
        on E: EOraError do
          if E.ErrorCode = 1877 then
            Result := ''
          else
            raise;
        on E: EConvertError do // for Direct option
          Result := '';
      end;
    finally
      Marshal.FreeHGlobal(Ptr);
      FreeStringOCI(FmtPtr, FEnvironment.UnicodeEnv);
    end;
  end;
end;

procedure TOraTimeStamp.SetAsString(const Value: string);
var
  hTmp: pOCIDateTime;
  Buf: pOCIDateTime;
  p1, p2: IntPtr;
  VSize, FSize: integer;
begin
  // We need to backup timestamp value because OCIDateTimeFromText may corrupt
  // it if input string is wrong format.
  if Value = '' then begin
    Marshal.WriteInt16(FIndicator, OCI_IND_NULL);
    Exit;
  end;

  if FFormat = '' then
    SetFormat('');

  if FHandleType = htLocal then
    LocalDateTime.Parse(Value, FFormat)
  else begin
    hTmp := hOCIDateTime;
    hOCIDateTime := nil;
    p1 := StringToHGlobalOCI(Value, VSize, FEnvironment.UnicodeEnv);
    p2 := StringToHGlobalOCI(FFormat, FSize, FEnvironment.UnicodeEnv);
    try
      try
        Check(FEnvironment.Home.OCI8.OCIDateTimeFromText(FEnvironment.hOCIEnv, FEnvironment.hOCIError,
          p1, VSize, p2, FSize, nil, 0, OCIDateTime));
      except
        // restore valid timestamp value
        Buf := hTmp;
        hTmp := hOCIDateTime;
        hOCIDateTime := Buf;
        raise;
      end;
    finally
      FreeStringOCI(p1, FEnvironment.UnicodeEnv);
      FreeStringOCI(p2, FEnvironment.UnicodeEnv);
      if hTmp <> nil then
        FEnvironment.Home.OCI8.OCIDescriptorFree(hTmp, FDescriptorType);
    end;
  end;

  Marshal.WriteInt16(FIndicator, OCI_IND_NOTNULL);
end;

procedure TOraTimeStamp.GetDate(var Year: smallint; var Month, Day: byte);
begin
  if FHandleType = htLocal then
    LocalDateTime.GetDate(Year, Month, Day)
  else
    Check(FEnvironment.Home.OCI8.OCIDateTimeGetDate(FEnvironment.hOCIEnv, FEnvironment.hOCIError, OCIDateTime, Year, Month, Day));
end;

procedure TOraTimeStamp.SetDate(Year: smallint; Month, Day: byte);
var
  Hour, Min, Sec: byte;
  FSec: cardinal;
  TZ: string;
begin
  GetTime(Hour, Min, Sec, FSec);

  if DescriptorType <> OCI_DTYPE_TIMESTAMP then
    // suppress exception raised when timezone is absent
    try
      TZ := TimeZone;
    except
      on EOraError do;
    end;

  Construct(Year, Month, Day, Hour, Min, Sec, FSec, TZ);
end;

procedure TOraTimeStamp.GetTime(var Hour, Min, Sec: byte; var FSec: cardinal);
begin
  if FHandleType = htLocal then
    LocalDateTime.GetTime(Hour, Min, Sec, FSec)
  else
    Check(FEnvironment.Home.OCI8.OCIDateTimeGetTime(FEnvironment.hOCIEnv, FEnvironment.hOCIError, OCIDateTime, Hour, Min, Sec, FSec));
end;

procedure TOraTimeStamp.SetTime(Hour, Min, Sec: byte; FSec: cardinal);
var
  Year: smallint;
  Month, Day: byte;
  TZ: string;
begin
  GetDate(Year, Month, Day);
  if DescriptorType <> OCI_DTYPE_TIMESTAMP then
    TZ := TimeZone;
  Construct(Year, Month, Day, Hour, Min, Sec, FSec, TZ);
end;

procedure TOraTimeStamp.GetTimeZoneOffset(var Hour, Min: shortint);
begin
  if FHandleType = htLocal then
    LocalDateTime.GetTimeZoneOffset(Hour, Min)
  else
    Check(FEnvironment.Home.OCI8.OCIDateTimeGetTimeZoneOffset(FEnvironment.hOCIEnv, FEnvironment.hOCIError, OCIDateTime, Hour, Min));
end;

procedure TOraTimeStamp.SetTimeZoneOffset(TZHour, TZMin: shortint);
var
  Year: smallint;
  Month, Day, Hour, Min, Sec: byte;
  FSec: cardinal;
  TZ: string;
begin
  GetDate(Year, Month, Day);
  GetTime(Hour, Min, Sec, FSec);

  TZ := '';

  if TZHour >= 0 then
    TZ := TZ + '+';
  TZ := TZ + IntToStr(TZHour) + ':';

  if tzMin >= 0 then
    TZ := TZ + '+';

  TZ := TZ + IntToStr(TZMin);

  Construct(Year, Month, Day, Hour, Min, Sec, FSec, TZ);

  CheckValid;
end;

function TOraTimeStamp.GetTimeZone: string;
var
  BufSize: cardinal;
  Ptr: IntPtr;
begin
  if FHandleType = htLocal then
    Result := LocalDateTime.GetTimeZoneName
  else begin
    BufSize := 255;
    Ptr := Marshal.AllocHGlobal(BufSize);
    try
      Check(FEnvironment.Home.OCI8.OCIDateTimeGetTimeZoneName(FEnvironment.hOCIEnv, FEnvironment.hOCIError, OCIDateTime, Ptr, BufSize));
      Result := string(Marshal.PtrToStringAnsi(Ptr, BufSize));
    finally
      Marshal.FreeHGlobal(Ptr);
    end;
  end;
end;

procedure TOraTimeStamp.CheckValid;
var
  Valid: cardinal;
begin
  if FHandleType = htLocal then
    Valid := LocalDateTime.Check
  else begin
    Assert(hOCIDateTime <> nil);
    Valid := 0;
    Check(FEnvironment.Home.OCI8.OCIDateTimeCheck(FEnvironment.hOCIEnv, FEnvironment.hOCIError, hOCIDateTime, Valid));
  end;

  if Valid <> 0 then
    raise Exception.Create(SInvalidTimeStamp);
end;

procedure TOraTimeStamp.Check(Res: sword);
begin
  {$IFDEF CLR}Devart.Odac.{$ENDIF}{$IFNDEF UNIDACPRO}OraCall{$ELSE}OraCallUni{$ENDIF}.Check(
    @FEnvironment.Home.OCI8.OCIErrorGet,
    Res,
    FEnvironment.UnicodeEnv,
    FEnvironment.hOCIError
  );
end;

procedure TOraTimeStamp.SetFormat(const AFormat: string);
var
  P, J, StrLen: integer;
  Str: string;
  Buf: integer;
  Temp: string;
begin
  if AFormat = '' then begin
    FFormat := '';
    P := 1;
    Str := {$IFDEF VER16P}FormatSettings.{$ENDIF}ShortDateFormat;
    StrLen := Length(Str);
    while P <= StrLen do begin
      case Str[P] of
        'd','D': begin
          Inc(P);
          if (P <= StrLen) and ((Str[P] = 'd') or (Str[P] = 'D')) then begin
            Inc(P);
            if (P <= StrLen) and ((Str[P] = 'd') or (Str[P] = 'D')) then begin
              Inc(P);
              if (P <= StrLen) and ((Str[P] = 'd') or (Str[P] = 'D')) then begin
                Inc(P);
                FFormat := FFormat + 'fmDAYfm';
              end else
                FFormat := FFormat + 'DY';
            end else
              FFormat := FFormat + 'DD';
          end else
            FFormat := FFormat + 'fmDDfm';
        end;
        'm','M': begin
          Inc(P);
          if (P <= StrLen) and ((Str[P] = 'm') or (Str[P] = 'M')) then begin
            Inc(P);
            if (P <= StrLen) and ((Str[P] = 'm') or (Str[P] = 'M')) then begin
              Inc(P);
              if (P <= StrLen) and ((Str[P] = 'm') or (Str[P] = 'M')) then begin
                Inc(P);
                FFormat := FFormat + 'MONTH';
              end else
                FFormat := FFormat + 'MON';
            end else
              FFormat := FFormat + 'MM';
          end else
            FFormat := FFormat + 'fmMMfm';
        end;
        'g','G': begin
          Inc(P);
          FFormat := FFormat + 'E';
        end;
        '''','"': begin
          Buf := P;
          Inc(P);
          P := Pos(Str[Buf], Copy(Str, P, StrLen - P + 1));
          if P <> 0 then begin
            Inc(P, Buf + 1);
            Str[Buf] := '"';
            Str[P - 1] := '"';
            FFormat := FFormat + Copy(Str, Buf, P - Buf)
          end else begin
            P := StrLen + 1;
            FFormat := FFormat + Copy(Str, Buf, P - Buf) + '"';
          end;
        end;
      else
        FFormat := FFormat + UpperCase(Str[P]);
        Inc(P);
      end;
    end;
    FFormat := FFormat + ' ';
    Str := {$IFDEF VER16P}FormatSettings.{$ENDIF}LongTimeFormat;
    StrLen := Length(Str);
    P := 1;
    while P <= StrLen do begin
      case Str[P] of
        't','T': begin
          Inc(P);
          while (P <= StrLen) and ((Str[P] = 't') or (Str[P] = 'T')) do
            Inc(P);
          FFormat := FFormat + 'AM';
        end;
        'h','H': begin
          Inc(P);
          J := StrLen;
          Temp := '24';
          while J > P do begin
            case Str[J] of
              't': begin
                Temp := '12';
                break;
              end;
              'a', 'A': begin
                if (UpperCase(Copy(Str, J, 3)) = 'A/P') or
                   (UpperCase(copy(Str, J, 4)) = 'AMPM') or
                   (UpperCase(copy(Str, J, 5)) = 'AM/PM')
                then begin
                  Temp := '12';
                  break;
                end;
              end;
            end;
            Dec(J);
          end;
          if (P <= StrLen) and ((Str[P] = 'h') or (Str[P] = 'H')) then begin
            Inc(P);
            FFormat := FFormat + 'HH' + Temp;
          end else
            FFormat := FFormat + 'fmHH'+ Temp +'fm';
        end;
        'n','N','m','M': begin
          Inc(P);
          if (P <= StrLen) and ((Str[P] = 'n') or (Str[P] = 'N') or (Str[P] = 'm') or (Str[P] = 'M')) then begin
            Inc(P);
            FFormat := FFormat + 'MI';
          end else
            FFormat := FFormat + 'fmMIfm';
        end;
        's','S': begin
          Inc(P);
          if (Precision > 0) and (AnsiPos('Z', UpperCase(Str)) = 0) then begin
            Temp := {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator + 'FF'; // + IntToStr(Precision); does not work on Oracle 9.0.1
          end else
            Temp := '';
          if (P <= StrLen) and ((Str[P] = 's') or (Str[P] = 'S')) then begin
            Inc(P);
            FFormat := FFormat + 'SS' + Temp;
          end else
            FFormat := FFormat + 'fmSSfm' + Temp;
        end;
        'z','Z': begin
          FFormat := FFormat + 'FF';
          Inc(P);
          while (P <= StrLen) and ((Str[P] = 'z') or (Str[P] = 'Z')) do
            Inc(P);
        end;
        '''','"': begin
          Buf := P;
          Inc(P);
          P := Pos(Str[Buf], Copy(Str, P, StrLen - P + 1));
          if P <> 0 then begin
            Inc(P, Buf + 1);
            Str[Buf] := '"';
            Str[P - 1] := '"';
            FFormat := FFormat + Copy(Str, Buf, P - Buf)
          end else begin
            P := StrLen + 1;
            FFormat := FFormat + Copy(Str, Buf, P - Buf) + '"';
          end;
        end;
        ':': begin // LongTimeFormat always contains ":" instead of TimeSeparator (Delphi bug)
          Inc(P);
          FFormat := FFormat + {$IFDEF VER16P}FormatSettings.{$ENDIF}TimeSeparator;
        end;
      else
        if UpperCase(Copy(Str, P, 3)) = 'A/P' then begin
          FFormat := FFormat + 'AM';
          Inc(P, 3);
        end
        else if UpperCase(Copy(Str, P, 4)) = 'AMPM' then begin
          FFormat := FFormat + 'AM';
          Inc(P, 4);
        end
        else if UpperCase(Copy(Str, P, 5)) = 'AM/PM' then begin
          FFormat := FFormat + 'AM';
          Inc(P, 5);
        end
        else begin
          FFormat := FFormat + UpperCase(Str[P]);
          Inc(P);
        end;
      end;
    end;
    if FDescriptorType = OCI_DTYPE_TIMESTAMP_TZ then
      FFormat := FFormat + ' TZH:TZM';
  end
  else
    FFormat := AFormat;
end;

function TOraTimeStamp.GetAsDateTime: TDateTime;
var
  Year: smallint;
  Month, Day, Hour, Min, Sec: byte;
  FSec: cardinal;
  Date, Time: TDateTime;
begin
  if IsNull then begin // to avoid error on OCI function call
    Result := 0;
    Exit;
  end;

  GetDate(Year, Month, Day);
  GetTime(Hour, Min, Sec, FSec);
  Date := EncodeDate(Year, Month, Day);

  Time := EncodeTime(Hour, Min, Sec, 0);
  if Date < 0 then
    Result := Date - Time
  else
    Result := Date + Time;
end;

procedure TOraTimeStamp.SetAsDateTime(Value: TDateTime);
var
  Year, Month, Day, Hour, Min, Sec, FSec: word;
begin
  DecodeDate(Value, Year, Month, Day);
  DecodeTime(Value, Hour, Min, Sec, FSec);
  Construct(Year, Month, Day, Hour, Min, Sec, 0, '');
end;

{$IFNDEF FPC}
{$IFDEF VER6P}
procedure TOraTimeStamp.SetAsSQLTimeStamp(const Value: TSQLTimeStamp);
begin
  Construct(Value.Year, Value.Month, Value.Day, Value.Hour, Value.Minute, Value.Second, Value.Fractions, '');
end;

function  TOraTimeStamp.GetAsSQLTimeStamp: TSQLTimeStamp;
var
  Year: smallint;
  Month, Day, Hour, Min, Sec: byte;
  FSec: cardinal;
begin
  if IsNull then begin
    Result := NullSQLTimeStamp;
    Exit;
  end;

  GetDate(Year, Month, Day);
  GetTime(Hour, Min, Sec, FSec);

  Result.Year := Year;
  Result.Month := Month;
  Result.Day := Day;
  Result.Hour := Hour;
  Result.Minute := Min;
  Result.Second := Sec;
  Result.Fractions := FSec;
end;
{$ENDIF}
{$ENDIF}

{ TOraInterval }

constructor TOraInterval.Create(ADataType: word);
begin
  inherited Create;

  FEnvironment := nil;
  FHandleType := htLocal;

  Init(ADataType);
end;

constructor TOraInterval.Create(AOCIEnvironment: TOCIEnvironment; ADataType: word);
begin
  inherited Create;

  FEnvironment := AOCIEnvironment;
  if FEnvironment = nil then
    FHandleType := htLocal
  else begin
    FHandleType := htNative;
  {$IFNDEF AUTOREFCOUNT}
    FEnvironment.AddRef;
  {$ENDIF}
  end;

  Init(ADataType);
end;

constructor TOraInterval.Create(AOCISvcCtx: TOCISvcCtx; ADataType: word);
begin
  inherited Create;

  if AOCISvcCtx <> nil then
    FEnvironment := AOCISvcCtx.Environment
  else
    FEnvironment := nil;
  if FEnvironment = nil then
    FHandleType := htLocal
  else begin
    FHandleType := htNative;
  {$IFNDEF AUTOREFCOUNT}
    FEnvironment.AddRef;
  {$ENDIF}
  end;

  Init(ADataType);
end;

destructor TOraInterval.Destroy;
begin
  FreeInterval;
  Marshal.FreeHGlobal(FIndicator);
  Marshal.FreeHGlobal(phOCIInterval);

  if FEnvironment <> nil then begin
  {$IFNDEF AUTOREFCOUNT}
    FEnvironment.ReleaseRef;
  {$ENDIF}
    FEnvironment := nil;
  end;

  inherited;
end;

procedure TOraInterval.Init(ADataType: word);
begin
  phOCIInterval := Marshal.AllocHGlobal(sizeof(IntPtr));
  Marshal.WriteIntPtr(phOCIInterval, nil);
  FIndicator := Marshal.AllocHGlobal(sizeof(OCIInd));
  Marshal.WriteInt16(FIndicator, OCI_IND_NULL);
  hOCIInterval := nil;
  FLeadPrecision := 2;
  FFracPrecision := 6;

  case ADataType of
    dtIntervalDS:
      FDescriptorType := OCI_DTYPE_INTERVAL_DS;
    dtIntervalYM:
      FDescriptorType := OCI_DTYPE_INTERVAL_YM;
  else
    Assert(False);
  end;
end;

procedure TOraInterval.AllocInterval;
var
 Interval: pOCIInterval;
begin
  if FHandleType = htLocal then begin
    if FLocalInterval = nil then
      case FDescriptorType of
        OCI_DTYPE_INTERVAL_DS:
          FLocalInterval := TOCIIntervalDS.Create;
        OCI_DTYPE_INTERVAL_YM:
          FLocalInterval := TOCIIntervalYM.Create;
      else
        Assert(False);
      end;
  end
  else if hOCIInterval = nil then begin
    Interval := nil;
    Check(FEnvironment.Home.OCI8.OCIDescriptorAlloc(FEnvironment.hOCIEnv, Interval, FDescriptorType, 0, nil));
    hOCIInterval := Interval;
    FHandleType := htNative
  end;
end;

procedure TOraInterval.FreeInterval;
begin
  if FHandleType = htLocal then
    FreeAndNil(FLocalInterval)
  else if hOCIInterval <> nil then begin
    if FHandleType = htNative then
      Check(FEnvironment.Home.OCI8.OCIDescriptorFree(hOCIInterval, FDescriptorType));
    hOCIInterval := nil;
    Marshal.WriteInt16(FIndicator, OCI_IND_NULL);
    FHandleType := htNative;
  end;
end;

function TOraInterval.ToLocalInterval: TOCIInterval;
var
  Year, Month: integer;
  Day, Hour, Min, Sec, FSec: integer;
begin
  case FDescriptorType of
    OCI_DTYPE_INTERVAL_DS: begin
      Result := TOCIIntervalDS.Create;
      if not IsNull then begin
        GetDaySecond(Day, Hour, Min, Sec, FSec);
        TOCIIntervalDS(Result).SetDaySecond(Day, Hour, Min, Sec, FSec);
      end;
    end;
    OCI_DTYPE_INTERVAL_YM: begin
      Result := TOCIIntervalYM.Create;
      if not IsNull then begin
        GetYearMonth(Year, Month);
        TOCIIntervalYM(Result).SetYearMonth(Year, Month);
      end;
    end
  else
    Result := nil;
    Assert(False);
  end;
end;

procedure TOraInterval.FromLocalInterval(Value: TOCIInterval);
var
  Year, Month: integer;
  Day, Hour, Min, Sec, FSec: integer;
begin
  case FDescriptorType of
    OCI_DTYPE_INTERVAL_DS: begin
      if not IsNull then begin
        (Value as TOCIIntervalDS).GetDaySecond(Day, Hour, Min, Sec, FSec);
        SetDaySecond(Day, Hour, Min, Sec, FSec);
      end;
    end;
    OCI_DTYPE_INTERVAL_YM: begin
      if not IsNull then begin
        (Value as TOCIIntervalYM).GetYearMonth(Year, Month);
        SetYearMonth(Year, Month);
      end;
    end
  else
    Assert(False);
  end;
end;

procedure TOraInterval.Check(Res: sword);
begin
  {$IFDEF CLR}Devart.Odac.{$ENDIF}{$IFNDEF UNIDACPRO}OraCall{$ELSE}OraCallUni{$ENDIF}.Check(
    @FEnvironment.Home.OCI8.OCIErrorGet,
    Res,
    FEnvironment.UnicodeEnv,
    FEnvironment.hOCIError
  );
end;

procedure TOraInterval.SetEnvironment(AEnvironment: TOCIEnvironment);
var
  TempIsNull: boolean;
  TempValue: TOCIInterval;
begin
  if FEnvironment <> AEnvironment then begin
    TempIsNull := GetIsNull;
    if not TempIsNull then
      TempValue := ToLocalInterval
    else
      TempValue := nil;

    try
      FreeInterval;

    {$IFNDEF AUTOREFCOUNT}
      if FEnvironment <> nil then
        FEnvironment.ReleaseRef;
    {$ENDIF}
      FEnvironment := AEnvironment;
      if FEnvironment <> nil then begin
        FHandleType := htNative;
      {$IFNDEF AUTOREFCOUNT}
        FEnvironment.AddRef;
      {$ENDIF}
      end
      else
        FHandleType := htLocal;

      SetIsNull(TempIsNull);
      if not TempIsNull then
        FromLocalInterval(TempValue);
    finally
      TempValue.Free;
    end;
  end;
end;

procedure TOraInterval.Disconnect;
begin
  SetEnvironment(nil);
end;

procedure TOraInterval.Assign(Source: TOraInterval);
begin
  Source.AssignTo(Self);
end;

procedure TOraInterval.AssignTo(Dest: TOraInterval);

  procedure LocalAssign;
  var
    Temp: TOCIInterval;
  begin
    Temp := ToLocalInterval;
    try
      Dest.FromLocalInterval(Temp);
    finally
      Temp.Free;
    end;
  end;

begin
  Dest.DescriptorType := DescriptorType;
  Dest.AllocInterval;
  Dest.LeadPrecision := LeadPrecision;
  Dest.FracPrecision := FracPrecision;
  Marshal.WriteInt16(Dest.FIndicator, Marshal.ReadInt16(FIndicator));

  if not IsNull then
    if (Dest.FEnvironment = nil) and (FEnvironment = nil) then
      Dest.LocalInterval.Assign(LocalInterval)
    else if Dest.FEnvironment = FEnvironment then
      Check(FEnvironment.Home.OCI8.OCIIntervalAssign(FEnvironment.hOCIEnv, FEnvironment.hOCIError, OCIInterval, Dest.OCIInterval))
    else
      LocalAssign;
end;

function TOraInterval.Compare(Dest: TOraInterval): integer;

  function LocalCompare: Integer;
  var
    Interval1, Interval2: TOCIInterval;
  begin
    Interval1 := ToLocalInterval;
    try
      Interval2 := Dest.ToLocalInterval;
      try
        Result := Interval1.Compare(Interval2);
      finally
        Interval2.Free;
      end;
    finally
      Interval1.Free;
    end;
  end;

begin
  if (Dest.FEnvironment = nil) and (FEnvironment = nil) then
    if Dest.IsNull or IsNull then
      raise Exception.Create(SIntervalsIncomparable)
    else
      Result := LocalInterval.Compare(Dest.LocalInterval)
  else if Dest.FEnvironment = FEnvironment then
    Check(FEnvironment.Home.OCI8.OCIIntervalCompare(FEnvironment.hOCIEnv, FEnvironment.hOCIError, OCIInterval, Dest.OCIInterval, Result))
  else
    if Dest.IsNull or IsNull then
      raise Exception.Create(SIntervalsIncomparable)
    else
      Result := LocalCompare;
end;

function TOraInterval.GetIsNull: boolean;
var
  Indicator: OCIInd;
begin
  Indicator := Marshal.ReadInt16(FIndicator);
  Result := Indicator = OCI_IND_NULL;
end;

procedure TOraInterval.SetIsNull(Value: boolean);
begin
  if Value then
    Marshal.WriteInt16(FIndicator, OCI_IND_NULL)
  else
    Marshal.WriteInt16(FIndicator, OCI_IND_NOTNULL);
end;


procedure TOraInterval.SetDescriptorType(const Value: cardinal);
begin
  if FDescriptorType <> Value then begin
    FreeInterval;
    FDescriptorType := Value;
  end;
end;

function TOraInterval.GethOCIInterval: pOCIInterval;
begin
  Result := Marshal.ReadIntPtr(phOCIInterval);
end;

procedure TOraInterval.SethOCIInterval(Value: pOCIInterval);
begin
  Marshal.WriteIntPtr(phOCIInterval, Value);
end;

function TOraInterval.GetOCIInterval: pOCIInterval;
begin
  AllocInterval;
  Result := hOCIInterval;
end;

procedure TOraInterval.SetOCIInterval(const Value: pOCIInterval);
begin
  FreeInterval;
  hOCIInterval := Value;
  if Value <> nil then begin
    FHandleType := htShared;
    IsNull := False;
  end;
end;

function TOraInterval.GetLocalInterval: TOCIInterval;
begin
  AllocInterval;
  Result := FLocalInterval;
end;

function TOraInterval.GetOCIIntervalPtr: ppOCIInterval;
begin
  AllocInterval;
  Result := phOCIInterval;
end;

procedure TOraInterval.CheckValid;
var
  Valid: cardinal;
begin
  if FHandleType = htLocal then
    Valid := LocalInterval.Check
  else begin
    Assert(hOCIInterval <> nil);
    Valid := 0;
    Check(FEnvironment.Home.OCI8.OCIIntervalCheck(FEnvironment.hOCIEnv, FEnvironment.hOCIError, hOCIInterval, Valid));
  end;

  if Valid <> 0 then
    raise Exception.Create(SInvalidInterval);
end;

function TOraInterval.GetAsString: string;
var
  Ptr: IntPtr;
  BufSize: NativeUInt;
begin
  if IsNull then begin // to avoid error on OCI function call
    Result := '';
    Exit;
  end;

  if FHandleType = htLocal then
    Result := LocalInterval.ToString(FLeadPrecision, FFracPrecision)
  else begin
    BufSize := 255 * SizeOfCharOCI(FEnvironment.UnicodeEnv);
    Ptr := Marshal.AllocHGlobal(BufSize);
    try
      Check(FEnvironment.Home.OCI8.OCIIntervalToText(FEnvironment.hOCIEnv, FEnvironment.hOCIError, OCIInterval, LeadPrecision,
        FracPrecision, Ptr, BufSize, BufSize));
      Result := PtrToStringOCI(Ptr, BufSize, FEnvironment.UnicodeEnv);
    finally
      Marshal.FreeHGlobal(Ptr);
    end;
  end;
end;

procedure TOraInterval.SetAsString(const Value: string);
var
  p: IntPtr;
  Res, Size: integer;
begin
  if Value = '' then begin
    Marshal.WriteInt16(FIndicator, OCI_IND_NULL);
    Exit;
  end;

  if FHandleType = htLocal then
    LocalInterval.Parse(Value)
  else begin
    p := StringToHGlobalOCI(Value, Size, FEnvironment.UnicodeEnv);
    Res := FEnvironment.Home.OCI8.OCIIntervalFromText(FEnvironment.hOCIEnv, FEnvironment.hOCIError,
      p, Size, OCIInterval);
    FreeStringOCI(p, FEnvironment.UnicodeEnv);
    Check(Res);
  end;

  CheckValid;
  Marshal.WriteInt16(FIndicator, OCI_IND_NOTNULL);
end;

procedure TOraInterval.GetDaySecond(var Day, Hour, Min, Sec, FSec: integer);
begin
  if FHandleType = htLocal then
    (LocalInterval as TOCIIntervalDS).GetDaySecond(Day, Hour, Min, Sec, FSec)
  else
    Check(FEnvironment.Home.OCI8.OCIIntervalGetDaySecond(FEnvironment.hOCIEnv, FEnvironment.hOCIError, Day, Hour, Min, Sec, FSec, OCIInterval));
end;

procedure TOraInterval.InitInterval;
var
  i: int64;
  pNum: IntPtr;
begin
  if FHandleType = htLocal then begin
    // Empty
  end
  else begin
    // Need to correctly initialize OCIInterval before SetDaySecond or SetYearMonth call.
    i := 0;
    pNum := Marshal.AllocHGlobal(OCI_NUMBER_SIZE);
    try
      Check(FEnvironment.Home.OCI8.OCINumberFromInt(FEnvironment.hOCIError, i, SizeOf(i), OCI_NUMBER_UNSIGNED, pNum));
      Check(FEnvironment.Home.OCI8.OCIIntervalFromNumber(FEnvironment.hOCIEnv, FEnvironment.hOCIError, OCIInterval, pNum));
    finally
      Marshal.FreeHGlobal(pNum);
    end;
  end;
end;

procedure TOraInterval.SetDaySecond(Day, Hour, Min, Sec, FSec: integer);
begin
  if FHandleType = htLocal then
    (LocalInterval as TOCIIntervalDS).SetDaySecond(Day, Hour, Min, Sec, FSec)
  else begin
    InitInterval;
    Check(FEnvironment.Home.OCI8.OCIIntervalSetDaySecond(FEnvironment.hOCIEnv, FEnvironment.hOCIError, Day, Hour, Min, Sec, FSec, OCIInterval));
  end;

  Marshal.WriteInt16(FIndicator, OCI_IND_NOTNULL);
end;

procedure TOraInterval.GetYearMonth(var Year, Month: integer);
begin
  if FHandleType = htLocal then
    (LocalInterval as TOCIIntervalYM).GetYearMonth(Year, Month)
  else
    Check(FEnvironment.Home.OCI8.OCIIntervalGetYearMonth(FEnvironment.hOCIEnv, FEnvironment.hOCIError, Year, Month, OCIInterval));
end;

procedure TOraInterval.SetYearMonth(Year, Month: integer);
begin
  if FHandleType = htLocal then
    (LocalInterval as TOCIIntervalYM).SetYearMonth(Year, Month)
  else begin
    InitInterval;
    Check(FEnvironment.Home.OCI8.OCIIntervalSetYearMonth(FEnvironment.hOCIEnv, FEnvironment.hOCIError, Year, Month, OCIInterval));
  end;

  Marshal.WriteInt16(FIndicator, OCI_IND_NOTNULL);
end;

{ TOraNumber }

constructor TOraNumber.Create;
begin
  inherited Create;

  FEnvironment := nil;
  FHandleType := htLocal;

  Init;
end;

constructor TOraNumber.Create(AOCIEnvironment: TOCIEnvironment);
begin
  inherited Create;

  FEnvironment := AOCIEnvironment;

  if FEnvironment = nil then
    FHandleType := htLocal
  else begin
    FHandleType := htNative;
  {$IFNDEF AUTOREFCOUNT}
    FEnvironment.AddRef;
  {$ENDIF}
  end;

  Init;
end;

constructor TOraNumber.Create(AOCISvcCtx: TOCISvcCtx);
begin
  inherited Create;

  if AOCISvcCtx <> nil then
    FEnvironment := AOCISvcCtx.Environment
  else
    FEnvironment := nil;

  if FEnvironment = nil then
    FHandleType := htLocal
  else begin
    FHandleType := htNative;
  {$IFNDEF AUTOREFCOUNT}
    FEnvironment.AddRef;
  {$ENDIF}
  end;

  Init;
end;

destructor TOraNumber.Destroy;
begin
  Marshal.FreeHGlobal(FIndicator);
  if FHandleType <> htShared then //To support SetOCINumberPtr assignation
    Marshal.FreeHGlobal(phOCINumber);

  if FHandleType <> htLocal then begin
  {$IFNDEF AUTOREFCOUNT}
    FEnvironment.ReleaseRef;
  {$ENDIF}
    FEnvironment := nil;
  end;

  inherited;
end;

procedure TOraNumber.Init;
begin
  phOCINumber := Marshal.AllocHGlobal(OCI_NUMBER_SIZE);
  FillChar(phOCINumber, OCI_NUMBER_SIZE, 0);
  FIndicator := Marshal.AllocHGlobal(sizeof(OCIInd));
  IsNull := True;
end;

procedure TOraNumber.SetEnvironment(AEnvironment: TOCIEnvironment);
begin
  if FEnvironment <> AEnvironment then begin
  {$IFNDEF AUTOREFCOUNT}
    if FEnvironment <> nil then
      FEnvironment.ReleaseRef;
  {$ENDIF}
    FEnvironment := AEnvironment;
    if FEnvironment <> nil then begin
      FHandleType := htNative;
    {$IFNDEF AUTOREFCOUNT}
      FEnvironment.AddRef;
    {$ENDIF}
    end
    else
      FHandleType := htLocal;
  end;
end;

procedure TOraNumber.Disconnect;
begin
  SetEnvironment(nil);
end;

procedure TOraNumber.Assign(Source: TOraNumber);
begin
  Source.AssignTo(Self);
end;

procedure TOraNumber.AssignTo(Dest: TOraNumber);
begin
  Dest.IsNull := IsNull;

  if not IsNull then
    if (Dest.FEnvironment = nil) and (FEnvironment = nil) then
      CopyBuffer(phOCINumber, Dest.phOCINumber, OCI_NUMBER_SIZE)
    else if Dest.FEnvironment = FEnvironment then
      Check(FEnvironment.Home.OCI8.OCINumberAssign(FEnvironment.hOCIError, OCINumberPtr, Dest.OCINumberPtr))
    else
      CopyBuffer(phOCINumber, Dest.phOCINumber, OCI_NUMBER_SIZE);
end;

function TOraNumber.Compare(Dest: TOraNumber): integer;

  function LocalCompare: Integer;
  var
    Number1, Number2: TBytes;
  begin
    SetLength(Number1, Marshal.ReadByte(phOCINumber));
    Marshal.Copy(PtrOffset(phOCINumber, 1), Number1, 0, Length(Number1));
    SetLength(Number2, Marshal.ReadByte(Dest.phOCINumber));
    Marshal.Copy(PtrOffset(Dest.phOCINumber, 1), Number2, 0, Length(Number2));
    Result := TOCINumber.Compare(Number1, Number2);
  end;

begin
  if (Dest.FEnvironment = nil) and (FEnvironment = nil) then
    Result := LocalCompare
  else if Dest.FEnvironment = FEnvironment then
    Check(FEnvironment.Home.OCI8.OCINumberCmp(FEnvironment.hOCIError, OCINumberPtr, Dest.OCINumberPtr, Result))
  else
    Result := LocalCompare;
end;

function TOraNumber.GetOCINumberPtr: pOCINumber;
begin
  Result := phOCINumber;
end;

procedure TOraNumber.SetOCINumberPtr(Value: pOCINumber);
begin
  if Value <> phOCINumber then begin
    if FHandleType <> htShared then
      Marshal.FreeHGlobal(phOCINumber);
    FHandleType := htShared;
    phOCINumber := Value;
    IsNull := False;
  end;
end;

const
  MAX_NUMBER_TEXT_SIZE = 64;
  SNlsParams = 'NLS_NUMERIC_CHARACTERS=''%s%s''';

function TOraNumber.GetOCINumber: OCINumber;
begin
{$IFDEF CLR}
  Marshal.Copy(phOCINumber, TBytes(Result.OCINumberPart), 0, OCI_NUMBER_SIZE);
{$ELSE}
  Move(phOCINumber^, Result.OCINumberPart[0], OCI_NUMBER_SIZE);
{$ENDIF}
end;

procedure TOraNumber.SetOCINumber(Value: OCINumber);
begin
{$IFDEF CLR}
  Marshal.Copy(TBytes(Value.OCINumberPart), 0, phOCINumber, OCI_NUMBER_SIZE);
{$ELSE}
  Move(Value.OCINumberPart[0], phOCINumber^, OCI_NUMBER_SIZE);
{$ENDIF}
  IsNull := False;
end;

function TOraNumber.GetAsString: string;
var
  BufSize: cardinal;
  NlsParams: string;
  Ptr, pF, pN: IntPtr;
  FSize, NSize: integer;
  b: byte;
  Num: TBytes;
begin
  Result := '';
  if IsNull then
    Exit;

  if FHandleType <> htLocal then
    if FEnvironment.Home.OCIVersion < 8100 then begin
      Result := FormatFloat('0.#', GetAsFloat);
      Exit;
    end;

  b := Marshal.ReadByte(OCINumberPtr);
  if b = 1 then begin
    b := Marshal.ReadByte(OCINumberPtr, 1);
    if b = $00 then begin
      Result := '-~';
      exit;
    end;
  end
  else if b = 2 then begin
    b := Marshal.ReadByte(OCINumberPtr, 1);
    if b = $FF then begin
      b := Marshal.ReadByte(OCINumberPtr, 2);
      if b = $65 then begin
        Result := '~';
        exit;
      end;
    end;
  end;

  if FHandleType = htLocal then begin
    SetLength(Num, Marshal.ReadByte(phOCINumber));
    Marshal.Copy(PtrOffset(phOCINumber, 1), Num, 0, Length(Num));
    Result := TOCINumber.ToString(Num, 'TM9')
  end
  else begin
    NlsParams := Format(SNlsParams, [{$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator, {$IFDEF VER16P}FormatSettings.{$ENDIF}ThousandSeparator]);

    BufSize := MAX_NUMBER_TEXT_SIZE * SizeOfCharOCI(FEnvironment.UnicodeEnv);
    Ptr := Marshal.AllocHGlobal(BufSize);
    pF := StringToHGlobalOCI('TM9', FSize, FEnvironment.UnicodeEnv);
    pN := StringToHGlobalOCI(NlsParams, NSize, FEnvironment.UnicodeEnv);
    try
      Check(FEnvironment.Home.OCI8.OCINumberToText(FEnvironment.hOCIError, OCINumberPtr, pF, FSize, pN, NSize, BufSize, Ptr));
      Result := PtrToStringOCI(Ptr, BufSize, FEnvironment.UnicodeEnv);
    finally
      Marshal.FreeHGlobal(Ptr);
      FreeStringOCI(pF, FEnvironment.UnicodeEnv);
      FreeStringOCI(pN, FEnvironment.UnicodeEnv);
    end;
  end;

  if Length(Result) > 0 then begin
    if (Result[1] = {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator) then
      Result := '0' + Result
    else
      if (Result[1] = '-') and (Result[2] = {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator) then
        Result := '-0' + Copy(Result, 2, MaxInt)
  end;
end;

procedure TOraNumber.SetAsString(const Value: string);
var
  FormatStr: string;
  NlsParams: string;

  function GetFormatString: string;
  const
    SScientificFormat = '9D99999999999999999999999999999999999999999EEEE';
  var
    i: integer;
    Signed: boolean;
    FractionalPart: boolean;
    HasDigits: boolean;
  begin
    if Length(Value) > 0 then begin
      SetLength(Result, Length(Value));

      Signed := (Value[1] = '+') or (Value[1] = '-');
      FractionalPart := False;
      HasDigits := False;

      if Signed then begin
        Result[1] := 'S';
        i := 2;
      end
      else
        i := 1;

      while i <= Length(Value) do begin
        if (Value[i] = {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator) and not FractionalPart then begin
          Result[i] := 'D';
          FractionalPart := True;
        end
        else
        if (Value[i] = {$IFDEF VER16P}FormatSettings.{$ENDIF}ThousandSeparator) and HasDigits and not FractionalPart then
          Result[i] := 'G'
        else
        if (Value[i] = 'e') or (Value[i] = 'E') then begin
          if Signed then
            Result := 'S' + SScientificFormat
          else
            Result := SScientificFormat;
          Exit;
        end
        else begin
          Result[i] := '9';
          HasDigits := True;
        end;
        Inc(i);
      end;
      if Length(Result) >= MAX_NUMBER_TEXT_SIZE then
        if Signed then
          SetLength(Result, MAX_NUMBER_TEXT_SIZE)
        else
          SetLength(Result, MAX_NUMBER_TEXT_SIZE - 1);
    end
    else
      Result := '';
  end;

var
  pV, pF, pN: IntPtr;
  Res, VSize, FSize, NSize: integer;
  Num: TBytes;
begin
  if Value = '' then begin
    Marshal.WriteInt16(FIndicator, OCI_IND_NULL);
    Exit;
  end;

  if Value = '-~' then begin
    Marshal.WriteByte(OCINumberPtr, 1);
    Marshal.WriteByte(OCINumberPtr, 1, $00);
    IsNull := False;
    exit;
  end
  else if Value = '~' then begin
    Marshal.WriteByte(OCINumberPtr, 2);
    Marshal.WriteByte(OCINumberPtr, 1, $FF);
    Marshal.WriteByte(OCINumberPtr, 2, $65);
    IsNull := False;
    exit;
  end;

  FillChar(OCINumberPtr, sizeof(OCI_NUMBER_SIZE), 0);
  FormatStr := GetFormatString;
  if FHandleType = htLocal then begin
    TOCINumber.Parse(Value, FormatStr, Num);
    Marshal.WriteByte(phOCINumber, Length(Num));
    Marshal.Copy(Num, 0, PtrOffset(phOCINumber, 1), Length(Num));
  end
  else begin
    NlsParams := Format(SNlsParams, [{$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator, {$IFDEF VER16P}FormatSettings.{$ENDIF}ThousandSeparator]);

    pV := StringToHGlobalOCI(Value, VSize, FEnvironment.UnicodeEnv);
    pF := StringToHGlobalOCI(FormatStr, FSize, FEnvironment.UnicodeEnv);
    pN := StringToHGlobalOCI(NlsParams, NSize, FEnvironment.UnicodeEnv);
    Res := FEnvironment.Home.OCI8.OCINumberFromText(FEnvironment.hOCIError, pV, VSize, pF, FSize, pN, NSize, OCINumberPtr);
    FreeStringOCI(pV, FEnvironment.UnicodeEnv);
    FreeStringOCI(pF, FEnvironment.UnicodeEnv);
    FreeStringOCI(pN, FEnvironment.UnicodeEnv);
    Check(Res);
  end;

  IsNull := False;
end;

function TOraNumber.GetAsInteger: integer;
begin
  Result := Integer(GetAsLargeInt);
end;

procedure TOraNumber.SetAsInteger(const Value: integer);
begin
  SetAsLargeInt(Value);
end;

function TOraNumber.GetAsLargeInt: int64;
var
  Num: TBytes;
begin
  if IsNull then
    Result := 0
  else if FHandleType = htLocal then begin
    SetLength(Num, Marshal.ReadByte(phOCINumber));
    Marshal.Copy(PtrOffset(phOCINumber, 1), Num, 0, Length(Num));
    Result := TOCINumber.ToInt(Num, sizeof(int64), OCI_NUMBER_SIGNED);
  end
  else
    Check(FEnvironment.Home.OCI8.OCINumberToInt(FEnvironment.hOCIError, OCINumberPtr, sizeof(int64), OCI_NUMBER_SIGNED, Result));
end;

procedure TOraNumber.SetAsLargeInt(const Value: int64);
var
  Val: int64;
  Num: TBytes;
begin
  SetLength(Num, 0); // to avoid warning

  if FHandleType = htLocal then begin
    Num := TOCINumber.FromInt(Value, sizeof(int64), OCI_NUMBER_SIGNED);
    Marshal.WriteByte(phOCINumber, Length(Num));
    Marshal.Copy(Num, 0, PtrOffset(phOCINumber, 1), Length(Num));
  end
  else begin
    Val := Value;
    Check(FEnvironment.Home.OCI8.OCINumberFromInt(FEnvironment.hOCIError, Val, sizeof(int64), OCI_NUMBER_SIGNED, OCINumberPtr));
  end;

  IsNull := False;
end;

function TOraNumber.GetAsFloat: double;
var
  Num: TBytes;
begin
  if IsNull then
    Result := 0
  else if FHandleType = htLocal then begin
    SetLength(Num, Marshal.ReadByte(phOCINumber));
    Marshal.Copy(PtrOffset(phOCINumber, 1), Num, 0, Length(Num));
    Result := TOCINumber.ToReal(Num, sizeof(double));
  end
  else
    Check(FEnvironment.Home.OCI8.OCINumberToReal(FEnvironment.hOCIError, OCINumberPtr, sizeof(double), Result));
end;

procedure TOraNumber.SetAsFloat(const Value: double);
var
  Val: double;
  Num: TBytes;
begin
  SetLength(Num, 0); // to avoid warning

  if FHandleType = htLocal then begin
    Num := TOCINumber.FromReal(Value, sizeof(double));
    Marshal.WriteByte(phOCINumber, Length(Num));
    Marshal.Copy(Num, 0, PtrOffset(phOCINumber, 1), Length(Num));
  end
  else begin
    Val := Value;
    Check(FEnvironment.Home.OCI8.OCINumberFromReal(FEnvironment.hOCIError, Val, sizeof(double), OCINumberPtr));
  end;

  IsNull := False;
end;

{$IFDEF VER6P}
function TOraNumber.GetAsBCD: TBCD;
{$IFDEF CLR}
var
  Val: TBytes;
{$ENDIF}
begin
  if IsNull then
    Result := NullBcd
  else begin
  {$IFDEF CLR}
    SetLength(Val, SizeOfTBCD);
    OCINumberToBCD(OCINumberPtr, Val);
    Result := TBcd.FromBytes(Val);
  {$ELSE}
    OCINumberToBCD(OCINumberPtr, Result);
  {$ENDIF}
  end;
end;

procedure TOraNumber.SetAsBCD(const Value: TBCD);
// OCINumberFromBCD causes problems in OCI
(*{$IFDEF NET}
var
  Val: TBytes;
{$ENDIF}*)
begin
//{$IFNDEF NET}
  AsString := BcdToStr(Value);
(*{$ELSE}
{$IFDEF CLR}
  Val := TBcd.ToBytes(Value);
{$ELSE}
  SetLength(Val, SizeOfTBCD);
  Move(Value, Val[0], SizeOfTBCD);
{$ENDIF}
  Check(OCINumberFromBCD(OCISvcCtx.hOCIError, Val, SizeOfTBCD, OCINumberPtr));
{$ENDIF}*)
  IsNull := False;
end;
{$ENDIF}

function TOraNumber.GetIsNull: boolean;
begin
  Result := Marshal.ReadInt16(FIndicator) = OCI_IND_NULL;
end;

procedure TOraNumber.SetIsNull(Value: boolean);
begin
  if Value then
    Marshal.WriteInt16(FIndicator, OCI_IND_NULL)
  else
    Marshal.WriteInt16(FIndicator, OCI_IND_NOTNULL);
end;

procedure TOraNumber.Check(Res: sword);
begin
  {$IFDEF CLR}Devart.Odac.{$ENDIF}{$IFNDEF UNIDACPRO}OraCall{$ELSE}OraCallUni{$ENDIF}.Check(
    @FEnvironment.Home.OCI8.OCIErrorGet,
    Res,
    FEnvironment.UnicodeEnv,
    FEnvironment.hOCIError
  );
end;

{TOCITransaction}

constructor TOCITransaction.Create;
begin
  inherited;
end;

destructor TOCITransaction.Destroy;
begin
{$IFNDEF LITE}
  if FXID <> nil then
    Marshal.FreeHGlobal(FXID);
{$ENDIF}

  inherited;
end;

procedure TOCITransaction.Check(Status: sword; Connection: TOCIConnection);
begin
  if Status <> OCI_SUCCESS then
      Connection.OraError(Connection.OCICallStyle, Status, True, Component);
end;

procedure TOCITransaction.OraError(OCISvcCtx: TOCISvcCtx; var ErrorCode: sword; UseCallback: boolean);
var
  Msg: string;
  Code: sword;
  Fail: boolean;
begin
  Code := OCISvcCtx.OCI8.GetOraError(ErrorCode, OCISvcCtx, Msg);
  if (ErrorCode = OCI_SUCCESS_WITH_INFO) and (Code <> 24344) then  // except compilation error
    Exit;
  ErrorCode := Code;

  try
    raise EOraError.Create(ErrorCode, Msg);
  except
    on E: EOraError do begin
      Fail := True;
      if UseCallback then
        if Assigned(FOnError) then
          FOnError(E, Fail);
      if Fail then
        raise
      else
        Abort;
    end;
  end;
end;

function TOCITransaction.SetProp(Prop: integer; const Value: variant): boolean;
begin
{$IFNDEF LITE}
  Result := True;
  case Prop of
    prInactiveTimeout:
      FInactiveTimeout := Value;
    prResumeTimeout:
      FResumeTimeout := Value;
    prTransactionName:
      FTransactionName := Value;
    prTransactionResume:
      FResume := Value;
    prRollbackSegment:
      FRollbackSegment := Value;
  else
    Result := inherited SetProp(Prop, Value);
  end;
{$ELSE}
  Result := inherited SetProp(Prop, Value);
{$ENDIF}
end;

function TOCITransaction.GetProp(Prop: integer; var Value: variant): boolean;
begin
  Result := inherited SetProp(Prop, Value);
end;

{$IFNDEF LITE}
procedure TOCITransaction.SetTransactionId(TransactionId: TBytes);
begin
  FTransactionId := Copy(TransactionId, 0, Length(TransactionId));
end;

procedure TOCITransaction.SetBranchQualifier(Index: integer; BranchQualifier: TBytes);
begin
  if Length(FTransactionLinks) <= Index then
    SetLength(FTransactionLinks, Index + 1);
  FTransactionLinks[Index].BranchQualifier := Copy(BranchQualifier, 0, Length(BranchQualifier));
end;

procedure TOCITransaction.WriteTransactionId;
var
  i, GtridLen: integer;
begin
  GtridLen := Length(FTransactionId);
  if GtridLen > MaxTransactionIdLength then
    raise Exception.CreateFmt(STransactionIdTooLong, ['TransactionId']);

  if FXID = nil then
    FXID := Marshal.AllocHGlobal(XID_SIZE);

  Marshal.WriteInt32(FXID, 0, 0);        // FormatID
  Marshal.WriteInt32(FXID, 4, GtridLen); // Gtrid_length
  for i := 0 to GtridLen - 1 do
    Marshal.WriteByte(FXID, 12 + i, FTransactionId[i]);
end;

procedure TOCITransaction.WriteBranchQualifier(TransactionLink: TTransactionLink);
var
  BranchQualifier: TBytes;
  i, GtridLen, BqualLen: integer;
begin
  BranchQualifier := TransactionLink.BranchQualifier;
  BqualLen := Length(BranchQualifier);
  if BqualLen > MaxTransactionIdLength then
    raise Exception.CreateFmt(STransactionIdTooLong, ['BranchQualifier']);

  Marshal.WriteInt32(FXID, 8, BqualLen); // Bqual_length
  GtridLen := Length(FTransactionId);
  for i := 0 to BqualLen - 1 do
    Marshal.WriteByte(FXID, 12 + GtridLen + i, BranchQualifier[i]);
end;

procedure TOCITransaction.FreeTransaction;
var
  i: integer;
  Connection: TOCIConnection;
begin
  for i := 0 to FConnections.Count - 1 do begin
    Connection := TOCIConnection(FConnections[i]);
    if FTransactionLinks[i].State = tsFinished then begin
      Check(Connection.OCI8.OCIAttrSet1(Connection.OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX,
        nil, 0, OCI_ATTR_TRANS, Connection.OCISvcCtx.hOCIError), Connection);
      Check(Connection.OCI8.OCIHandleFree(FTransactionLinks[i].OCITrans, OCI_HTYPE_TRANS), Connection);
      FTransactionLinks[i].State := tsInactive;
    end;
  end;
  FActive := False;
end;
{$ENDIF}

procedure TOCITransaction.StartTransactionLocal;
{$IFNDEF LITE}
var
  S: string;
  Connection: TOCIConnection;
  Command: TOCICommand;
{$ENDIF}
begin
  CommitLocal;

{$IFNDEF LITE}
  Connection := TOCIConnection(FConnections[0]);
  Command := Connection.GetCommand;

  if FRollbackSegment <> '' then begin
    S := 'SET TRANSACTION USE ROLLBACK SEGMENT '+ FRollbackSegment;
    if FTransactionName <> '' then
      S := S + ' NAME ''' + FTransactionName + '''';
    Command.SetSQL('begin ' + S + '; end;');
    Command.Execute;
  end;

  if FReadOnly then begin
    S := 'SET TRANSACTION READ ONLY';
    if FTransactionName <> '' then
      S := S + ' NAME ''' + FTransactionName + '''';
    Command.SetSQL('begin ' + S + '; end;');
    Command.Execute;
  end
  else
  if FIsolationLevel = ilSnapshot then begin
    S := 'SET TRANSACTION ISOLATION LEVEL SERIALIZABLE';
    if FTransactionName <> '' then
      S := S + ' NAME ''' + FTransactionName + '''';
    Command.SetSQL('begin ' + S + '; end;');
    Command.Execute;
  end
  else
  if not (FIsolationLevel = ilReadCommitted) then
    RaiseError(SUnsupportedIsolationLevel);

  if (FIsolationLevel = ilReadCommitted) and (FRollbackSegment = '') and
    (FTransactionName <> '')
  then begin
    Command.SetSQL('begin SET TRANSACTION NAME ''' + FTransactionName + '''; end;');
    Command.Execute;
  end;
{$ENDIF}

  FLocalTransactionId := LocalTransactionId(True); //Server side transaction starts here
  FActive := True;
  FNativeTransaction := True;
end;

procedure TOCITransaction.CommitLocal;
var
  Connection: TOCIConnection;
begin
  Connection := TOCIConnection(FConnections[0]);
  Connection.BusyWait;
  try
    FLocalTransactionId := '';
    FActive := False;
    if FNativeTransaction then begin
      if Connection.OCISvcCtx.Home.OCICallStyle = OCI73 then begin
        Check(Connection.OCI7.ocom(Connection.LDA), Connection);
      end
      else
      if Connection.OCISvcCtx.Home.OCICallStyle = OCI80 then begin
        Check(Connection.OCI8.OCITransCommit(Connection.OCISvcCtx.hOCISvcCtx, Connection.OCISvcCtx.hOCIError, OCI_DEFAULT), Connection);
      end
      else
        Connection.OCISvcCtx.Home.CheckOCI;
    end;
    FNativeTransaction := True;
  finally
    Connection.Release;
  end;
end;

procedure TOCITransaction.RollbackLocal;
var
  Connection: TOCIConnection;
begin
  Connection := TOCIConnection(FConnections[0]);
  FLocalTransactionId := '';
  FActive := False;
  if FNativeTransaction then begin
    if Connection.OCISvcCtx.Home.OCICallStyle = OCI73 then begin
      Check(Connection.OCI7.orol(Connection.LDA), Connection);
    end
    else
    if Connection.OCISvcCtx.Home.OCICallStyle = OCI80 then begin
      Check(Connection.OCI8.OCITransRollback(Connection.OCISvcCtx.hOCISvcCtx, Connection.OCISvcCtx.hOCIError, OCI_DEFAULT), Connection);
    end
    else
      Connection.OCISvcCtx.Home.CheckOCI;
  end;
  FNativeTransaction := True;
end;

procedure TOCITransaction.Savepoint(const Name: string);
var
  Connection: TOCIConnection;
  Command: TOCICommand;
  i: integer;
begin
  for i := 0 to FConnections.Count - 1 do begin
    Connection := TOCIConnection(FConnections[i]);
    Command := Connection.GetCommand;
    Command.SetSQL('SAVEPOINT ' + Name);
    Command.Execute;
  end;
end;

procedure TOCITransaction.RollbackToSavepoint(const Name: string);
var
  Connection: TOCIConnection;
  Command: TOCICommand;
  i: integer;
begin
  for i := 0 to FConnections.Count - 1 do begin
    Connection := TOCIConnection(FConnections[i]);
    Command := Connection.GetCommand;
    Command.SetSQL('ROLLBACK TO SAVEPOINT ' + Name);
    Command.Execute;
  end;
end;

function TOCITransaction.DetectInTransaction(CanActivate: boolean): boolean;
var
  NewID: string;
begin
  if not FActive then begin
    if CanActivate then begin
      FLocalTransactionId := LocalTransactionId;
      FActive := FLocalTransactionId <> '';
    end;
  end
  else
  if FLocalTransactionId <> '' then begin
    NewID := LocalTransactionId;
    FActive := NewID = FLocalTransactionId;
    if not FActive then begin
      // transaction was implicitly ended (by server-side logic)
      FLocalTransactionId := '';
    end;
  end;
  Result := FActive;
end;

procedure TOCITransaction.AssignConnect(Source: TCRTransaction);
begin
  inherited;

  FLocalTransactionId := TOCITransaction(Source).FLocalTransactionId;
end;

function TOCITransaction.LocalTransactionId(CreateTransaction: boolean = False): string;
var
  SqlLine: string;
  Connection: TOCIConnection;
  Command: TOCICommand;
begin
  //we couldn't use here SQL couse of recursive calls in AfterExecute in DisconnectedMode
  Connection := TOCIConnection(FConnections[0]);
  // Connection.BusyWait - fix bug with multi thread applications
  Connection.BusyWait;
  try
    Command := Connection.GetCommand;
    SqlLine := '  :result := sys.dbms_transaction.local_transaction_id';
    if CreateTransaction then
      SqlLine := SqlLine + '(true)'; //call local_transaction_id(true) - to create transaction if there is no any
    SqlLine := SqlLine + '; ';
    Command.SetSQL('begin' + SqlLine + 'end;');
    with TOraParamDesc(Command.GetParam(0)) do begin
      SetDataType(dtString);
      SetParamType(pdOutput);
      SetSize(4000);
    end;
    Command.Execute;

    Result := TOraParamDesc(Command.GetParam(0)).GetItemAsString(1);
  finally
    Connection.Release;
  end;
end;

procedure TOCITransaction.StartTransaction;
{$IFNDEF LITE}
var
  i, Size, Res: integer;
  TransactionFlags: integer;
  Connection: TOCIConnection;
  p: IntPtr;
{$ENDIF}
begin
{$IFNDEF LITE}
  if FConnections.Count = 0 then
    raise Exception.Create(SNoConnectionsInTransaction);

  if (FConnections.Count > 1) and (FTransactionName = '') and (FTransactionId = nil) then
    raise Exception.Create(SCannotStartTransactionWithoutId);

  for i := 0 to FConnections.Count - 1 do
    if not FConnections[i].GetConnected then
      raise Exception.Create(SConnectionInTransactionNotActive);

  if (FConnections.Count = 1) and (FTransactionId = nil) then begin
{$ENDIF}
    StartTransactionLocal;
{$IFNDEF LITE}
    exit;
  end;

  CheckInactive;

  SetLength(FTransactionLinks, FConnections.Count);

  if FTransactionId <> nil then
    WriteTransactionId;

  if FReadOnly then begin
    TransactionFlags := OCI_TRANS_READONLY;
  end
  else
    case FIsolationLevel of
      ilReadCommitted:
        TransactionFlags := OCI_TRANS_READWRITE;
      ilSnapshot:
        TransactionFlags := OCI_TRANS_SERIALIZABLE;
    else
      raise Exception.Create(SUnsupportedIsolationLevel);
    end;

  FActive := True;
  FLocalTransactionId := '';
  try
    for i := 0 to FConnections.Count - 1 do begin
      Connection := TOCIConnection(FConnections[i]);

      if (Connection.OCISvcCtx.Home.OCICallStyle = OCI80) and not (OCI73 in Connection.OCISvcCtx.Home.PossibleOCICallStyles) then
        raise Exception.Create(STransactionNotSupportedWithDirect);

      Connection.OCISvcCtx.Home.CheckOCI80;

      with FTransactionLinks[i] do begin
        Check(Connection.OCI8.OCIHandleAlloc(Connection.OCISvcCtx.hOCIEnv, OCITrans, OCI_HTYPE_TRANS, 0, nil), Connection);
        try
          if FTransactionId <> nil then begin
            WriteBranchQualifier(FTransactionLinks[i]);
            Check(Connection.OCI8.OCIAttrSet1(OCITrans, OCI_HTYPE_TRANS,
              FXID, XID_SIZE, OCI_ATTR_XID, Connection.OCISvcCtx.hOCIError), Connection);
          end
          else
            if FTransactionName <> '' then begin
              p := StringToHGlobalOCI(FTransactionName, Size, Connection.OCISvcCtx.UnicodeEnv);
              Res := Connection.OCI8.OCIAttrSet1(OCITrans, OCI_HTYPE_TRANS, p, Size, OCI_ATTR_TRANS_NAME, Connection.OCISvcCtx.hOCIError);
              FreeStringOCI(p, Connection.OCISvcCtx.UnicodeEnv);
              Check(Res, Connection);
            end;

            Check(Connection.OCI8.OCIAttrSet1(Connection.OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX,
              OCITrans, 0, OCI_ATTR_TRANS, Connection.OCISvcCtx.hOCIError), Connection);

          if FResume then
            Check(Connection.OCI8.OCITransStart(Connection.OCISvcCtx.hOCISvcCtx, Connection.OCISvcCtx.hOCIError, FResumeTimeOut,
              TransactionFlags or OCI_TRANS_RESUME), Connection)
          else
            Check(Connection.OCI8.OCITransStart(Connection.OCISvcCtx.hOCISvcCtx, Connection.OCISvcCtx.hOCIError, FInactiveTimeOut,
              TransactionFlags or OCI_TRANS_NEW), Connection);
        except
          Check(Connection.OCI8.OCIAttrSet1(Connection.OCISvcCtx.hOCISvcCtx, OCI_HTYPE_SVCCTX,
            nil, 0, OCI_ATTR_TRANS, Connection.OCISvcCtx.hOCIError), Connection);

          Check(Connection.OCI8.OCIHandleFree(OCITrans, OCI_HTYPE_TRANS), Connection);
          raise;
        end;
        State := tsActive;
      end;
    end;
  except // detach or rollback successfully started branches
    if FResume then
      Detach
    else
      Rollback;
    raise;
  end;
{$ENDIF}
end;

procedure TOCITransaction.Commit;
{$IFNDEF LITE}
var
  i, Status: integer;
  Connection: TOCIConnection;
{$ENDIF}
begin
{$IFNDEF LITE}
  if (FConnections.Count = 1) and (FTransactionId = nil) then begin
{$ENDIF}
    CommitLocal;
{$IFNDEF LITE}
    exit;
  end;

  CheckActive;

  if FConnections.Count > 1 then begin
    for i := 0 to FConnections.Count - 1 do begin
      Connection := TOCIConnection(FConnections[i]);
      if FTransactionLinks[i].State = tsActive then begin
        Status := Connection.OCI8.OCITransPrepare(Connection.OCISvcCtx.hOCISvcCtx, Connection.OCISvcCtx.hOCIError, OCI_DEFAULT);
        case Status of
          OCI_SUCCESS:
            FTransactionLinks[i].State := tsPrepared;
          OCI_SUCCESS_WITH_INFO:
            FTransactionLinks[i].State := tsFinished;
          else begin
            RollBack;
            Check(Status, Connection);
          end;
        end;
      end;
    end;
    for i := 0 to FConnections.Count - 1 do begin
      Connection := TOCIConnection(FConnections[i]);
      if FTransactionLinks[i].State = tsPrepared then begin
        Check(Connection.OCI8.OCITransCommit(Connection.OCISvcCtx.hOCISvcCtx, Connection.OCISvcCtx.hOCIError, OCI_TRANS_TWOPHASE), Connection);
        FTransactionLinks[i].State := tsFinished;
      end;
    end;
  end
  else begin
    Connection := TOCIConnection(FConnections[0]);
    if FTransactionLinks[0].State = tsActive then begin
      Check(Connection.OCI8.OCITransCommit(Connection.OCISvcCtx.hOCISvcCtx, Connection.OCISvcCtx.hOCIError, OCI_DEFAULT), Connection);
      FTransactionLinks[0].State := tsFinished;
    end;
  end;

  FreeTransaction;
{$ENDIF}
end;

procedure TOCITransaction.Rollback;
{$IFNDEF LITE}
var
  i: integer;
  Connection: TOCIConnection;
{$ENDIF}
begin
{$IFNDEF LITE}
  if (FConnections.Count = 1) and (FTransactionId = nil) then begin
{$ENDIF}
    RollbackLocal;
{$IFNDEF LITE}
    exit;
  end;

  CheckActive;

  for i := 0 to FConnections.Count - 1 do begin
    Connection := TOCIConnection(FConnections[i]);
    if FTransactionLinks[i].State in [tsActive, tsPrepared] then begin
      Check(Connection.OCI8.OCITransRollback(Connection.OCISvcCtx.hOCISvcCtx, Connection.OCISvcCtx.hOCIError, OCI_DEFAULT), Connection);
      FTransactionLinks[i].State := tsFinished;
    end;
  end;

  FreeTransaction;
{$ENDIF}
end;

{$IFNDEF LITE}
procedure TOCITransaction.Detach;
var
  Connection: TOCIConnection;
  i: integer;
begin
  CheckActive;

  for i := 0 to FConnections.Count - 1 do begin
    Connection := TOCIConnection(FConnections[i]);
    if FTransactionLinks[i].State = tsActive then begin
      Check(Connection.OCI8.OCITransDetach(Connection.OCISvcCtx.hOCISvcCtx, Connection.OCISvcCtx.hOCIError, OCI_DEFAULT), Connection);
      FTransactionLinks[i].State := tsFinished;
    end;
  end;
  FreeTransaction;
end;
{$ENDIF}

{$IFNDEF LITE}

{ TOCIMetaData }

const
  fmtOrderByOwner =
    'CASE ' +
    'WHEN %s = %s THEN 0 ' +
    'WHEN %s = ''PUBLIC'' THEN 1 ' +
    'ELSE 2 ' +
    'END';

procedure TOCIMetaData.AddOrderBy(var OrderByClause: string; const Value: string);
begin
  if Value <> '' then begin
    if OrderByClause <> '' then
      OrderByClause := OrderByClause + ', ' + Value
    else
      OrderByClause := Value;
  end;
end;

function TOCIMetaData.GetTypesForSQL(const ObjectTypes: string; AllTypes: array of string): string;
var
  i: integer;
  Res: TBooleanArray;
begin
  Res := ParseTypes(ObjectTypes, AllTypes);
  Result := '';
  for i := 0 to High(AllTypes) do
    if Res[i] then begin
      if Result <> '' then
        Result := Result + ', ';
      Result := Result + '''' + AllTypes[i] + '''';
    end;
  if Result = '' then
    Result := '''''';
end;

function TOCIMetaData.CreateRecordSet: TCRRecordSet;
begin
  Result := TOCIRecordSet.Create;
  Result.GetCommand.SetProp(prIntegerPrecision, 38);
  Result.GetCommand.SetProp(prUseDefaultDataTypes, True);
end;

function TOCIMetaData.InternalGetMetaData(const MetaDataKind: string; Restrictions: TStrings): TData;
begin
  if MetaDataKind = 'sequences' then
    Result := GetSequences(Restrictions)
  else
    Result := inherited InternalGetMetaData(MetaDataKind, Restrictions);
end;

procedure TOCIMetaData.InternalGetMetaDataKindsList(List: TStringList);
begin
  inherited;

  List.Add('DataTypes');
  List.Add('Users');
  List.Add('UserDefinedTypes');
  List.Add('Packages');
  List.Add('Sequences');

  List.Sort;
end;

procedure TOCIMetaData.InternalGetRestrictionsList(List: TStringList; const MetaDataKind: string);
begin
  List.Clear;

  if MetaDataKind = 'procedures' then begin
    List.Add('PROCEDURE_CATALOG');
    List.Add('PROCEDURE_SCHEMA');
    List.Add('PROCEDURE_PACKAGE');
    List.Add('PROCEDURE_NAME');
    List.Add('PROCEDURE_TYPE');
  end
  else
  if MetaDataKind = 'procedureparameters' then begin
    List.Add('PROCEDURE_CATALOG');
    List.Add('PROCEDURE_SCHEMA');
    List.Add('PROCEDURE_PACKAGE');
    List.Add('PROCEDURE_NAME');
    List.Add('PARAMETER_NAME');
  end
  else
  if MetaDataKind = 'packages' then begin
    List.Add('PACKAGE_CATALOG');
    List.Add('PACKAGE_SCHEMA');
    List.Add('PACKAGE_NAME');
    List.Add('CURRENT_SCHEMA');
  end
  else
  if MetaDataKind = 'users' then begin
    List.Add('USER_NAME');
  end
  else
  if MetaDataKind = 'userdefinedtypes' then begin
    List.Add('TYPE_CATALOG');
    List.Add('TYPE_SCHEMA');
    List.Add('TYPE_NAME');
  end
  else
  if MetaDataKind = 'sequences' then begin
    List.Add('SEQUENCE_CATALOG');
    List.Add('SEQUENCE_SCHEMA');
    List.Add('SEQUENCE_NAME');
  end
  else
    inherited;
end;

function TOCIMetaData.GetTables(Restrictions: TStrings): TData;
const
  fmtGetTablesSQL = 'SELECT ' +
    ''''' TABLE_CATALOG, OWNER TABLE_SCHEMA, OBJECT_NAME TABLE_NAME, ' +
    'OBJECT_TYPE TABLE_TYPE, CREATED, LAST_DDL_TIME ' +
    'FROM SYS.ALL_OBJECTS ' +
    'WHERE %s OBJECT_TYPE IN (%s) ' +
    'ORDER BY %s';
  fmtOrderBy = 'OWNER, OBJECT_NAME ';
var
  WhereClause, OrderByClause, Schema, TableName, TableTypes, QuotedTypes, Scope, CachedSchema: string;
begin
  Schema := Trim(Restrictions.Values['TABLE_SCHEMA']);
  TableName := Trim(Restrictions.Values['TABLE_NAME']);
  TableTypes := Trim(Restrictions.Values['TABLE_TYPE']);
  Scope := UpperCase(Trim(Restrictions.Values['SCOPE']));
  CachedSchema := TOCIRecordSet(FRecordSet).FConnection.GetCachedSchema;

  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'OWNER', Schema)
  else
    AddWhere(WhereClause, 'OWNER', CachedSchema);
  AddWhere(WhereClause, 'OBJECT_NAME', TableName);
  if WhereClause <> '' then
    WhereClause := WhereClause + ' AND ';

  QuotedTypes := GetTypesForSQL(TableTypes, ['TABLE', 'VIEW', 'SYNONYM']);

  OrderByClause := '';
  if (Scope <> 'LOCAL') and (Schema = '') then
    AddOrderBy(OrderByClause, Format(fmtOrderByOwner, ['TABLE_SCHEMA', AnsiQuotedStr(CachedSchema, ''''), 'TABLE_SCHEMA']));

  AddOrderBy(OrderByClause, fmtOrderBy);

  FRecordSet.SetSQL(Format(fmtGetTablesSQL, [WhereClause, QuotedTypes, OrderByClause]));

  FRecordSet.Open;
  Result := FRecordSet;
end;

function TOCIMetaData.GetColumns(Restrictions: TStrings): TData;
const
  fmtGetColumnsSQL = 'SELECT ' +
    ''''' TABLE_CATALOG, OWNER TABLE_SCHEMA, TABLE_NAME, COLUMN_NAME, COLUMN_ID POSITION, ' +
    'DATA_TYPE, DATA_LENGTH, DATA_PRECISION, DATA_SCALE, ' +
    'DECODE(NULLABLE, ''Y'', 1, 0) NULLABLE, DATA_TYPE_MOD, DATA_TYPE_OWNER ' +
    'FROM SYS.ALL_TAB_COLUMNS %s ORDER BY %s ';
  fmtOrderBy = 'OWNER, TABLE_NAME, COLUMN_ID ';
var
  WhereClause, OrderByClause, Schema, TableName, ColumnName, Scope, CachedSchema: string;
begin

  Schema := Trim(Restrictions.Values['TABLE_SCHEMA']);
  TableName := Trim(Restrictions.Values['TABLE_NAME']);
  ColumnName := Trim(Restrictions.Values['COLUMN_NAME']);
  Scope := UpperCase(Trim(Restrictions.Values['SCOPE']));
  CachedSchema := TOCIRecordSet(FRecordSet).FConnection.GetCachedSchema;

  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'OWNER', Schema)
  else
    AddWhere(WhereClause, 'OWNER', CachedSchema);
  AddWhere(WhereClause, 'TABLE_NAME', TableName);
  AddWhere(WhereClause, 'COLUMN_NAME', ColumnName);
  if WhereClause <> '' then
    WhereClause := 'WHERE ' + WhereClause;

  OrderByClause := '';
  if (Scope <> 'LOCAL') and (Schema = '') then
    AddOrderBy(OrderByClause, Format(fmtOrderByOwner, ['TABLE_SCHEMA', AnsiQuotedStr(CachedSchema, ''''), 'TABLE_SCHEMA']));
  AddOrderBy(OrderByClause, fmtOrderBy);

  FRecordSet.SetSQL(Format(fmtGetColumnsSQL, [WhereClause, OrderByClause]));
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TOCIMetaData.GetProcedures(Restrictions: TStrings): TData;
const
  fmtGetProceduresSQL = 'SELECT ' +
    ''''' PROCEDURE_CATALOG, OWNER PROCEDURE_SCHEMA, OBJECT_NAME PROCEDURE_NAME, ' +
    'OBJECT_TYPE PROCEDURE_TYPE, '''' PROCEDURE_PACKAGE, CREATED, LAST_DDL_TIME, STATUS, NULL OVERLOAD ' +
    'FROM SYS.ALL_OBJECTS WHERE %s OBJECT_TYPE IN (%s) ';
  fmtGetPackageProceduresSQL = 'SELECT ' +
    ''''' PROCEDURE_CATALOG, OWNER PROCEDURE_SCHEMA, ' +
    'OBJECT_NAME PROCEDURE_NAME, ' +
    'DECODE(POSITION, 0, ''FUNCTION'', ''PROCEDURE'') PROCEDURE_TYPE, ' +
    'PACKAGE_NAME PROCEDURE_PACKAGE, ' +
    'TO_DATE(NULL) CREATED, TO_DATE(NULL) LAST_DDL_TIME, '''' STATUS, ' +
    'OVERLOAD ' +
    'FROM ( ' +
    'SELECT OWNER, PACKAGE_NAME, OBJECT_NAME, OVERLOAD, MIN(POSITION) POSITION ' +
    'FROM SYS.ALL_ARGUMENTS WHERE %s DATA_LEVEL = 0 ' +
    'GROUP BY OWNER, PACKAGE_NAME, OBJECT_NAME, OVERLOAD ' +
    ') %s';
  fmtOrderBy = 'PROCEDURE_SCHEMA, PROCEDURE_PACKAGE, PROCEDURE_NAME';
var
  WhereClause, OrderByClause, Schema, Package, ProcName, ProcTypes, QuotedTypes, Str, SQL, Scope, CachedSchema: string;
  BoolTypes: TBooleanArray;
begin
  Schema := Trim(Restrictions.Values['PROCEDURE_SCHEMA']);
  Package := Trim(Restrictions.Values['PROCEDURE_PACKAGE']);
  ProcName := Trim(Restrictions.Values['PROCEDURE_NAME']);
  ProcTypes := Trim(Restrictions.Values['PROCEDURE_TYPE']);
  Scope := UpperCase(Trim(Restrictions.Values['SCOPE']));
  CachedSchema := TOCIRecordSet(FRecordSet).FConnection.GetCachedSchema;

  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'OWNER', Schema)
  else
    AddWhere(WhereClause, 'OWNER', CachedSchema);
  AddWhere(WhereClause, 'OBJECT_NAME', ProcName);

  BoolTypes := nil;

  if (Package = '') or (Package = '""') then begin
    Str := WhereClause;
    if Str <> '' then
      Str := Str + ' AND ';

    QuotedTypes := GetTypesForSQL(ProcTypes, ['PROCEDURE', 'FUNCTION']);

    SQL := Format(fmtGetProceduresSQL, [Str, QuotedTypes]);
  end;

  if (Package = '') or (Package <> '""') then begin
    if Package <> '' then
      AddWhere(WhereClause, 'PACKAGE_NAME', Package)
    else begin
      if WhereClause <> '' then
        WhereClause := WhereClause + ' AND ';
      WhereClause := WhereClause + 'PACKAGE_NAME is not NULL';
    end;
    if WhereClause <> '' then
      WhereClause := WhereClause + ' AND ';

    BoolTypes := ParseTypes(ProcTypes, ['PROCEDURE', 'FUNCTION']);
    if BoolTypes[0] or BoolTypes[1] then begin
      if not (BoolTypes[0] and BoolTypes[1]) then begin
        if BoolTypes[0] then
          Str := '1'
        else
          Str := '0';
        QuotedTypes := 'WHERE POSITION = ' + Str;
      end
      else
        QuotedTypes := '';
    end
    else
      QuotedTypes := 'WHERE 1 = 0';

    if SQL <> '' then
      SQL := SQL + DALineSeparator + 'UNION ALL' + DALineSeparator;
    SQL := SQL + Format(fmtGetPackageProceduresSQL, [WhereClause, QuotedTypes]);
  end;

  SQL := 'SELECT * FROM ( ' + SQL + DALineSeparator + ') ORDER BY ';

  OrderByClause := '';
  if (Scope <> 'LOCAL') and (Schema = '') then
    AddOrderBy(OrderByClause, Format(fmtOrderByOwner, ['PROCEDURE_SCHEMA', AnsiQuotedStr(CachedSchema, ''''), 'PROCEDURE_SCHEMA']));
  AddOrderBy(OrderByClause, fmtOrderBy);

  SQL := SQL + DALineSeparator + OrderByClause;

  FRecordSet.SetSQL(SQL);
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TOCIMetaData.GetProcedureParameters(Restrictions: TStrings): TData;
const
  fmtGetProcedureParametersSQL = 'SELECT ' +
    ''''' PROCEDURE_CATALOG, OWNER PROCEDURE_SCHEMA, OBJECT_NAME PROCEDURE_NAME, ' +
    'ARGUMENT_NAME PARAMETER_NAME, POSITION, IN_OUT DIRECTION, ' +
    'DATA_TYPE, DATA_LENGTH, DATA_PRECISION, DATA_SCALE, ' +
    'TYPE_OWNER, TYPE_NAME, TYPE_SUBNAME, TYPE_LINK ' +
    'FROM SYS.ALL_ARGUMENTS ' +
    'WHERE %s AND DATA_LEVEL = 0 AND (ARGUMENT_NAME IS NOT NULL OR POSITION = 0) ' +
    'ORDER BY %s';
  fmtOrderBy = 'OWNER, OBJECT_NAME, OVERLOAD, POSITION';
var
  WhereClause, OrderByClause, Schema, Package, ProcName, ParamName, Scope, CachedSchema: string;
begin
  Schema := Trim(Restrictions.Values['PROCEDURE_SCHEMA']);
  Package := Trim(Restrictions.Values['PROCEDURE_PACKAGE']);
  ProcName := Trim(Restrictions.Values['PROCEDURE_NAME']);
  ParamName := Trim(Restrictions.Values['PARAMETER_NAME']);
  Scope := UpperCase(Trim(Restrictions.Values['SCOPE']));
  CachedSchema := TOCIRecordSet(FRecordSet).FConnection.GetCachedSchema;

  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'OWNER', Schema)
  else
    AddWhere(WhereClause, 'OWNER', CachedSchema);
  AddWhere(WhereClause, 'PACKAGE_NAME', Package, True);
  AddWhere(WhereClause, 'OBJECT_NAME', ProcName);
  AddWhere(WhereClause, 'ARGUMENT_NAME', ParamName);

  OrderByClause := '';
  if (Scope <> 'LOCAL') and (Schema = '') then
    AddOrderBy(OrderByClause, Format(fmtOrderByOwner, ['PROCEDURE_SCHEMA', AnsiQuotedStr(CachedSchema, ''''), 'PROCEDURE_SCHEMA']));
  AddOrderBy(OrderByClause, fmtOrderBy);

  FRecordSet.SetSQL(Format(fmtGetProcedureParametersSQL, [WhereClause, OrderByClause]));
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TOCIMetaData.GetIndexes(Restrictions: TStrings): TData;
const
  fmtGetIndexesSQL =
    'SELECT '''' TABLE_CATALOG, ' +
    '       TABLE_OWNER TABLE_SCHEMA, ' +
    '       TABLE_NAME, ' +
    '       '''' INDEX_CATALOG, ' +
    '       OWNER INDEX_SCHEMA, ' +
    '       INDEX_NAME, ' +
    '       DECODE(UNIQUENESS, ''UNIQUE'', 1, 0) "UNIQUE", ' +
    '       INDEX_TYPE, ' +
    '       TO_DATE(NULL) CREATED, ' +
    '       TO_DATE(NULL) LAST_DDL_TIME, ' +
    '       STATUS ' +
    'FROM SYS.ALL_INDEXES %s ' +
    'ORDER BY %s';
  fmtOrderBy = 'OWNER,  ' +
    '         TABLE_OWNER, ' +
    '         TABLE_NAME, ' +
    '         INDEX_NAME';
var
  WhereClause, OrderByClause, IndexSchema, TableName, TableSchema, IndexName, Scope, CachedSchema: string;
begin
  TableSchema := Trim(Restrictions.Values['TABLE_SCHEMA']);
  TableName := Trim(Restrictions.Values['TABLE_NAME']);
  IndexSchema := Trim(Restrictions.Values['INDEX_SCHEMA']);
  IndexName := Trim(Restrictions.Values['INDEX_NAME']);
  Scope := UpperCase(Trim(Restrictions.Values['SCOPE']));
  CachedSchema := TOCIRecordSet(FRecordSet).FConnection.GetCachedSchema;

  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'I.OWNER', IndexSchema)
  else
    AddWhere(WhereClause, 'I.OWNER', CachedSchema);
  AddWhere(WhereClause, 'TABLE_OWNER', TableSchema);
  AddWhere(WhereClause, 'TABLE_NAME', TableName);
  AddWhere(WhereClause, 'INDEX_NAME', IndexName);

  if WhereClause <> '' then
    WhereClause := 'WHERE ' + WhereClause;

  OrderByClause := '';
  if (Scope <> 'LOCAL') and (IndexSchema = '') then
    AddOrderBy(OrderByClause, Format(fmtOrderByOwner, ['INDEX_SCHEMA', AnsiQuotedStr(CachedSchema, ''''), 'INDEX_SCHEMA']));
  AddOrderBy(OrderByClause, fmtOrderBy);

  FRecordSet.SetSQL(Format(fmtGetIndexesSQL, [WhereClause, OrderByClause]));
  FRecordSet.Open;

  Result := FRecordSet;
end;

function TOCIMetaData.GetIndexColumns(Restrictions: TStrings): TData;
const
  fmtGetIndexColumnsSQL = 'SELECT ' +
    ''''' TABLE_CATALOG, IC.TABLE_OWNER TABLE_SCHEMA, IC.TABLE_NAME, ' +
    ''''' INDEX_CATALOG, IC.INDEX_OWNER INDEX_SCHEMA, IC.INDEX_NAME, ' +
    'IC.COLUMN_NAME, IC.COLUMN_POSITION, %s DESCENDING ' +
    'FROM SYS.ALL_IND_COLUMNS IC ' +
    '%s ORDER BY %s ';
  fmtOrderBy = 'INDEX_OWNER, TABLE_OWNER, TABLE_NAME, INDEX_NAME, COLUMN_POSITION';

  // Index for Primary Key must be first, but for Oracle 805 it is impossible
  fmtSQLWithIndexTypeOld = 'SELECT ' +
    ''''' TABLE_CATALOG, IC.TABLE_OWNER TABLE_SCHEMA, IC.TABLE_NAME, ' +
    ''''' INDEX_CATALOG, IC.INDEX_OWNER INDEX_SCHEMA, IC.INDEX_NAME, ' +
    'IC.COLUMN_NAME, IC.COLUMN_POSITION, %s DESCENDING ' +
    'FROM SYS.ALL_IND_COLUMNS IC, SYS.ALL_INDEXES I ' +
    'WHERE %s ' +
    '      I.OWNER = IC.INDEX_OWNER AND I.INDEX_NAME = IC.INDEX_NAME ' +
    'ORDER BY %s ';
  fmtOrderByOld = 'IC.INDEX_OWNER, IC.TABLE_OWNER, IC.TABLE_NAME, IC.INDEX_NAME, IC.COLUMN_POSITION';
  // Index for Primary Key must be first
  fmtSQLWithIndexTypeForORA9 = 'SELECT ' +
    ''''' TABLE_CATALOG, IC.TABLE_OWNER TABLE_SCHEMA, IC.TABLE_NAME, ' +
    ''''' INDEX_CATALOG, IC.INDEX_OWNER INDEX_SCHEMA, IC.INDEX_NAME, ' +
    'IC.COLUMN_NAME, IC.COLUMN_POSITION, %s DESCENDING ' +
    'FROM SYS.ALL_IND_COLUMNS IC, SYS.ALL_INDEXES I, SYS.ALL_CONSTRAINTS C ' +
    'WHERE %s ' +
    '      I.OWNER = IC.INDEX_OWNER AND I.INDEX_NAME = IC.INDEX_NAME AND ' +
    '      C.TABLE_NAME (+) = IC.TABLE_NAME AND C.INDEX_NAME (+) = IC.INDEX_NAME AND C.OWNER (+)= IC.TABLE_OWNER ' +
    'ORDER BY %s ';
  fmtOrderByForORA9 = 'DECODE(C.CONSTRAINT_TYPE, ''P'', 1, ''U'', 2, 3), IC.INDEX_OWNER, IC.TABLE_OWNER, IC.TABLE_NAME, IC.INDEX_NAME, IC.COLUMN_POSITION';

  DescOld = '0';
  DescForORA9 = 'DECODE(IC.DESCEND, ''ASC'', 0, 1)';
var
  WhereClause, OrderByClause, IndexSchema, TableName, TableSchema, IndexName, Uniqueness, Scope, CachedSchema: string;
begin
  TableSchema := Trim(Restrictions.Values['TABLE_SCHEMA']);
  TableName := Trim(Restrictions.Values['TABLE_NAME']);
  IndexSchema := Trim(Restrictions.Values['INDEX_SCHEMA']);
  IndexName := Trim(Restrictions.Values['INDEX_NAME']);
  Uniqueness := Trim(Restrictions.Values['UNIQUE']);
  Scope := UpperCase(Trim(Restrictions.Values['SCOPE']));
  CachedSchema := TOCIRecordSet(FRecordSet).FConnection.GetCachedSchema;

  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'INDEX_OWNER', IndexSchema)
  else
    AddWhere(WhereClause, 'IC.INDEX_OWNER', CachedSchema);
  AddWhere(WhereClause, 'IC.TABLE_OWNER', TableSchema);
  AddWhere(WhereClause, 'IC.TABLE_NAME', TableName);
  AddWhere(WhereClause, 'IC.INDEX_NAME', IndexName);

  OrderByClause := '';
  if (Scope <> 'LOCAL') and (IndexSchema = '') then
    AddOrderBy(OrderByClause, Format(fmtOrderByOwner, ['IC.INDEX_OWNER', AnsiQuotedStr(CachedSchema, ''''), 'IC.INDEX_OWNER']));

  if (Uniqueness = '0') or (Uniqueness = '1') then begin
    if Uniqueness = '0' then
      Uniqueness := 'NONUNIQUE'
    else
      Uniqueness := 'UNIQUE';
    AddWhere(WhereClause, 'I.UNIQUENESS', Uniqueness);
    if WhereClause <> '' then
      WhereClause := WhereClause + ' AND ';
    if TOCIConnection(FRecordSet.GetCommand.GetConnection).GetOracleVersion < 9000 then begin
      AddOrderBy(OrderByClause, fmtOrderByOld);
      FRecordSet.SetSQL(Format(fmtSQLWithIndexTypeOld, [DescOld, WhereClause, OrderByClause]));
    end
    else begin
      AddOrderBy(OrderByClause, fmtOrderByForORA9);
      FRecordSet.SetSQL(Format(fmtSQLWithIndexTypeForORA9, [DescForORA9, WhereClause, OrderByClause]));
    end;
  end
  else begin
    if WhereClause <> '' then
      WhereClause := 'WHERE ' + WhereClause;
    AddOrderBy(OrderByClause, fmtOrderBy);
    FRecordSet.SetSQL(Format(fmtGetIndexColumnsSQL, [DescForORA9, WhereClause, OrderByClause]));
  end;

  FRecordSet.Open;

  Result := FRecordSet;
end;

function TOCIMetaData.GetConstraints(Restrictions: TStrings): TData;
const
  fmtGetConstraintsSQLStart = 'SELECT ' +
    ''''' TABLE_CATALOG, OWNER TABLE_SCHEMA, TABLE_NAME, CONSTRAINT_NAME, ' +
    'DECODE(CONSTRAINT_TYPE, ''C'', ''CHECK'', ''P'', ''PRIMARY KEY'', ''U'', ''UNIQUE'', ' +
    '''R'', ''FOREIGN KEY'', ''UNKNOWN'') CONSTRAINT_TYPE, ';

  fmtGetConstraintsSQLforORA9 = ''''' INDEX_CATALOG, INDEX_OWNER INDEX_SCHEMA, INDEX_NAME, ';

  fmtGetConstraintsSQLEnd = 'R_OWNER REFERRED_TABLE_OWNER, R_CONSTRAINT_NAME REFERRED_CONSTRAINT_NAME, ' +
    'DECODE(STATUS, ''ENABLED'', 1, 0) ENABLED ' +
    'FROM SYS.ALL_CONSTRAINTS ' +
    '%s ORDER BY %s ';

  fmtOrderBy = 'OWNER, TABLE_NAME, CONSTRAINT_NAME';
var
  WhereClause, OrderByClause, Schema, TableName, ConstraintName, Types, TypesFilter, Scope, CachedSchema: string;
  fmtGetConstraintsSQL: string;
  BoolTypes: TBooleanArray;
  i: integer;
begin
  Schema := Trim(Restrictions.Values['TABLE_SCHEMA']);
  TableName := Trim(Restrictions.Values['TABLE_NAME']);
  ConstraintName := Trim(Restrictions.Values['CONSTRAINT_NAME']);
  Types := Trim(Restrictions.Values['CONSTRAINT_TYPE']);

  Scope := UpperCase(Trim(Restrictions.Values['SCOPE']));
  CachedSchema := TOCIRecordSet(FRecordSet).FConnection.GetCachedSchema;

  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'OWNER', Schema)
  else
    AddWhere(WhereClause, 'OWNER', CachedSchema);
  AddWhere(WhereClause, 'TABLE_NAME', TableName);
  AddWhere(WhereClause, 'CONSTRAINT_NAME', ConstraintName);

  BoolTypes := nil;
  if Types <> '' then begin
    BoolTypes := ParseTypes(Types, ['CHECK', 'PRIMARY KEY', 'UNIQUE', 'FOREIGN KEY', 'UNKNOWN']);
    if not (BoolTypes[0] and BoolTypes[1] and BoolTypes[2] and BoolTypes[3] and BoolTypes[4])
    then begin
      TypesFilter := '';
      for i := 0 to High(BoolTypes) - 1 do begin
        if BoolTypes[i] xor BoolTypes[4] then begin
          if TypesFilter <> '' then
            TypesFilter := TypesFilter + ', ';
          case i of
            0: TypesFilter := TypesFilter + '''C''';
            1: TypesFilter := TypesFilter + '''P''';
            2: TypesFilter := TypesFilter + '''U''';
            3: TypesFilter := TypesFilter + '''R''';
          end;
        end;
      end;
      if TypesFilter = '' then
        TypesFilter := '0 = 1'
      else begin
        TypesFilter := 'CONSTRAINT_TYPE IN (' + TypesFilter + ')';
        if BoolTypes[4] then
          TypesFilter := 'NOT ' + TypesFilter;
      end;
      if WhereClause <> '' then
        WhereClause := WhereClause + ' AND ';
      WhereClause := WhereClause + TypesFilter;
    end;
  end;

  if WhereClause <> '' then
    WhereClause := 'WHERE ' + WhereClause;

  OrderByClause := '';
  if (Scope <> 'LOCAL') and (Schema = '') then
    AddOrderBy(OrderByClause, Format(fmtOrderByOwner, ['OWNER', AnsiQuotedStr(CachedSchema, ''''), 'OWNER']));
  AddOrderBy(OrderByClause, fmtOrderBy);

  if TOCIConnection(FRecordSet.GetCommand.GetConnection).GetOracleVersion >= 9000 then
    fmtGetConstraintsSQL := fmtGetConstraintsSQLStart + fmtGetConstraintsSQLforORA9 + fmtGetConstraintsSQLEnd
  else
    fmtGetConstraintsSQL := fmtGetConstraintsSQLStart + fmtGetConstraintsSQLEnd;

  FRecordSet.SetSQL(Format(fmtGetConstraintsSQL, [WhereClause, OrderByClause]));
  FRecordSet.Open;
  Result := FRecordSet;
end;

{function TOCIMetaData.GetDataTypes(Restrictions: TStrings): TData;
const
  fmtGetDataTypesSQL = 'SELECT TYPE_NAME FROM SYS.ALL_TYPES ' +
  'WHERE OWNER IS NULL ' +
  'ORDER BY TYPE_NAME';
begin
  FRecordSet.SetSQL(fmtGetDataTypesSQL);
  FRecordSet.Open;
  Result := FRecordSet;
end;}

function TOCIMetaData.GetUsers(Restrictions: TStrings): TData;
const
  fmtGetUsersSQL = 'SELECT ' +
    'USERNAME USER_NAME, CREATED ' +
    'FROM SYS.ALL_USERS ' +
    '%s ORDER BY USERNAME';
var
  WhereClause, UserName: string;
begin
  UserName := Trim(Restrictions.Values['USER_NAME']);

  WhereClause := '';
  AddWhere(WhereClause, 'USERNAME', UserName);
  if WhereClause <> '' then
    WhereClause := 'WHERE ' + WhereClause;

  FRecordSet.SetSQL(Format(fmtGetUsersSQL, [WhereClause]));
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TOCIMetaData.GetPackages(Restrictions: TStrings): TData;
const
  fmtGetPackagesSQL = 'SELECT ' +
    ''''' PACKAGE_CATALOG, OWNER PACKAGE_SCHEMA, OBJECT_NAME PACKAGE_NAME, ' +
    'CREATED, LAST_DDL_TIME, STATUS ' +
    'FROM SYS.ALL_OBJECTS ' +
    'WHERE %s OBJECT_TYPE = ''PACKAGE'' ' +
    'ORDER BY %s ';
  fmtOrderBy = 'OWNER, OBJECT_NAME';

var
  WhereClause, OrderByClause, Schema, PackageName, Scope, CachedSchema: string;
begin
  Schema := Trim(Restrictions.Values['PACKAGE_SCHEMA']);
  PackageName := Trim(Restrictions.Values['PACKAGE_NAME']);
  Scope := Trim(Restrictions.Values['SCOPE']);
  CachedSchema := TOCIRecordSet(FRecordSet).FConnection.GetCachedSchema;
  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'OWNER', Schema)
  else
    AddWhere(WhereClause, 'OWNER', CachedSchema);

  AddWhere(WhereClause, 'OBJECT_NAME', PackageName);
  if WhereClause <> '' then
    WhereClause := WhereClause + ' AND ';

  OrderByClause := '';
  if (Scope <> 'LOCAL') and (Schema = '') then
    AddOrderBy(OrderByClause, Format(fmtOrderByOwner, ['OWNER', AnsiQuotedStr(CachedSchema, ''''), 'OWNER']));
  AddOrderBy(OrderByClause, fmtOrderBy);

  FRecordSet.SetSQL(Format(fmtGetPackagesSQL, [WhereClause, OrderByClause]));

  FRecordSet.Open;
  Result := FRecordSet;
end;

function TOCIMetaData.GetUDTs(Restrictions: TStrings): TData;
const
  fmtGetUDTsSQL = 'SELECT ' +
    ''''' TYPE_CATALOG, OWNER TYPE_SCHEMA, OBJECT_NAME TYPE_NAME, ' +
    'CREATED, LAST_DDL_TIME, STATUS ' +
    'FROM SYS.ALL_OBJECTS ' +
    'WHERE %s OBJECT_TYPE = ''TYPE'' ORDER BY %s ';
  fmtOrderBy = 'OWNER, OBJECT_NAME';
var
  WhereClause, OrderByClause, Schema, TypeName, Scope, CachedSchema: string;
begin
  Schema := Trim(Restrictions.Values['TYPE_SCHEMA']);
  TypeName := Trim(Restrictions.Values['TYPE_NAME']);
  Scope := Trim(Restrictions.Values['SCOPE']);
  CachedSchema := TOCIRecordSet(FRecordSet).FConnection.GetCachedSchema;

  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'OWNER', Schema)
  else
    AddWhere(WhereClause, 'OWNER', CachedSchema);
  AddWhere(WhereClause, 'OBJECT_NAME', TypeName);
  if WhereClause <> '' then
    WhereClause := WhereClause + ' AND ';

  OrderByClause := '';
  if (Scope <> 'LOCAL') and (Schema = '') then
    AddOrderBy(OrderByClause, Format(fmtOrderByOwner, ['OWNER', AnsiQuotedStr(CachedSchema, ''''), 'OWNER']));
  AddOrderBy(OrderByClause, fmtOrderBy);

  FRecordSet.SetSQL(Format(fmtGetUDTsSQL, [WhereClause, OrderByClause]));
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TOCIMetaData.GetSequences(Restrictions: TStrings): TData;
const
  fmtGetSequencesSQL = 'SELECT ' +
    ''''' SEQUENCE_CATALOG, OWNER SEQUENCE_SCHEMA, OBJECT_NAME SEQUENCE_NAME, ' +
    'CREATED, LAST_DDL_TIME ' +
    'FROM SYS.ALL_OBJECTS ' +
    'WHERE %s OBJECT_TYPE IN (''SEQUENCE'') ORDER BY %s ';
  fmtOrderBy = 'OWNER, OBJECT_NAME ';
var
  WhereClause, OrderByClause, Schema, ObjectName, Scope, CachedSchema: string;
begin
  Schema := Trim(Restrictions.Values['SEQUENCE_SCHEMA']);
  ObjectName := Trim(Restrictions.Values['SEQUENCE_NAME']);
  Scope := UpperCase(Trim(Restrictions.Values['SCOPE']));
  CachedSchema := TOCIRecordSet(FRecordSet).FConnection.GetCachedSchema;

  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'OWNER', Schema)
  else
    AddWhere(WhereClause, 'OWNER', CachedSchema);
  AddWhere(WhereClause, 'OBJECT_NAME', ObjectName);
  if WhereClause <> '' then
    WhereClause := WhereClause + ' AND ';

  OrderByClause := '';
  if (Scope <> 'LOCAL') and (Schema = '') then
    AddOrderBy(OrderByClause, Format(fmtOrderByOwner, ['OWNER', AnsiQuotedStr(CachedSchema, ''''), 'OWNER']));
  AddOrderBy(OrderByClause, fmtOrderBy);

  FRecordSet.SetSQL(Format(fmtGetSequencesSQL, [WhereClause, OrderByClause]));
  FRecordSet.Open;
  Result := FRecordSet;
end;

{ TOCILoader }

const
  DPBufferSize = $10000*2; // 64K*2

// RESET, [[GET_RECORD, FIELD_SET]+, DO_CONVERT, DO_LOAD]+, RESET

constructor TOCILoaderColumn.Create;
begin
  inherited;
  FIsNational := false;
  FIsLob := false;
end;

procedure TOCILoaderColumn.VerifySize;
begin
  case DataType of
    dtString, dtWideString, dtFixedChar, dtFixedWideChar, dtMemo, dtWideMemo, dtGuid {$IFDEF VER6P}, dtTimeStamp{$ENDIF}: begin
      if Size = 0 then
        Size := 20;
    end;
    dtInt8, dtInt16, dtInt32, dtInt64, dtUInt16, dtUInt32: begin
      if Size < sizeof(Integer) then
        Size := sizeof(Integer);
    end;
    dtFloat, dtCurrency, dtBCD{$IFDEF VER6P}{$IFNDEF FPC}, dtFMTBCD{$ENDIF}{$ENDIF}: begin
      if Size < sizeof(Double) then
        Size := sizeof(Double);
    end;
    dtDate, dtTime, dtDateTime: begin
      if Size < 7 then
        Size := 7;
    end;
    dtBlob, dtOraBlob: begin
      if Size < 4 then
        Size := 4;
    end;
    dtOraClob, dtNClob, dtWideOraClob: begin
      if Size < 4 then
        Size := 4;
    end;
  else begin
      if Size = 0 then
        Size := 20;
    end;
  end;
end;

procedure TOCILoaderColumn.UpdateDataType(Value: word);
begin
  // do not change DateTime types
  if (Value    in [dtDate, dtTime, dtDateTime,
                   {$IFDEF VER6P}{$IFNDEF FPC}dtSQLTimeStamp, {$ENDIF}{$ENDIF}
                   dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ]) and
     (DataType in [dtDate, dtTime, dtDateTime,
                   {$IFDEF VER6P}{$IFNDEF FPC}dtSQLTimeStamp, {$ENDIF}{$ENDIF}
                   dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ])
 then
   exit
 else
   inherited UpdateDataType(Value);
end;

{ TOCILoader }

constructor TOCILoader.Create;
begin
  inherited;

  FDML := TOCICommand.Create;
  FDML.SetProp(prAutoCommit, True);
  FDML.SetProp(prTemporaryLobUpdate, True);
  hDirPathCtx := nil;
  hColumnArray := nil;
  hStream := nil;
  FBuffer := nil;
  FLobBuffer := nil;
  FIsDirectMode := True;
  FSkipReadOnlyFieldDescs := False;
end;

destructor TOCILoader.Destroy;
begin
  FDML.Free;

  inherited;
end;

function TOCILoader.GetOCISvcCtx: TOCISvcCtx;
begin
  Result := FConnection.OCISvcCtx;
end;

function TOCILoader.GetOCI7: TOCI7API;
begin
  Result := FConnection.OCI7;
end;

function TOCILoader.GetOCI8: TOCI8API;
begin
  Result := FConnection.OCI8;
end;

procedure TOCILoader.Check(Status: Word);
begin
  OCISvcCtx.OCI8.Check(Status, FConnection.OCISvcCtx);
end;

function TOCILoader.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prDirectPath:
      FIsDirectMode := Value;
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TOCILoader.GetProp(Prop: integer; var Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prDirectPath:
      Value := FIsDirectMode;
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

procedure TOCILoader.Prepare;
var
  StrTableName: string;
  SchemaName: string;
  i: integer;
  Column: TOCILoaderColumn;
  ColumnCount: integer; //sb2
  hColumnList: pOCIParam;
  hColumn: pOCIParam;
  ParamType: byte;
  D1: integer; //byte;
  D2: integer; //word;
  BufSize: Integer;
  Res: sword;
  Ptr, ValuePtr: IntPtr;
  ValueInt: Integer;
  ValSize: integer;
  St: string;
  CharsetID: integer;
  Info: TSQLObjectInfo;
begin
  inherited;

  if FIsDirectMode then begin
  // Direct path
    if OCISvcCtx.Home.PossibleOCICallStyles = [OCI80] then
      RaiseError(SDirectPathLoadingNotSupportedWithDirect);
    OCISvcCtx.Home.CheckOCI81;
    FConnection.CheckOCI80;

    if hDirPathCtx = nil then begin
      Res := OCI8.OCIHandleAlloc(OCISvcCtx.hOCIEnv, pOCIHandle(hDirPathCtx), OCI_HTYPE_DIRPATH_CTX, 0, nil); // raises OCI_NO_DATA if OCIThreaded
      if Res <> OCI_SUCCESS then begin
        hDirPathCtx := nil;
        Check(Res);
      end;
    end;

    TableName := OCISQLInfo.NormalizeName(TableName, QuoteNames);
    OCISQLInfo.SplitObjectName(TableName, Info);
    StrTableName := Info.Name;
    SchemaName := Info.Schema;
    if SchemaName = '' then
      SchemaName := FConnection.GetCachedSchema;

    Ptr := StringToHGlobalOCI(SchemaName, ValSize, OCISvcCtx.UnicodeEnv);
    Res := OCI8.OCIAttrSet1(hDirPathCtx, OCI_HTYPE_DIRPATH_CTX, Ptr, ValSize,
      OCI_ATTR_SCHEMA_NAME, OCISvcCtx.hOCIError);
    FreeStringOCI(Ptr, OCISvcCtx.UnicodeEnv);
    Check(Res);

    Ptr := StringToHGlobalOCI(StrTableName, ValSize, OCISvcCtx.UnicodeEnv);
    Res := OCI8.OCIAttrSet1(hDirPathCtx, OCI_HTYPE_DIRPATH_CTX, Ptr, ValSize,
      OCI_ATTR_NAME, OCISvcCtx.hOCIError);
    FreeStringOCI(Ptr, OCISvcCtx.UnicodeEnv);
    Check(Res);

  // Columns
    ColumnCount := Columns.Count;
    Check(OCI8.OCIAttrSet2(hDirPathCtx, OCI_HTYPE_DIRPATH_CTX, ColumnCount,
      0, OCI_ATTR_NUM_COLS, OCISvcCtx.hOCIError));

    ValuePtr := OrdinalToPtr(hColumnList);
    try
      Check(OCI8.OCIAttrGet1(hDirPathCtx, OCI_HTYPE_DIRPATH_CTX, ValuePtr, nil,
        OCI_ATTR_LIST_COLUMNS, OCISvcCtx.hOCIError));
    finally
      PtrToOrdinal(ValuePtr, hColumnList);
    end;

    Check(OCI8.OCIAttrGet2(hColumnList, OCI_DTYPE_PARAM, ValueInt, nil,
      OCI_ATTR_PTYPE, OCISvcCtx.hOCIError));
    ParamType := Byte(ValueInt);

    Assert(ParamType = OCI_PTYPE_LIST);

    FRowSize := 0;
    for i := 0 to ColumnCount - 1 do begin
      Check(OCI8.OCIParamGet(hColumnList, OCI_DTYPE_PARAM, OCISvcCtx.hOCIError, hColumn, i + 1));

      try
        Ptr := StringToHGlobalOCI(Columns[i].Name, ValSize, OCISvcCtx.UnicodeEnv);
        Res := OCI8.OCIAttrSet1(hColumn, OCI_DTYPE_PARAM, Ptr, ValSize,
          OCI_ATTR_NAME, OCISvcCtx.hOCIError);
        FreeStringOCI(Ptr, OCISvcCtx.UnicodeEnv);
        Check(Res);

        Column := TOCILoaderColumn(Columns[i]);
        case Column.DataType of
          dtInt8, dtInt16, dtInt32: begin
            Column.ColumnType := SQLT_INT;
            Column.DataSize := SizeOf(Integer);
          end;
          dtUInt8, dtUInt16, dtUInt32: begin
            Column.ColumnType := SQLT_UIN;
            Column.DataSize := SizeOf(Integer);
          end;
          dtFloat, dtCurrency, dtBCD{$IFDEF VER6P}{$IFNDEF FPC}, dtFMTBcd{$ENDIF}{$ENDIF}, dtNumber, dtInt64: begin
            Column.ColumnType := SQLT_FLT;
            Column.DataSize := SizeOf(Double);
          end;
          dtDate, dtTime, dtDateTime: begin
            Column.ColumnType := SQLT_DAT;
            Column.DataSize := 8;
          end;
        {$IFDEF VER6P}{$IFNDEF FPC}
          dtSQLTimeStamp: begin
            case Column.SubDataType of
              dtTimeStamp: begin
                Column.ColumnType := SQLT_TIMESTAMP;
                Column.DataSize := 20;
              end;
              dtTimeStampTZ: begin
                Column.ColumnType := SQLT_TIMESTAMP_TZ;
                Column.DataSize := 20;
              end;
              dtTimeStampLTZ: begin
                Column.ColumnType := SQLT_TIMESTAMP_TZ;
                Column.DataSize := 20;
              end;
              else begin
                Column.ColumnType := SQLT_TIMESTAMP;
                Column.DataSize := 20;
              end;
            end;
          end;
        {$ENDIF}{$ENDIF}
          dtTimeStamp: begin
            Column.ColumnType := SQLT_TIMESTAMP;
            Column.DataSize := 20;
          end;
          dtTimeStampTZ: begin
            Column.ColumnType := SQLT_TIMESTAMP_TZ;
            Column.DataSize := 20;
          end;
          dtTimeStampLTZ: begin
            Column.ColumnType := SQLT_TIMESTAMP_TZ;
            Column.DataSize := 20;
          end;
          dtBlob, dtOraBlob: begin
            Column.ColumnType := SQLT_CHR;
            Column.DataSize := 4;
            Column.IsLob := true;
          end;
          dtOraClob, dtNClob, dtWideOraClob: begin
            Column.ColumnType := SQLT_CHR;
            Column.DataSize := 4;
            Column.IsLob := true;
          end;
        else
          Column.ColumnType := SQLT_CHR;
          if Column.DataSize = 0 then
            Column.DataSize := 20;
        end;

        ValueInt := Column.ColumnType;
        Check(OCI8.OCIAttrSet2(hColumn, OCI_DTYPE_PARAM, ValueInt,
          0, OCI_ATTR_DATA_TYPE, OCISvcCtx.hOCIError));

        if ConverToUnicode(TOCILoaderColumn(Columns[i])) then begin
          CharsetID := OCI_UTF16ID;
          Check(OCI8.OCIAttrSet2(hColumn, OCI_DTYPE_PARAM, CharsetID,
            0, OCI_ATTR_CHARSET_ID, OCISvcCtx.hOCIError));
        end;

        ValueInt := Column.DataSize;
        Check(OCI8.OCIAttrSet2(hColumn, OCI_DTYPE_PARAM, ValueInt,
          0, OCI_ATTR_DATA_SIZE, OCISvcCtx.hOCIError));

        if Column.Precision > 0 then begin
          D1 := Integer(Column.Precision);
          Check(OCI8.OCIAttrSet2(hColumn, OCI_DTYPE_PARAM, D1,
            0, OCI_ATTR_PRECISION, OCISvcCtx.hOCIError));
        end;

        if Column.Scale > 0 then begin
          D1 := Integer(Column.Scale);
          Check(OCI8.OCIAttrSet2(hColumn, OCI_DTYPE_PARAM, D1,
            0, OCI_ATTR_SCALE, OCISvcCtx.hOCIError));
        end;

        // date format
        if Column.DateFormat <> '' then begin
          Ptr := StringToHGlobalOCI(Column.DateFormat, ValSize, OCISvcCtx.UnicodeEnv);
          Res := OCI8.OCIAttrSet1(hColumn, OCI_DTYPE_PARAM, Ptr, ValSize,
            OCI_ATTR_DATEFORMAT, OCISvcCtx.hOCIError);
          FreeStringOCI(Ptr, OCISvcCtx.UnicodeEnv);
          Check(Res);
        end;

        if Column.Scale > 0 then begin
          // Set char set for float fields
          D2 := 1; // US7ASCII
          Check(OCI8.OCIAttrSet2(hColumn, OCI_DTYPE_PARAM, D2, 0,
            OCI_ATTR_CHARSET_ID, OCISvcCtx.hOCIError));
        end;

        Column.Offset := FRowSize;
        Inc(FRowSize, Column.DataSize);

      finally
        // free memory for OCIParamGet
        OCI8.OCIDescriptorFree(hColumn, OCI_DTYPE_PARAM);
      end;
    end;

    BufSize := Integer(DPBufferSize);
    Check(OCI8.OCIAttrSet2(hDirPathCtx, OCI_HTYPE_DIRPATH_CTX, BufSize,
        0, OCI_ATTR_BUF_SIZE, OCISvcCtx.hOCIError));
    try
      Check(OCI8.OCIDirPathPrepare(hDirPathCtx, OCISvcCtx.hOCISvcCtx, OCISvcCtx.hOCIError));
    except
      Check(OCI8.OCIHandleFree(hDirPathCtx, OCI_HTYPE_DIRPATH_CTX));
      hDirPathCtx := nil;
      raise;
    end;

    if hColumnArray = nil then
      Check(OCI8.OCIHandleAlloc(hDirPathCtx, pOCIHandle(hColumnArray), OCI_HTYPE_DIRPATH_COLUMN_ARRAY, 0, nil));
    if hStream = nil then
      Check(OCI8.OCIHandleAlloc(hDirPathCtx, pOCIHandle(hStream), OCI_HTYPE_DIRPATH_STREAM, 0, nil));

    Check(OCI8.OCIAttrGet2(hColumnArray, OCI_HTYPE_DIRPATH_COLUMN_ARRAY, ValueInt, nil,
      OCI_ATTR_NUM_ROWS, OCISvcCtx.hOCIError));
    FBufNumRows := Integer(ValueInt);

    Check(OCI8.OCIAttrGet2(hColumnArray, OCI_HTYPE_DIRPATH_COLUMN_ARRAY, ValueInt, nil,
      OCI_ATTR_NUM_COLS, OCISvcCtx.hOCIError));
    FBufNumCols := Word(ValueInt);

    FBuffer := Marshal.AllocHGlobal(FBufNumRows * FRowSize);
    CheckLobBuffer;

    Reset;
  end
  else begin
  // DML
    FDML.SetConnection(FConnection);
    St := 'INSERT INTO ' + TableName + '(';
    for i := 0 to Columns.Count - 1 do begin
      if i > 0 then
        St := St + ', ';
      St := St + OCISQLInfo.NormalizeName(Columns[i].Name, QuoteNames);
    end;
    St := St + ') VALUES (';
    for i := 0 to Columns.Count - 1 do begin
      if i > 0 then
        St := St + ', ';
      St := St + ':' + OCISQLInfo.NormalizeName(Columns[i].Name, QuoteNames);
    end;
    St := St + ')';

    FDML.SetSQL(St);

  // Set params type
    FBufNumRows := 100;
    for i := 0 to Columns.Count - 1 do begin
      FDML.Params[i].SetDataType(Columns[i].DataType);
      if Columns[i].DataType in [dtBlob, dtOraBlob, dtOraClob, dtNClob, dtWideOraClob] then
        FDML.Params[i].SetSize(0)
      else
        FDML.Params[i].SetSize(TOCILoaderColumn(Columns[i]).Size);
      TOraParamDesc(FDML.Params[i]).SetLength(FBufNumRows);
    end;

    FDML.Prepare;
  end;
end;

procedure TOCILoader.Finish;
var
  i: Integer;
begin
  if FIsDirectMode then begin
  // Direct
    Reset;

    if hDirPathCtx <> nil then begin
      Check(OCI8.OCIDirPathFinish(hDirPathCtx, OCISvcCtx.hOCIError));

      Check(OCI8.OCIHandleFree(hColumnArray, OCI_HTYPE_DIRPATH_COLUMN_ARRAY));
      Check(OCI8.OCIHandleFree(hStream, OCI_HTYPE_DIRPATH_STREAM));
      Check(OCI8.OCIHandleFree(hDirPathCtx, OCI_HTYPE_DIRPATH_CTX));

      hColumnArray := nil;
      hStream := nil;
      hDirPathCtx := nil;
    end;

    Marshal.FreeHGlobal(FBuffer);
    FBuffer := nil;
    FreeLobBuffer;
  end
  else begin
  // DML
    FDML.UnPrepare;
    for i := 0 to FDML.Params.Count - 1 do
      TOraParamDesc(FDML.Params[i]).SetLength(0);
  end;

  inherited;
end;

procedure TOCILoader.Reset;
var
  i: Integer;
begin
  inherited;

  for i := 0 to FColumns.Count - 1 do
    TOCILoaderColumn(FColumns[i]).VerifySize;

  if hColumnArray <> nil then
    Check(OCI8.OCIDirPathColArrayReset(hColumnArray, OCISvcCtx.hOCIError));
  if hStream <> nil then
    Check(OCI8.OCIDirPathStreamReset(hStream, OCISvcCtx.hOCIError));
end;

procedure TOCILoader.PutColumnData(Col: integer; Row: integer; const Value: variant);
var
{$IFDEF CLR}
  lb: integer;
{$ENDIF}
  i: integer;
  Ptr: IntPtr;
  Size: integer;
  Column: TOCILoaderColumn;
  ParamDesc: TOraParamDesc;
  Flag: byte;
  OldDecimalSeparator: {$IFDEF CLR}string{$ELSE}Char{$ENDIF};
  NumericCharacters: variant;
  ObjRef: TSharedObject;

  procedure Error;
  begin
    raise EConvertError.Create('Cannot convert data for ' + Column.Name + ' column');
  end;

  procedure PutColumnStr(const Str: String; const IsUnicode: boolean; const ColumnSize: Integer; var Size: Integer; var Ptr: IntPtr);
  var
    AStr: AnsiString;
    WStr: WideString;
    SrcPtr: IntPtr;
  begin
    if IsUnicode then begin
      WStr := WideString(Str);
      Size := Length(WStr) * 2;
      if (ColumnSize >= 0) and (Size > ColumnSize) then
        Size := Column.Size;
      SrcPtr := Marshal.StringToHGlobalUni(WStr);
    end
    else begin
      AStr := AnsiString(Str);
      Size := LengthA(AStr);
      if (ColumnSize >= 0) and (Size > ColumnSize) then
        Size := Column.Size;
      SrcPtr := Marshal.StringToHGlobalAnsi(AStr);
    end;

    try
      if ColumnSize < 0 then
        Ptr := Marshal.AllocHGlobal(Size);
      CopyBuffer(SrcPtr, Ptr, Size);
    finally
      FreeString(SrcPtr);
    end;
  end;

begin
  if Row > FLoadedRows + FBufNumRows then
    DoLoad;

  inherited;

  if Row <= FLoadedRows then
    RaiseError('Invalid row number');

  if FIsDirectMode then begin
  // Direct
    Column := TOCILoaderColumn(Columns[Col]);
    Ptr := PtrOffset(FBuffer, (Row - FLoadedRows - 1) * FRowSize + Column.FOffset);
    Flag := OCI_DIRPATH_COL_COMPLETE;
    Size := Column.DataSize;

    if VarIsNull(Value) or VarIsEmpty(Value) then
      Flag := OCI_DIRPATH_COL_NULL
    else if Column.FIsLob then begin
      if VarIsStr(Value) then
        PutColumnStr(Value, ConverToUnicode(Column), -1, Size,  Ptr)
      else if VarType(Value) = varByte + varArray then begin
      {$IFDEF CLR}
        lb := VarArrayLowBound(Value, 1);
        Size := VarArrayHighBound(Value, 1) - lb + 1;
        Ptr := Marshal.AllocHGlobal(Size);
        for i := lb to Size - 1 do
          Marshal.WriteByte(Ptr, i, Value[i + lb]);
      {$ELSE}
        Size := TVarData(Value).VArray.Bounds[0].ElementCount;
        Ptr := Marshal.AllocHGlobal(Size);
        CopyBuffer(TVarData(Value).VArray.Data, Ptr, Size);
     {$ENDIF}
      end
      else if VarType(Value) = varSharedObject then begin
        ObjRef := TSharedObject.FromVariant(Value);
        Size := TOraLob(ObjRef).Size;
        if TOraLob(ObjRef).LobType = ltBlob then begin
          Ptr := Marshal.AllocHGlobal(Size);
          TOraLob(ObjRef).Read(0, Size, Ptr);
        end
        else
          PutColumnStr(TOraLob(ObjRef).AsString, ConverToUnicode(Column), -1, Size,  Ptr);
      end
      else
        Error;

      FLobBuffer.Add(Ptr);
    end
    else
      case Column.FColumnType of
        SQLT_CHR: begin
          case VarType(Value) of
            varInteger,varByte,varSmallint{$IFDEF VER6P},varShortInt,varWord,varLongWord{$ENDIF}:
              PutColumnStr(IntToStr(Value), ConverToUnicode(Column), Column.Size, Size, Ptr);
            varDouble,varSingle,varCurrency: begin
              OldDecimalSeparator := {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator;
              FConnection.GetProp(prNumericCharacters, NumericCharacters);
              {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator := VarToStr(NumericCharacters)[1];
              try
                {if (Column.Precision > 0) and (Column.Scale > 0) then
                  Str := FloatToStrF(Value, ffFixed, Column.Precision, Column.Scale)
                else
                  Str := FloatToStr(Value);
                }
                PutColumnStr(FloatToStr(Value), ConverToUnicode(Column), Column.Size, Size, Ptr);
              finally
                {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator := OldDecimalSeparator;
              end;
            end;
            varDate:
              if Column.DateFormat <> '' then
                 PutColumnStr(FormatDateTime(Column.DateFormat, Value), ConverToUnicode(Column), Column.Size, Size, Ptr)
               else
                 PutColumnStr(DateToStr(Value), ConverToUnicode(Column), Column.Size, Size, Ptr);
          else
            if VarIsStr(Value) then
              PutColumnStr(Value, ConverToUnicode(Column), Column.Size, Size, Ptr)
            else
              Error;
          end;
        end;
        SQLT_INT, SQLT_UIN:
          case VarType(Value) of
            varInteger,varDouble,varCurrency,varSingle,varByte,varSmallint{$IFDEF VER6P},varShortInt,varWord,varLongWord{$ENDIF}:
              Marshal.WriteInt32(Ptr, Value);
          else
            if VarIsStr(Value) then
              Marshal.WriteInt32(Ptr, StrToInt(Value))
            else
              Error;
          end;
        SQLT_FLT:
          case VarType(Value) of
            varByte, varShortInt, varSmallint, varWord, varInteger, {$IFDEF VER6P}varLongWord,{$ENDIF} varInt64,
            varSingle, varDouble, varCurrency:
              Marshal.WriteInt64(Ptr, BitConverter.DoubleToInt64Bits(Value));
          else
            if VarIsStr(Value) then
              Marshal.WriteInt64(Ptr, BitConverter.DoubleToInt64Bits(StrToFloat(Value)))
            else
              Error;
          end;
        SQLT_DAT:
          case VarType(Value) of
            varDate: begin
              DateTimeToOraDate(Value, Ptr);
              Size := 7;
            end
          else
            Error;
          end;
        SQLT_TIMESTAMP,
        SQLT_TIMESTAMP_TZ,
        SQLT_TIMESTAMP_LTZ:
          case VarType(Value) of
            varDate:
              PutColumnStr(FormatDateTime('dd.mm.yyyy hh:nn:ss', Value), ConverToUnicode(Column), 20, Size, Ptr);
          else
          {$IFDEF VER6P}{$IFNDEF FPC}
            if VarIsSQLTimeStamp(Value) then
              PutColumnStr(SQLTimeStampToStr('dd.mm.yyyy hh:nn:ss', VarToSQLTimeStamp(Value)), ConverToUnicode(Column), 20, Size, Ptr)
            else
          {$ENDIF}{$ENDIF}
              Error;
          end;
      else
        Error;
      end;

    Check(OCI8.OCIDirPathColArrayEntrySet(hColumnArray, OCISvcCtx.hOCIError, Row - FLoadedRows - 1,
      Col, Ptr, Size, Flag));
  end
  else begin
  // DML
    i := (Row - 1) mod FBufNumRows + 1;
    ParamDesc := TOraParamDesc(FDML.Params[Col]);
    ParamDesc.AllocBuffer;
    if ParamDesc.GetDataType in [dtOraClob, dtWideOraClob, dtNClob] then
      TOraLob(ParamDesc.GetItemAsObject(i)).IsUnicode := FConnection.FUseUnicode;
    ParamDesc.SetNational(TOCILoaderColumn(Columns[Col]).IsNational);
    ParamDesc.SetItemAsVariant(i, Value);
  end;
end;

procedure TOCILoader.DoLoad;
var
  Res: sword;
  ArrRowCount: integer; // count of rows in array
  RowOffset: integer;
  PieceRows: integer; // count of rows in piece
  RowCount: integer;
  Action: _TDPErrorAction;
  ColCount: word;
  ValueInt: Integer;
begin
  if FIsDirectMode then begin
  /// Loading via Oracle direct path interface
    RowOffset := 0;
    ColCount := 0;
    ArrRowCount := FLastRow - FLoadedRows + 1;
    Action := _dpFail;
    repeat
      Res := OCI8.OCIDirPathColArrayToStream(hColumnArray, hDirPathCtx, hStream,
        OCISvcCtx.hOCIError, ArrRowCount, RowOffset);

      Check(OCI8.OCIAttrGet2(hColumnArray, OCI_HTYPE_DIRPATH_COLUMN_ARRAY, ValueInt, nil,
        OCI_ATTR_ROW_COUNT, OCISvcCtx.hOCIError));
      RowCount := Integer(ValueInt);

      if OCISvcCtx.Home.OCIVersion >= 8170 then // Difference of 8.1.7
        PieceRows := RowCount
      else
        PieceRows := RowCount - RowOffset;

      if Res <> OCI_SUCCESS then begin
      /// Stream buffer is not large enough to contain all of the column array
      /// data (OCI_CONTINUE), partial column was encountered (OCI_NEED_DATA)
      /// or convert error ocured (OCI_ERROR).
        if OCISvcCtx.Home.OCIVersion >= 8170 then // Difference of 8.1.7
          Inc(RowOffset, RowCount)
        else
          RowOffset := RowCount;

        if Res = OCI_ERROR then begin
        /// process convert error
          try
            Check(OCI8.OCIAttrGet2(hColumnArray, OCI_HTYPE_DIRPATH_COLUMN_ARRAY,
              ValueInt, nil, OCI_ATTR_COL_COUNT, OCISvcCtx.hOCIError));
            ColCount := Word(ValueInt);
            Check(Res);
          except
            on E: Exception do begin
              Action := _dpFail;
              if Assigned(FOnError) then
                FOnError(E, ColCount, FLoadedRows + RowCount, Action);
              case Action of
                _dpFail:
                  raise;
                _dpAbort:
                  Break;
              end;
            end;
          end;
        /// Skip row which caused error
          Inc(PieceRows);
          Inc(RowOffset);
        end;
      end;

      Res := OCI8.OCIDirPathLoadStream(hDirPathCtx, hStream, OCISvcCtx.hOCIError);

      if Res = OCI_ERROR then begin
      /// process load error
        ColCount := 0;
        try
          Check(OCI8.OCIAttrGet2(hColumnArray, OCI_HTYPE_DIRPATH_COLUMN_ARRAY,
            ValueInt, nil, OCI_ATTR_ROW_COUNT, OCISvcCtx.hOCIError));
          RowCount := Integer(ValueInt);
          Check(OCI8.OCIAttrGet2(hColumnArray, OCI_HTYPE_DIRPATH_COLUMN_ARRAY,
            ValueInt, nil, OCI_ATTR_COL_COUNT, OCISvcCtx.hOCIError));
          ColCount := Word(ValueInt);
          Check(Res);
        except
          on E: Exception do begin
            Action := _dpFail;
            if Assigned(FOnError) then
              FOnError(E, ColCount, FLoadedRows + RowCount, Action);
            case Action of
              _dpFail:
                raise;
              _dpAbort:
                Break;
            end;
          end;
        end;
      end;
    /// reset stream
      Check(OCI8.OCIDirPathStreamReset(hStream, OCISvcCtx.hOCIError));
      Inc(FLoadedRows, PieceRows);
    until FLoadedRows >= FLastRow + 1;

    if Action <> _dpAbort then
      Assert(FLoadedRows = FLastRow + 1);

  /// reset column array
    Check(OCI8.OCIDirPathColArrayReset(hColumnArray, OCISvcCtx.hOCIError));
    ClearLobBuffer;

    if Action = _dpAbort then
      Abort;
  end
  else begin
  // Loading via DML array
    ArrRowCount := FLastRow - FLoadedRows + 1;
    FDML.Execute(ArrRowCount);
    Inc(FLoadedRows, ArrRowCount);
  end;
end;

class function TOCILoader.GetColumnClass: TCRLoaderColumnClass;
begin
  Result := TOCILoaderColumn;
end;

class function TOCILoader.GetRecordSetClass: TCRRecordSetClass;
begin
  Result := TOCIRecordSet;
end;

procedure TOCILoader.SetConnection(Value: TCRConnection);
begin
  inherited;

  FConnection := TOCIConnection(Value);
end;

procedure TOCILoader.FillColumn(Column: TCRLoaderColumn; FieldDesc: TFieldDesc);
begin
  inherited;

  with TOCILoaderColumn(Column) do begin
    case FieldDesc.DataType of
      dtNumber: begin
        Size := 0;
        Precision := FieldDesc.Length;
        Scale := FieldDesc.Scale;
      end;
      dtTime: begin
        FDateFormat := 'hh24:mi:ss';
      end;
      dtDate: begin
        FDateFormat := 'dd.mm.yyyy';
      end;
      dtDateTime:
        FDateFormat := 'dd.mm.yyyy hh24:mi:ss';
      {$IFDEF VER6P}{$IFNDEF FPC}dtSQLTimeStamp,{$ENDIF}{$ENDIF}
      dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ:
        FDateFormat := 'dd.mm.yyyy hh24:mi:ss';
    end;

    FIsNational := TOCIFieldDesc(FieldDesc).IsNational;
  end;
end;

function TOCILoader.ConverToUnicode(Column: TOCILoaderColumn): boolean;
begin
  // Loader allows to use Unicode for Oracle 11 client and higher
  Result := (Column.DataType in [dtString, dtWideString,
                                 dtFixedChar, dtFixedWideChar,
                                 dtOraClob, dtNClob, dtWideOraClob]) and
            (FConnection.FOracleVersion >= 11000) and
            FConnection.FUseUnicode {and Column.IsNational};
end;

procedure TOCILoader.CheckLobBuffer;
begin
  if FLobBuffer = nil then
    FLobBuffer := TList.Create;
end;

procedure TOCILoader.ClearLobBuffer;
var
  i: integer;
begin
  if FLobBuffer <> nil then begin
    for i := 0 to FLobBuffer.Count - 1 do
      Marshal.FreeHGlobal(IntPtr(FLobBuffer.Items[i]));
    FLobBuffer.Clear;
  end;
end;

procedure TOCILoader.FreeLobBuffer;
begin
  if FLobBuffer <> nil then begin
    ClearLobBuffer;
    FLobBuffer.Free;
    FLobBuffer := nil;
  end;
end;

{ TOCIAlerter }

constructor TOCIAlerter.Create;
begin
  inherited;

  FListenConnection := TOCIConnection.Create;
  FWaitCommand := FListenConnection.CreateCommand;
{$IFDEF MSWINDOWS}
  FResponseEvent := TEvent.Create(nil, True, False, '');
  FIntervalEvent := TEvent.Create(nil, True, False, '');
{$ENDIF}

  FTimeOut := -1;
  FInterval := 0;
  FEventType := _etAlert;
  FSelfMessage := msBlank;
  FAutoCommit := True;
  FSelfEvents := True;
end;

destructor TOCIAlerter.Destroy;
begin
  Stop;

  FWaitCommand.Free;
  FListenConnection.Free;
{$IFDEF MSWINDOWS}
  FResponseEvent.Free;
  FIntervalEvent.Free;
{$ENDIF}

  if FGCHandle <> nil then
    FreeGCHandle(FGCHandle);

  inherited;
end;

function TOCIAlerter.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prAutoCommit:
      FAutoCommit := Value;
    prAlerterTimeout:
      FTimeOut := Value;
    prAlerterInterval:
      FInterval := Value;
    prAlerterEventType:
      FEventType := _TEventType(Value);
    prAlerterSelfEvents:
      FSelfEvents := Value;
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TOCIAlerter.GetProp(Prop: integer; var Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prAutoCommit:
      Value := FAutoCommit;
    prAlerterTimeout:
      Value := FTimeOut;
    prAlerterInterval:
      Value := FInterval;
    prAlerterEventType:
      Value := Variant(FEventType);
    prAlerterSelfEvents:
      Value := FSelfEvents;
  else
    Result := inherited GetProp(Prop, Value);
  end;
end;

procedure TOCIAlerter.SendEvent(const EventName, Message: string);
begin
  case FEventType of
    _etAlert: begin
      SendAlertMessage(EventName, Message);
   end;
    _etPipe: begin
      PackMessage(Message);
      SendPipeMessage(EventName);
    end;
  end;
end;

procedure TOCIAlerter.Start;
var
  Name: string;
  i: integer;
  SQL: string;
begin
  if FActive then
    exit;

  Assert(FEventNames.Count > 0);

{$IFDEF MSWINDOWS}
  AllocODACWnd;
{$ENDIF}

  FListenConnection.Assign(TOCIConnection(FConnection));
  FListenConnection.OnError := nil;
  FListenConnection.Connect('');

  if (FEventType = _etAlert) and not FRegistered then
    RegisterEvents;

  case FEventType of
    _etAlert: begin
      SQL := '';
      if OCISvcCtx.Home.OCIVersion div 10 = 805 then begin  // fix Oracle 8.0.5 bug that unregister events, need to check server version
        for i := 0 to FEventNames.Count - 1 do begin
          Name := Trim(FEventNames[i]);
          SQL := SQL + '  DBMS_ALERT.Register(''' + Name + ''');' + DALineSeparator;
        end;
      end;

      FWaitCommand.SetSQL('begin ' + SQL + 'DBMS_ALERT.WaitAny(:Name, :Message, :Status, :TimeOut); end;');
      with FWaitCommand.Params[0] do begin
        SetParamType(pdOutput);
        SetSize(TOCIConnection(FConnection).GetMaxStringSize);
        if TOCIConnection(FConnection).FUseUnicode then
          SetDataType(dtWideString)
        else
          SetDataType(dtString);
      end;
      with FWaitCommand.Params[1] do begin
        SetParamType(pdOutput);
        SetSize(TOCIConnection(FConnection).GetMaxStringSize);
        if TOCIConnection(FConnection).FUseUnicode then
          SetDataType(dtWideString)
        else
          SetDataType(dtString);
      end;
      with FWaitCommand.Params[2] do begin
        SetParamType(pdOutput);
        SetDataType(dtInteger);
      end;
      with FWaitCommand.Params[3] do begin
        SetParamType(pdInput);
        SetDataType(dtInteger);
        if FTimeOut >= 0 then
          Value := FTimeOut
        else
          Value := 86400000; // 1000 days
      end;
    end;
    _etPipe: begin
      FWaitCommand.SetSQL('begin :Status := DBMS_PIPE.Receive_Message(:Name, :TimeOut); end;');

      with FWaitCommand.Params[0] do begin
        SetParamType(pdOutput);
        SetDataType(dtInteger);
      end;

      // get first pipe from list
      Name := FEventNames[0];

      with FWaitCommand.Params[1] do begin
        SetParamType(pdInput);
        if TOCIConnection(FConnection).FUseUnicode then begin
          SetDataType(dtWideString);
          SetSize(Length(WideString(Name)));
        end
        else begin
          SetDataType(dtString);
          SetSize(Length(AnsiString(Name)));
        end;
        Value := Name;
      end;
      with FWaitCommand.Params[2] do begin
        SetParamType(pdInput);
        SetDataType(dtInteger);
        if FTimeOut >= 0 then
          Value := FTimeOut
        else
          Value := 86400000; // 1000 days
      end;
    end;
  end;

  FActive := True;
  try
    FWaitCommand.Prepare;

    FListenThread := TOCIAlerterListenThread.Create(Self);
  except
    FActive := False;
    raise;
  end;
end;

procedure TOCIAlerter.Stop;
begin
  if FActive then begin
    FActive := False;

    try
      FListenThread.Terminate;
    finally
      FListenThread.WaitFor;
      FreeAndNil(FListenThread);
    end;

    try
      try
        FWaitCommand.UnPrepare;
        if FEventType = _etAlert then
          RemoveEvents;
      finally
        FListenConnection.Disconnect;
      end;
    except
    end;
  end;
end;

procedure TOCIAlerter.PackMessage(const Item: variant);
var
  Command: TOCICommand;
begin
  if (FEventType = _etPipe) and (Item <> Null) then begin
    Command := TOCIConnection(FConnection).GetCommand;

    Command.SetSQL('begin DBMS_PIPE.Pack_Message(:Item); end;');

    with Command.Params[0] do begin
      SetParamType(pdInput);
      SetDataType(dtUnknown);
      Value := Item;
    end;

    Command.Execute;
  end;
end;

procedure TOCIAlerter.UnpackMessage(var Item: variant);
var
  Command: TOCICommand;
  DataType: word;
  Size: integer;
begin
  Size := 0;
  case NextItemType of
    mtNone: begin
      Item := Null;
      Exit;
    end;
    mtNumber:
      DataType := dtFloat;
    mtString: begin
      if TOCIConnection(FListenConnection).FUseUnicode then
        DataType := dtWideString
      else
        DataType := dtString;
      Size := TOCIConnection(FListenConnection).GetMaxStringSize;
    end;
    mtDate:
      DataType := dtDateTime;
  else
    DataType := dtString;
  end;

  Command := TOCIConnection(FListenConnection).GetCommand;

  Command.SetSQL('begin DBMS_PIPE.Unpack_Message(:Item); end;');

  with Command.Params[0] do begin
    SetParamType(pdOutput);
    SetDataType(DataType);
    SetSize(Size);
  end;

  Command.Execute;

  Item := Command.Params[0].GetValue;
end;

function TOCIAlerter.NextItemType: TMessageType;
var
  Command: TOCICommand;
  Res: integer;
begin
  Command := TOCIConnection(FListenConnection).GetCommand;

  Command.SetSQL('begin :Result := DBMS_PIPE.Next_Item_Type; end;');

  with Command.Params[0] do begin
    SetParamType(pdOutput);
    SetDataType(dtInteger);
  end;

  Command.Execute;

  Res := Command.Params[0].GetValue;
  case Res of
    0: Result := mtNone;
    6: Result := mtNumber;
    9: Result := mtString;
    12: Result := mtDate;
  else
    Result := mtNone;
  end;
end;

procedure TOCIAlerter.SendPipeMessage(const Name: string);
var
  Command: TOCICommand;
  Res: integer;
  AName: string;
begin
  Assert(FEventNames.Count > 0);

  AName := Name;
  if AName = '' then
    AName := FEventNames[0];

  Command := TOCIConnection(FConnection).GetCommand;

  Command.SetSQL('begin :Result := DBMS_PIPE.Send_Message(:Name); end;');

  with Command.Params[0] do begin
    SetParamType(pdOutput);
    SetDataType(dtInteger);
  end;
  with Command.Params[1] do begin
    SetParamType(pdInput);
    if TOCIConnection(FConnection).FUseUnicode then begin
      SetDataType(dtWideString);
      SetSize(Length(WideString(AName)));
    end
    else begin
      SetDataType(dtString);
      SetSize(Length(AnsiString(AName)));
    end;
    Value := AName;
  end;

  Command.Execute;

  Res := Command.Params[0].GetValue;
  if Res <> 0 then
    raise Exception.Create(SAlerterSendFailed);
end;

procedure TOCIAlerter.PurgePipe;
var
  Command: TOCICommand;
  AName: string;
begin
  Assert(FEventNames.Count > 0);

  AName := FEventNames[0];

  Command := TOCIConnection(FConnection).GetCommand;

  Command.SetSQL('begin :Result := DBMS_PIPE.Purge(:Name); end;');

  with Command.Params[0] do begin
    SetParamType(pdOutput);
    SetDataType(dtInteger);
  end;
  with Command.Params[1] do begin
    SetParamType(pdInput);
    if TOCIConnection(FConnection).FUseUnicode then begin
      SetDataType(dtWideString);
      SetSize(Length(WideString(AName)));
    end
    else begin
      SetDataType(dtString);
      SetSize(Length(AnsiString(AName)));
    end;
    Value := AName;
  end;

  Command.Execute;
end;

function TOCIAlerter.GetGCHandle: IntPtr;
begin
  if FGCHandle = nil then
    FGCHandle := AllocGCHandle(Self);
  Result := FGCHandle;
end;

function TOCIAlerter.GetOCISvcCtx: TOCISvcCtx;
begin
  Result := TOCIConnection(FConnection).OCISvcCtx;
end;

procedure TOCIAlerter.RegisterEvents;
var
  Name: string;
  i: integer;
  SQL: string;
  Command: TOCICommand;
begin
  Assert(FEventNames.Count > 0);

  if FEventType = _etAlert then begin
    SQL := '';
    for i := 0 to FEventNames.Count - 1 do begin
      Name := Trim(FEventNames[i]);
      SQL := SQL + '  DBMS_ALERT.Register(''' + Name + ''');' + DALineSeparator;
    end;

    Command := TOCIConnection(FListenConnection).GetCommand;
    Command.SetSQL('begin' + DALineSeparator + SQL + 'end;');
    try
      Command.Execute;
    except
      on E: EOraError do begin
        if E.ErrorCode = 6550 then
          raise EOraError.Create(E.ErrorCode,
            'Please execute GRANT EXECUTE ON DBMS_ALERT TO ' +
            FConnection.GetUsername + ' as SYS' + DALineSeparator + DALineSeparator + E.Message);
        raise;
      end;
    end;
  end;
  FRegistered := True;
end;

procedure TOCIAlerter.RemoveEvents;
var
  Name: string;
  i: integer;
  SQL: string;
  Command: TOCICommand;
begin
  Assert(FEventNames.Count > 0);

  FRegistered := False;
  if FEventType = _etAlert then begin
    SQL := '';
    for i := 0 to FEventNames.Count - 1 do begin
      Name := Trim(FEventNames[i]);
      SQL := SQL + '  DBMS_ALERT.Remove(''' + Name + ''');' + DALineSeparator;
    end;

    Command := TOCIConnection(FListenConnection).GetCommand;
    Command.SetSQL('begin' + DALineSeparator + SQL + 'end;');
    Command.Execute;
  end;
end;

procedure TOCIAlerter.SendAlertMessage(const EventName, Message: string);
var
  Command: TOCICommand;
begin
  if not FSelfEvents then
    FSelfMessage := Message;
  Command := TOCIConnection(FConnection).GetCommand;
  Command.SetSQL('begin DBMS_ALERT.Signal(:Name, :Message); end;');

  with Command.Params[0] do begin
    SetParamType(pdInput);
    if TOCIConnection(FConnection).FUseUnicode then begin
      SetDataType(dtWideString);
      SetSize(Length(WideString(EventName)));
    end
    else begin
      SetDataType(dtString);
      SetSize(Length(AnsiString(EventName)));
    end;
    Value := EventName;
  end;

  with Command.Params[1] do begin
    SetParamType(pdInput);
    if TOCIConnection(FConnection).FUseUnicode then begin
      SetDataType(dtWideString);
      SetSize(Length(WideString(Message)));
    end
    else begin
      SetDataType(dtString);
      SetSize(Length(AnsiString(Message)));
    end;
    Value := Message;
  end;

  Command.Execute;

  if FAutoCommit and TOCIConnection(FConnection).AutoCommit then
    FConnection.GetInternalTransaction.Commit;
end;

function TOCIAlerter.ProcessWaitResult: boolean;
var
  Status: integer;
begin
  Status := FWaitCommand.Params.ParamByName('Status').GetValue;
  if Status = 0 then begin
    ProcessMessage;
    Result := True;
  end
  else
    Result := ProcessError(Status);
end;

procedure TOCIAlerter.ProcessMessage;
var
  Event: TAlertEvent;
  Item: variant;
begin
  Event := TAlertEvent.Create;
  try
    case FEventType of
      _etAlert: begin
        Event.Name := VarToStr(FWaitCommand.Params.ParamByName('Name').GetValue);
        Event.Message := VarToStr(FWaitCommand.Params.ParamByName('Message').GetValue);
      end;
      _etPipe: begin
        Event.Name := FEventNames[0];
        UnpackMessage(Item);
        Event.Message := VarToStr(Item);
      end;
    end;

    if Event.Message = FSelfMessage then begin
      FSelfMessage := msBlank;
      Event.Free;
    end
    else
    if Event.Message = msTerminate then begin
      Event.Free;
    end
    else begin
    {$IFDEF MSWINDOWS}
      FResponseEvent.ResetEvent;
      PostMessage(hODACWindow, WM_ALERTER_EVENT, WPARAM(GCHandle),
        LPARAM(AllocGCHandle(Event)));
      FResponseEvent.WaitFor(INFINITE);
    {$ELSE}
      try
        CallEvent(Event);
      finally
        Event.Free;
      end;
    {$ENDIF}
    end;

  except
    Event.Free;
    raise;
  end;
end;

function TOCIAlerter.ProcessError(Status: integer): boolean;
begin
  if Status = 1 then begin
    if FTimeOut >= 0 then begin
      Result := False;
    {$IFDEF MSWINDOWS}
      FResponseEvent.ResetEvent;
      PostMessage(hODACWindow, WM_ALERTER_TIMEOUT, WPARAM(GCHandle),
        LPARAM({$IFNDEF CLR}@Result{$ELSE}0{$ENDIF}));
      FResponseEvent.WaitFor(INFINITE);
    {$ELSE}
      DoOnTimeout(Result);
    {$ENDIF}
    end
    else
      Result := True;
  end
  else
    raise Exception.CreateFmt(SAlerterReceiveFailed, [Status]);
end;

{$IFDEF MSWINDOWS}
procedure TOCIAlerter.DoOnEvent(const EnentName, Message: string);
begin
  if Assigned(OnEvent) then
    OnEvent(EnentName, Message);
end;
{$ELSE}
procedure TOCIAlerter.DoOnEvent;
begin
  Assert(Assigned(OnEvent) and (FLastEvent <> nil));
  OnEvent(FLastEvent.Name, FLastEvent.Message);
end;

procedure TOCIAlerter.CallEvent(Event: TAlertEvent);
begin
  if Assigned(OnEvent) then begin
    FLastEvent := Event;
    try
      FListenThread.Synchronize(DoOnEvent);
    finally
      FLastEvent := nil;
    end;
  end;
end;
{$ENDIF}

procedure TOCIAlerter.DoOnTimeout(var Continue: boolean);
begin
  if Assigned(OnTimeout) then
    OnTimeout(Continue);
end;

{$IFDEF MSWINDOWS}
procedure TOCIAlerter.DoOnError(E: Exception);
begin
  if Assigned(OnError) then
    OnError(E);
end;
{$ENDIF}

{ TOCIAlerterListenThread }

constructor TOCIAlerterListenThread.Create(Alerter: TOCIAlerter);
begin
  inherited Create(True);

  FAlerter := Alerter;
  Resume;
end;

procedure TOCIAlerterListenThread.Terminate;
var
  Event: string;
begin
  inherited Terminate;

{$IFDEF MSWINDOWS}
  FAlerter.FResponseEvent.SetEvent;
  FAlerter.FIntervalEvent.SetEvent;
{$ENDIF}

  Event := FAlerter.EventNames[0];

  {if csDestroying in FSession.ComponentState then begin
    // force stopping on application exit
    if FWaitCommand.Executing then
      FWaitCommand.BreakExec;
  end
  else}
    FAlerter.SendEvent(Event, msTerminate);
    if (FAlerter.FEventType = _etAlert) and
      not (FAlerter.FAutoCommit and TOCIConnection(FAlerter.Connection).AutoCommit)
    then
      FAlerter.Connection.GetInternalTransaction.Commit;

  {$IFDEF WIN32_64}
    if WaitForSingleObject(Handle, 1000) = WAIT_TIMEOUT	then
      FAlerter.FListenConnection.BreakExec;
  {$ENDIF}
end;

procedure TOCIAlerterListenThread.Execute;
var
  Continue: boolean;
begin
  try
    repeat
      FAlerter.FWaitCommand.Execute;

      if not Terminated then begin
        Continue := FAlerter.ProcessWaitResult;

        if not Continue and not Terminated then begin
          if FAlerter.FInterval > 0 then
          {$IFDEF MSWINDOWS}
          begin
            FAlerter.FIntervalEvent.ResetEvent;
            FAlerter.FIntervalEvent.WaitFor(FAlerter.FInterval * 1000);
            Continue := not Terminated;
          end
          else
            PostMessage(hODACWindow, WM_ALERTER_STOPED, WPARAM(FAlerter.GCHandle), 0);
          {$ELSE}
          begin
            Sleep(FAlerter.FInterval * 1000);
            Continue := not Terminated;
          end;
          {$ENDIF}
        end;
      end
      else
        Continue := False;

    until not Continue;
  except
  {$IFDEF MSWINDOWS}
    on E: Exception do begin
      if not Terminated then begin
      {$IFDEF VER6P}
      {$IFNDEF CLR}
        AcquireExceptionObject;
      {$ENDIF}
        PostMessage(hODACWindow, WM_ALERTER_STOPED, WPARAM(FAlerter.GCHandle),
          LPARAM(AllocGCHandle(E)));
      {$ELSE}
        PostMessage(hODACWindow, WM_ALERTER_STOPED, WPARAM(FAlerter.GCHandle), 0);
      {$ENDIF}
      end;
    end;
  {$ENDIF}
  end;
end;

{$ENDIF}

{ TOraClassesUtils }

class procedure TOraClassesUtils.InternalUnPrepare(Obj: TOCIRecordSet);
begin
  Obj.InternalUnPrepare;
end;

{$IFDEF CLR}
function GetLocaleStr(Locale, LocaleType: Integer; const Default: string): string;
var
  L: Integer;
  Buffer: StringBuilder;
begin
  Buffer := StringBuilder.Create(1024);
  L := GetLocaleInfo(Locale, LocaleType, Buffer, Buffer.Capacity);
  if L > 0 then Result := Buffer.ToString else Result := Default;
end;
{$ENDIF}

{$IFDEF FPC}
function GetLocaleStr(Locale, LocaleType: Integer; const Default: string): string;
{$IFDEF MSWINDOWS}
var
  L: Integer;
  Buffer: array[0..255] of Char;
begin
  L := GetLocaleInfo(Locale, LocaleType, Buffer, SizeOf(Buffer));
  if L > 0 then SetString(Result, Buffer, L - 1) else Result := Default;
end;
{$ENDIF}
{$IFNDEF MSWINDOWS}
begin
  Result := Default;
end;
{$ENDIF}
{$ENDIF}

procedure ParseConnectString(const ConnectString: string;
  var Username, Password, Server: string; var ConnectMode: TConnectMode);
var
  i, p, Mode: integer;
  s: string;
  c: Char;
  Quoted: boolean;
begin
  Username := '';
  Password := '';
  Server := '';
  ConnectMode := cmNormal;

  // 1. bypass blanks
  // 2. go to the end of name
  // 3. go to delimiter ('/', '@') and detect next mode

  Mode := 0;
  i := 1;
  while True do begin
    // 1.
    while (i <= Length(ConnectString)) and (ConnectString[i] = ' ') do
      Inc(i);
    if i > Length(ConnectString) then
      exit;

    // 2.
    p := i;
    Quoted := ConnectString[i] = '"';
    if Quoted then begin
      Inc(i);
      while i <= Length(ConnectString) do begin
        c := ConnectString[i];
        Inc(i);
        if c = '"' then
          break;
      end;
    end
    else begin
      while i <= Length(ConnectString) do begin
        case ConnectString[i] of
          ' ', '"':
            break;
          '/', '@':
            if Mode < 2 then
              // Server can contain any characters except space and "
              break;
        end;
        Inc(i);
      end
    end;

    s := Copy(ConnectString, p, i - p);
    case Mode of
      0:
        Username := s;
      1:
        Password := OCISQLInfo.UnQuote(s); // Password is case-insensitive; Direct mode doen't support quotes
      2:
        Server := OCISQLInfo.UnQuote(s); // Quoted server name is not supported by OCI
      3: begin
        s := UpperCase(s);
        if s = 'SYSDBA' then
          ConnectMode := cmSysDBA
        else
        if s = 'SYSOPER' then
          ConnectMode := cmSysOper
        else
        if s = 'SYSASM' then
          ConnectMode := cmSysASM
        else
        if s = 'SYSBACKUP' then
          ConnectMode := cmSysBkp
        else
        if s = 'SYSDG' then
          ConnectMode := cmSysDG
        else
        if s = 'SYSKM' then
          ConnectMode := cmSysKM
        else
          RaiseError(SInvalidConnectString);
      end;
    end;

    // 3.
    p := i;
    while (i <= Length(ConnectString)) and (ConnectString[i] = ' ') do
      Inc(i);
    if i > Length(ConnectString) then
      exit;
    if (Mode < 1) and (ConnectString[i] = '/') then
      Mode := 1
    else
    if (Mode < 2) and (ConnectString[i] = '@') then
      Mode := 2
    else
    // at least one space must be before and after AS
    if (Mode < 3) and (i > p) and (UpperCase(Copy(ConnectString, i, 3)) = 'AS ') then
      Mode := 3
    else
      exit;
    if Mode = 3 then
      Inc(i, 3)
    else
      Inc(i);
  end;
end;

{$IFDEF CLR}
var
  OCICallbackDefineCode : array[0..51] of byte =
    ($55, $8B, $EC, $51,
    $8B, $45, $24, $50,
    $8B, $45, $20, $50,
    $8B, $45, $1C, $50,
    $8B, $45, $18, $50,
    $8B, $45, $14, $50,
    $8B, $45, $10, $50,
    $8B, $45, $C, $50,
    $8B, $45, $8, $50,

    $B8, $00, $00, $00, $00,
    $FF, $D0,
    $89, $45, $FC,
    $8B, $45, $FC,
    $59,
    $5D,
    $C3);

  OCICallbackInBindCode : array[0..51] of byte =
    ($55,
    $8B, $EC,
    $51,
    $8B, $45, $24, $50,
    $8B, $45, $20, $50,
    $8B, $45, $1C, $50,
    $8B, $45, $18, $50,
    $8B, $45, $14, $50,
    $8B, $45, $10, $50,
    $8B, $45, $C, $50,
    $8B, $45, $8, $50,

    $B8, $00, $00, $00, $00,
    $FF, $D0,
    $89, $45, $FC,
    $8B, $45, $FC,
    $59,
    $5D,
    $C3);

  OCICallbackOutBindCode : array[0..55] of byte =
    ($55,
    $8B, $EC,
    $51,
    $8B, $45, $28, $50,
    $8B, $45, $24, $50,
    $8B, $45, $20, $50,
    $8B, $45, $1C, $50,
    $8B, $45, $18, $50,
    $8B, $45, $14, $50,
    $8B, $45, $10, $50,
    $8B, $45, $C, $50,
    $8B, $45, $8, $50,

    $B8, $00, $00, $00, $00,
    $FF, $D0,

    $89, $45, $FC,
    $8B, $45, $FC,

    $59,
    $5D,
    $C3);

  OCICallbackFailoverCode : array[0..39] of byte =
    ($55,
    $8B, $EC,
    $51,
    $8B, $45, $18, $50,
    $8B, $45, $14, $50,
    $8B, $45, $10, $50,
    $8B, $45, $C, $50,
    $8B, $45, $8, $50,

    $B8, $00, $00, $00, $00,
    $FF, $D0,

    $89, $45, $FC,
    $8B, $45, $FC,

    $59,
    $5D,
    $C3);

  OCISubscriptionNotifyCode : array[0..43] of byte =
    ($55,
    $8B, $EC,
    $51,
    $8B, $45, $1C, $50,
    $8B, $45, $18, $50,
    $8B, $45, $14, $50,
    $8B, $45, $10, $50,
    $8B, $45, $C, $50,
    $8B, $45, $8, $50,
    $B8, $00, $00, $00, $00,
    $FF, $D0,
    $89, $45, $FC,
    $8B, $45, $FC,
    $59,
    $5D,
    $C3);


var
  DefineRec: packed record
    Ptr: TOCICallbackDefine;
  end;
  InBindRec: packed record
    Ptr: TOCICallbackInBind;
  end;
  OutBindRec: packed record
    Ptr: TOCICallbackOutBind;
  end;
  FailoverRec: packed record
    Ptr: TOCICallbackFailover;
  end;
  ChangeNotifyRec: packed record
    Ptr: TOCISubscriptionNotify;
  end;
  CallbackRecPtr: IntPtr;
{$ENDIF}

initialization
{$IFNDEF MSWINDOWS}
  hLockConnect := TCriticalSection.Create;
{$ENDIF}
  OCISQLInfo := TOCISQLInfo.Create(nil);
  OCIConnections := TConnectionList.Create;

{$IFDEF CLR}
  OCICallbackDefinePtr := Marshal.AllocHGlobal(Length(OCICallbackDefineCode));
  Marshal.Copy(TBytes(OCICallbackDefineCode), 0, OCICallbackDefinePtr, Length(OCICallbackDefineCode));

  OCICallbackInBindPtr := Marshal.AllocHGlobal(Length(OCICallbackInBindCode));
  Marshal.Copy(TBytes(OCICallbackInBindCode), 0, OCICallbackInBindPtr, Length(OCICallbackInBindCode));

  OCICallbackOutBindPtr := Marshal.AllocHGlobal(Length(OCICallbackOutBindCode));
  Marshal.Copy(TBytes(OCICallbackOutBindCode), 0, OCICallbackOutBindPtr, Length(OCICallbackOutBindCode));

  OCICallbackFailoverPtr := Marshal.AllocHGlobal(Length(OCICallbackFailoverCode));
  Marshal.Copy(TBytes(OCICallbackFailoverCode), 0, OCICallbackFailoverPtr, Length(OCICallbackFailoverCode));

  OCICallbackChangeNotifyPtr := Marshal.AllocHGlobal(Length(OCISubscriptionNotifyCode));
  Marshal.Copy(TBytes(OCISubscriptionNotifyCode), 0, OCICallbackChangeNotifyPtr, Length(OCISubscriptionNotifyCode));

  CallbackRecPtr := Marshal.AllocHGlobal(20);
  try
    DefineRec.Ptr := OCICallbackDefine;
    HOCICallbackDefine := GCHandle.Alloc(@DefineRec.Ptr, GCHandleType.Normal);
    Marshal.StructureToPtr(DefineRec, CallbackRecPtr, False);
    Marshal.WriteIntPtr(OCICallbackDefinePtr, 37, Marshal.ReadIntPtr(CallbackRecPtr));

    InBindRec.Ptr := OCICallbackInBind;
    HOCICallbackInBind := GCHandle.Alloc(@InBindRec.Ptr, GCHandleType.Normal);
    Marshal.StructureToPtr(InBindRec, CallbackRecPtr, False);
    Marshal.WriteIntPtr(OCICallbackInBindPtr, 37, Marshal.ReadIntPtr(CallbackRecPtr));

    OutBindRec.Ptr := OCICallbackOutBind;
    HOCICallbackOutBind := GCHandle.Alloc(@OutBindRec.Ptr, GCHandleType.Normal);
    Marshal.StructureToPtr(OutBindRec, CallbackRecPtr, False);
    Marshal.WriteIntPtr(OCICallbackOutBindPtr, 41, Marshal.ReadIntPtr(CallbackRecPtr));

    FailoverRec.Ptr := OCICallbackFailover;
    HOCICallbackFailover := GCHandle.Alloc(@FailoverRec.Ptr, GCHandleType.Normal);
    Marshal.StructureToPtr(FailoverRec, CallbackRecPtr, False);
    Marshal.WriteIntPtr(OCICallbackFailoverPtr, 25, Marshal.ReadIntPtr(CallbackRecPtr));

    ChangeNotifyRec.Ptr := OCICallbackChangeNotify;
    HOCICallbackChangeNotify := GCHandle.Alloc(@ChangeNotifyRec.Ptr, GCHandleType.Normal);
    Marshal.StructureToPtr(ChangeNotifyRec, CallbackRecPtr, False);
    Marshal.WriteIntPtr(OCICallbackChangeNotifyPtr, 29, Marshal.ReadIntPtr(CallbackRecPtr));

    HWndProc := GCHandle.Alloc(@WndClass.lpfnWndProc, GCHandleType.Normal);
  finally
    Marshal.FreeHGlobal(CallbackRecPtr);
  end;
{$ELSE}
  OCICallbackDefinePtr := @OCICallbackDefine;
  OCICallbackInBindPtr := @OCICallbackInBind;
  OCICallbackOutBindPtr := @OCICallbackOutBind;
  OCICallbackFailoverPtr := @OCICallbackFailover;
{$IFDEF MSWINDOWS}
  OCICallbackChangeNotifyPtr := @OCICallbackChangeNotify;
{$ENDIF}
{$ENDIF}

finalization
  if OCIConnections <> nil then begin
    OCIConnections.DisconnectAll;
    OCIConnections.Free;
    OCIConnections := nil;
  end;

  if GlobalBuf <> nil then
    Marshal.FreeHGlobal(GlobalBuf);
{$IFNDEF MSWINDOWS}
  hLockConnect.Free;
{$ENDIF}
  OCISQLInfo.Free;
{$IFDEF MSWINDOWS}
  if hODACWindow <> 0 then
    DestroyWindow(hODACWindow);
{$ENDIF}

{$IFDEF CLR}
  HOCICallbackDefine.Free;
  HOCICallbackInBind.Free;
  HOCICallbackOutBind.Free;
  HOCICallbackFailover.Free;
  HOCICallbackChangeNotify.Free;
  HWndProc.Free;
  Marshal.FreeHGlobal(OCICallbackDefinePtr);
  Marshal.FreeHGlobal(OCICallbackInBindPtr);
  Marshal.FreeHGlobal(OCICallbackOutBindPtr);
  Marshal.FreeHGlobal(OCICallbackFailoverPtr);
  Marshal.FreeHGlobal(OCICallbackChangeNotifyPtr);
{$ENDIF}

end.
