PageRenderTime 55ms CodeModel.GetById 40ms app.highlight 6ms RepoModel.GetById 1ms app.codeStats 0ms

/EndTask/2008.04.16 ?????/Oracle Data Access Components(ODAC) v6/Source/OraClasses.pas

http://xinhaining-dianjianyiqi-tongxunchengxu.googlecode.com/
Pascal | 2090 lines | 1557 code | 330 blank | 203 comment | 78 complexity | 9d5a9360d91c8ba693baba823cef1d02 MD5 | raw file

Large files files are truncated, but you can click here to view the full file

   1//////////////////////////////////////////////////
   2//  Oracle Data Access Components
   3//  Copyright Š 1998-2006 Core Lab. All right reserved.
   4//  Oracle Classes
   5//  Created:            01.03.98
   6//  Last modified:      16.03.04
   7//////////////////////////////////////////////////
   8
   9{$IFNDEF CLR}
  10{$I Odac.inc}
  11unit OraClasses;
  12{$ENDIF}
  13{$J+}
  14{$DEFINE _LOCAL_ERROR_HANDLE}  // LOCAL_ERROR_HANDLE
  15{$IFDEF VER6P}
  16{$WARN SYMBOL_PLATFORM OFF}
  17{$ENDIF}
  18
  19interface
  20uses
  21{$IFDEF MSWINDOWS}
  22  Windows, Messages,
  23{$ENDIF}
  24{$IFDEF CLR}
  25  Variants, WinUtils,
  26{$ELSE}
  27  CLRClasses,
  28{$ENDIF}
  29{$IFDEF LITE}
  30  FMTBcd,
  31{$ENDIF}
  32  SysUtils, Classes, SyncObjs, MemData, OraCall, OraError, CRAccess, MemUtils;
  33
  34const
  35  dtRowId         = 100;
  36  dtCursor        = 101;
  37  dtOraBlob       = 102;
  38  dtOraClob       = 103;
  39  dtBFILE         = 104;
  40  dtCFILE         = 105;
  41  dtLabel         = 106;  // MLSLABEL
  42  dtFixedChar     = 107;
  43  dtUndefined     = 108;
  44  dtTimeStamp     = 109;
  45  dtTimeStampTZ   = 110;
  46  dtTimeStampLTZ  = 111;
  47  dtIntervalYM    = 112;
  48  dtIntervalDS    = 113;
  49  dtURowId        = 114;
  50  dtNumber        = 115;
  51  dtXML           = 116;
  52  dtFixedWideChar = 117;
  53  dtBFloat        = 118;
  54  dtBDouble       = 119;
  55  dtNString       = 120;
  56  dtNWideString   = 121;
  57  dtNClob         = 122;
  58
  59// obsolete
  60  dtBLOBLocator = dtOraBlob;
  61  dtCLOBLocator = dtOraClob;
  62
  63// Props
  64  prNonBlocking       = 50; // bool
  65  prThreadSafety      = 51; // bool
  66  prAutoClose         = 55; // bool
  67  prErrorOffset       = 57; // word
  68  prMaxStringSize     = 58; // word
  69  prFieldsAsString    = 59; // bool
  70  prDateFormat        = 60; // string
  71  prDeferredLobRead   = 61; // bool
  72  prConnectMode       = 62; // enum
  73  prCharLength        = 63; // word
  74  prCacheLobs         = 64; // bool
  75  prEnableIntegers    = 65; // bool
  76  prInternalName      = 66; // string
  77  prScrollableCursor  = 67; // bool
  78  prStoreRowId        = 68; // bool
  79  prCharset           = 69; // word
  80  prDateLanguage      = 70; // string
  81  prTimeStampFormat   = 71; // string
  82  prTimeStampTZFormat = 72; // string
  83  prRawAsString       = 73; // bool
  84  prNumberAsString    = 74; // bool
  85  prNumericCharacters = 75; // string
  86  prEnableNumbers     = 76; // bool
  87  prUseUnicode        = 77; // bool
  88  prIntegerPrecision  = 78; // word;
  89  prFloatPrecision    = 79; // word;
  90  prTemporaryLobUpdate= 82; // bool
  91  prDisconnectMode    = 84; // bool
  92  prInactiveTimeout   = 85; // integer
  93  prResumeTimeout     = 86; // integer
  94  prGlobalCoordinator = 87; // integer
  95  prTransactionName   = 88; // string
  96  prIsolationLevel    = 89; // integer
  97  prDefaultCloseAction= 90; // integer
  98  prConnectionTimeOut = 91; // integer
  99  prHasObjectFields   = 92; // bool
 100  prStatementCache    = 93; // bool
 101  prStatementCacheSize= 94; // integer
 102  prEnabled           = 95; // bool
 103  prTimeout           = 96; // integer
 104  prPersistent        = 97; // bool
 105  prOperations        = 98; // set
 106
 107  RowIdSize = 18;
 108
 109  MaxBlobSize: longint = 2147483647;
 110
 111  MaxTransactionIdLength = 64; // Maximum length for TransactionId and BranchQualifier
 112
 113type
 114  TOraCursor = class;
 115  TOraLob = class;
 116  TOraFile = class;
 117  TOraTimeStamp = class;
 118  TOraInterval = class;
 119  TOraNumber = class;
 120  TOraParamDesc = class;
 121  TOCICommand = class;
 122{$IFNDEF LITE}
 123  TOCITransaction = class;
 124{$ENDIF}
 125
 126{ OraAccess level }
 127
 128  TTransactionMode = (tmReadOnly, tmReadWrite, tmReadCommitted, tmSerializable);
 129  TErrorProc = procedure (E: EOraError; var Fail: boolean) of object;
 130  TConnectMode = (cmNormal, cmSysOper, cmSysDBA);
 131
 132{ TOraParamDesc }
 133
 134  TOraParamDesc = class (TParamDesc)
 135  private
 136    FValue: IntPtr;
 137    FActualLengthPtr: IntPtr;
 138    FDefIndicator: IntPtr;
 139    FIndicator: IntPtr;
 140    FTable: boolean;
 141    FLength: integer;  // Table Length
 142    FHandle: IntPtr;
 143    FBindBufferSize: integer;
 144    FBlobPiece: integer;  // number of piece
 145    FQuotedName: boolean;
 146    FLen: integer;
 147    FTableIndicator: boolean;
 148    FNational : boolean;
 149    FHasDefault: boolean;
 150
 151    function GetActualLength: integer;
 152    procedure SetActualLength(Value: integer);
 153    property ActualLength: integer read GetActualLength write SetActualLength;
 154
 155  protected
 156    procedure AllocBuffer;
 157    procedure FreeBuffer;
 158
 159    procedure CheckRange(Index: integer);
 160
 161    property Name;
 162    property DataType;
 163    property ParamType;
 164    property Size;
 165
 166    procedure ClearBindData;
 167
 168  public
 169    constructor Create; override;
 170    destructor Destroy; override;
 171
 172    procedure SetDataType(Value: word); override;
 173    procedure SetSize(Value: integer); override;
 174    procedure SetTable(Value: boolean);
 175    procedure SetLength(Value: integer);
 176    procedure SetNational(Value: boolean);
 177    procedure SetHasDefault(Value: boolean);
 178
 179  // TEMP for describe
 180    function GetSize: integer;
 181    function GetTable: boolean;
 182    function GetLength: integer;
 183    function GetNational: boolean;
 184    function GetHasDefault: boolean;
 185
 186    function GetIndicator(Index: integer): smallint;
 187    procedure SetIndicator(Index: integer; Value: smallint);
 188
 189    function ValuePtr: IntPtr;
 190    procedure SetValuePtr(Buf: IntPtr);
 191    function IndicatorPtr: IntPtr;
 192    procedure SyncIndicator;
 193
 194    function GetItemAsDateTime(Index: integer): TDateTime;
 195    procedure SetItemAsDateTime(Index: integer; Value: TDateTime);
 196    function GetItemAsFloat(Index: integer): double;
 197    procedure SetItemAsFloat(Index: integer; Value: double);
 198    function GetItemAsInteger(Index: integer): integer;
 199    procedure SetItemAsInteger(Index: integer; Value: integer);
 200    function GetItemAsLargeInt(Index: integer): Int64;
 201    procedure SetItemAsLargeInt(Index: integer; Value: Int64);
 202    function GetItemAsString(Index: integer): string;
 203    procedure SetItemAsString(Index: integer; Value: string);
 204    function GetItemAsWideString(Index: integer): WideString;
 205    procedure SetItemAsWideString(Index: integer; Value: WideString);
 206    function GetItemAsBoolean(Index: integer): boolean;
 207    procedure SetItemAsBoolean(Index: integer; Value: boolean);
 208    procedure SetItemAsObject(Index: integer; Value: TSharedObject);
 209    function GetItemAsObject(Index: integer): TSharedObject;
 210
 211    function GetItemAsVariant(Index: integer): variant;
 212    procedure SetItemAsVariant(Index: integer; const Value: variant);
 213
 214    function GetValue: variant; override;
 215    procedure SetValue(const Value: variant); override;
 216
 217    function GetAsBlobRef: TBlob;
 218    function GetAsCursor: TOraCursor;
 219    function GetAsOraBlob: TOraLob;
 220    function GetAsBFile: TOraFile;
 221    function GetAsTimeStamp: TOraTimeStamp;
 222    function GetAsInterval: TOraInterval;
 223    function GetAsNumber: TOraNumber;
 224
 225    function GetObject: TSharedObject; override;
 226    procedure SetObject(Value: TSharedObject); override;
 227
 228    function GetNull: boolean; override;
 229    procedure SetNull(const Value: boolean); override;
 230    function GetItemNull(Index: integer): boolean;
 231    procedure SetItemNull(Index: integer; Value: boolean);
 232  end;
 233
 234{ TOCIConnection }
 235
 236  TRunMethod = procedure of object;
 237  TEndMethod = procedure(E: Exception) of object;
 238
 239  TMethodDesc = class
 240  public
 241    RunMethod     : TRunMethod;
 242    EndMethod     : TEndMethod;
 243  {$IFDEF MSWINDOWS}
 244    hWindow   :HWND;
 245  {$ENDIF}
 246  end;
 247
 248{$IFDEF LINUX}
 249  THandle = integer;
 250{$ENDIF}
 251
 252  TNlsParamType = (nlsDateLanguage, nlsDateFormat, nlsNumericCharacters, nlsTimeStampFormat,
 253    nlsTimeStampTZFormat);
 254
 255  TNlsSessionParam = record
 256    Name: string;
 257    Value: string;
 258    IsUserDefined: boolean;
 259  end;
 260
 261  TFailoverCallback = procedure (FailoverState: cardinal; FailoverType: cardinal;
 262    var Retry: boolean) of object;
 263
 264  TConnectionType = (ctDefault, ctOCIPooled{$IFDEF MSWINDOWS}{$IFNDEF LITE}, ctMTSPooled{$ENDIF}{$ENDIF});
 265
 266  TOCIConnection = class (TCRConnection)
 267  private
 268    FThreadSafety: boolean;
 269    FMaxStringSize: word;
 270    FOCICallStyle: TOCICallStyle;
 271    FOCICallStyleCommand: TOCICallStyle;
 272    FNativeHandle: boolean;
 273    FLastError: integer;
 274    FConnectMode: TConnectMode;
 275    FEnableIntegers: boolean;
 276    FEnableNumbers: boolean;
 277    FInternalName: string;
 278    FCommand: TOCICommand;
 279    FOracleVersionSt: string;
 280    FOracleVersion: word;
 281    FProxyConnection : TOCIConnection;
 282    FDisconnectMode: boolean;
 283    FConnectionTimeout: integer;
 284  {$IFNDEF LITE}  
 285    FTransaction: TOCITransaction;
 286  {$ENDIF}  
 287    FOCIPoolName: string;
 288    FStatementCache: boolean;
 289    FStatementCacheSize: integer;
 290
 291  { Charset parameters }
 292    FCharset: string;
 293    FCharsetId: word;
 294    FCharLength: word;
 295    FQueryCharLength: boolean;
 296    FUseUnicode: boolean;
 297
 298  { NLS session parameters }
 299    FNlsParams: array[TNlsParamType] of TNlsSessionParam;
 300
 301  { OCI73 }
 302    LDA: PLDA;
 303    HDA: PHDA;
 304  { OCI80 }
 305    hSvcCtx  : pOCISvcCtx;
 306    hServer  : pOCIServer;
 307    hSession : pOCISession;
 308    hOCIError : pOCIError;  // local error handle
 309    hOCIEnv   : pOCIEnv;
 310    hOCIAuthInfo : pOCIAuthInfo;
 311    //hTrans   : pOCITrans;
 312
 313    FConnectionType: TConnectionType;
 314
 315  {$IFDEF MSWINDOWS}
 316    hBusy: THandle;
 317    hWindow   :HWND;
 318  {$ENDIF}
 319
 320    procedure CheckCommand;
 321    procedure GetSessionParameters;
 322    procedure SetNlsParameter(const Name, Value: string);
 323    function GetMaxStringSize: word;
 324
 325  protected
 326    FOnFailover: TFailoverCallback;
 327    FInTransaction: boolean;
 328
 329    procedure DoError(E: Exception; var Fail: boolean); override;
 330    procedure SetStatementCacheSize(Size: integer);
 331    
 332    property AutoCommit;
 333  public
 334    constructor Create; override;
 335    destructor Destroy; override;
 336
 337    procedure CheckOCI;
 338    procedure CheckOCI73;
 339    procedure CheckOCI80;
 340
 341    procedure Check(Status: sword);
 342    procedure OraError(FOCICallStyle: TOCICallStyle; var ErrorCode: sword; UseCallback: boolean; Component: TObject);
 343
 344    procedure SetConnectionType(ConnectionType: TConnectionType);
 345    procedure Connect(const ConnectString: string); override;
 346    procedure Disconnect; override;
 347    function GetOracleVersionSt: string;
 348    function GetOracleVersion: word;
 349
 350  { Transaction control }
 351    procedure StartTransaction; override; // (Mode: TTransactionMode);
 352    procedure Commit; override;
 353    procedure Rollback; override;
 354
 355    procedure BreakExec;
 356
 357  { Multi Thread }
 358    procedure Busy;
 359    procedure BusyWait;
 360    procedure Release;
 361    function RunThread(RunMethod: TRunMethod; EndMethod: TEndMethod): TThread;
 362    function StopThread(var hThread: TThread{$IFDEF MSWINDOWS}; APeekMessage: boolean = False{$ENDIF}): boolean;
 363  {$IFDEF MSWINDOWS}
 364    procedure AllocWnd;
 365  {$ENDIF}
 366
 367  { OCI73 }
 368    function GetLDA: PLDA;
 369    procedure SetLDA(Value: PLDA);
 370
 371  { OCI80 }
 372    function GetSvcCtx: pOCISvcCtx;
 373    procedure SetSvcCtx(Value: pOCISvcCtx);
 374  {$IFDEF MSWINDOWS}  
 375  {$IFNDEF LITE}
 376    procedure GetMTSSvcCtx(var OCISvcCtx: pOCISvcCtx);
 377  {$ENDIF}
 378  {$ENDIF}
 379
 380    procedure ChangePassword(NewPassword: string);
 381
 382    procedure AssignConnect(Source: TOCIConnection);
 383
 384    procedure SetNonBlocking(Value: boolean); // nonblocking connection
 385    function GetOCICallStyle: TOCICallStyle;
 386    procedure SetOCICallStyle(Value: TOCICallStyle);
 387    function GetOCICallStyleCommand: TOCICallStyle;
 388    function GetLastError: integer;
 389    procedure SetLastError(Value: integer);
 390    procedure GetTableFields(TableName: string; Fields: TStringList);
 391
 392    function SetProp(Prop: integer; const Value: variant): boolean; override;
 393    function GetProp(Prop: integer; var Value: variant): boolean; override;
 394
 395    function CheckIsValid: boolean; override;
 396
 397  {$IFNDEF LITE}
 398    procedure ReturnToPool; override;
 399  {$ENDIF}
 400
 401    property OnFailover: TFailoverCallback read FOnFailover write FOnFailover;
 402    property InTransaction: boolean read FInTransaction;
 403
 404    property ProxyConnection : TOCIConnection read FProxyConnection write FProxyConnection;
 405
 406    procedure SetClientIdentifier(const Value: string);
 407  {$IFNDEF LITE}
 408    property Transaction: TOCITransaction read FTransaction;
 409  {$ENDIF}  
 410  end;
 411
 412{ TCursor }
 413
 414  TOraCursor = class (TSharedObject)
 415  private
 416    FCDA: PCDA;
 417    phOCIStmt: ppOCIStmt;
 418
 419    hOCIError: pOCIError;  // local error handle
 420    hOCIEnv: pOCIEnv;
 421    FState: TCursorState;
 422    FOCICallStyle: TOCICallStyle;
 423    FScrollable: boolean;
 424    FStatementCache: boolean;
 425    FPrefetchRows: integer;
 426
 427
 428    procedure DisablePrefetching;
 429    function GetCDA: PCDA;
 430    function GethOCIStmt: pOCIStmt;
 431    procedure SethOCIStmt(Value: pOCIStmt);
 432    function GetOCIStmt: pOCIStmt;
 433    function GetOCIStmtPtr: ppOCIStmt;
 434    procedure SetOCICallStyle(Value: TOCICallStyle);
 435    procedure SetPrefetchRows(Value: integer);
 436
 437    property hOCIStmt: pOCIStmt read GethOCIStmt write SethOCIStmt;
 438
 439  protected
 440    procedure CheckOCI;
 441    procedure CheckOCI73;
 442    procedure CheckOCI80;
 443    procedure InternalFreeCursor;
 444
 445  public
 446    constructor Create;
 447    destructor Destroy; override;
 448
 449    procedure AllocCursor(StatementCache: boolean = False);
 450    procedure FreeCursor;
 451
 452    function CanFetch: boolean;
 453
 454    property CDA: PCDA read GetCDA;
 455    property OCIStmt: pOCIStmt read GetOCIStmt;
 456    property OCIStmtPtr: ppOCIStmt read GetOCIStmtPtr;
 457    property State: TCursorState read FState write FState;
 458    property OCICallStyle: TOCICallStyle read FOCICallStyle write SetOCICallStyle;
 459    property PrefetchRows: integer read FPrefetchRows write SetPrefetchRows;
 460  end;
 461
 462{$IFDEF MSWINDOWS}
 463{ TOCIChangeNotification }
 464
 465  TChangeNotifyEventType = (cneNone, cneStartup, cneShutdown, cneShutdownAny,
 466    cneDropDB, cneDereg, cneObjChange);
 467
 468  TCustomNotifyChanges = class
 469  private
 470    function GetCount: integer;
 471  protected
 472    FItems: array of TObject;
 473    function CreateItem(ChangeDescriptor: IntPtr): TObject; virtual; abstract;
 474  public
 475    constructor Create(OCIColl: pOCIColl);
 476    destructor Destroy; override;
 477    property Count: integer read GetCount;
 478  end;
 479
 480  TNotifyRowChange = class
 481  private
 482    FRowId: string;
 483    FOperations: TChangeNotifyOperations;
 484  public
 485    constructor Create(ChangeDescriptor: IntPtr);
 486    property RowId: string read FRowId;
 487    property Operations: TChangeNotifyOperations read FOperations;
 488  end;
 489
 490  TNotifyRowChanges = class(TCustomNotifyChanges)
 491  private
 492    function GetChanges(Index: integer): TNotifyRowChange;
 493  protected
 494    function CreateItem(ChangeDescriptor: IntPtr): TObject; override;
 495  public
 496    property Changes[Index: integer]: TNotifyRowChange read GetChanges; default;
 497  end;
 498
 499  TNotifyTableChange = class
 500  private
 501    FTableName: string;
 502    FOperations: TChangeNotifyOperations;
 503    FRowChanges: TNotifyRowChanges;
 504  public
 505    constructor Create(ChangeDescriptor: IntPtr);
 506    destructor Destroy; override;
 507    property TableName: string read FTableName;
 508    property Operations: TChangeNotifyOperations read FOperations;
 509    property RowChanges: TNotifyRowChanges read FRowChanges;
 510  end;
 511
 512  TNotifyTableChanges = class(TCustomNotifyChanges)
 513  private
 514    function GetChanges(Index: integer): TNotifyTableChange;
 515  protected
 516    function CreateItem(ChangeDescriptor: IntPtr): TObject; override;
 517  public
 518    property Changes[Index: integer]: TNotifyTableChange read GetChanges; default;
 519  end;
 520
 521  TNotifyChange = class
 522  private
 523    FNotifyType: TChangeNotifyEventType;
 524    FTableChanges: TNotifyTableChanges;
 525  public
 526    constructor Create(ChangeDescriptor: IntPtr);
 527    destructor Destroy; override;
 528    property NotifyType: TChangeNotifyEventType read FNotifyType;
 529    property TableChanges: TNotifyTableChanges read FTableChanges;
 530  end;
 531
 532  TChangeNotifyCallback = procedure(NotifyType: TChangeNotifyEventType;
 533    TableChanges: TNotifyTableChanges) of object;
 534
 535  TOCIChangeNotification = class
 536  private
 537    FGCHandle: IntPtr;
 538    FEnabled: boolean;
 539    FPersistent: boolean;
 540    FTimeOut: integer;
 541    FOperations: TChangeNotifyDMLOperations;
 542    FOnChange: TChangeNotifyCallback;
 543    hOCISubscription: pOCISubscription;
 544    hWindow: HWND;
 545
 546    function GetGCHandle: IntPtr;
 547    procedure AllocWnd;
 548    procedure SetEnabled(Value: boolean);
 549    function CallbackChangeNotify(pCtx: IntPtr; pSubscrHp: pOCISubscription;
 550      pPayload: IntPtr; iPayloadLen: ub4; pDescriptor: IntPtr; iMode: ub4): sword;
 551
 552  protected
 553    property GCHandle: IntPtr read GetGCHandle;
 554
 555  public
 556    constructor Create;
 557    destructor Destroy; override;
 558
 559    function SetProp(Prop: integer; const Value: variant): boolean;
 560    function GetProp(Prop: integer; var Value: variant): boolean;
 561
 562    function GetSubscriptionHandle(Connection: TOCIConnection): pOCISubscription;
 563    procedure Register(Connection: TOCIConnection);
 564    procedure Unregister(Connection: TOCIConnection);
 565    function IsActive: boolean;
 566
 567    property OnChange: TChangeNotifyCallback read FOnChange write FOnChange;
 568  end;
 569{$ENDIF}
 570
 571{ TOCICommand }
 572
 573  TOCICommand = class (TCRCommand)
 574  private
 575    FCursor: TOraCursor;
 576    FCursorRef: TOraCursor;
 577    FOCICallStyle: TOCICallStyle;
 578    FScanParams: boolean;
 579    FNonBlocking: boolean;
 580    FSQLType: word;
 581    FRowsProcessed: integer;
 582    FFetchedRows: integer;
 583    FErrorOffset: word;
 584    FIterCount: integer;
 585    FFieldsAsString: boolean;
 586    FCacheLobs: boolean;
 587    FStoreRowId: boolean;
 588    FRowId: string;
 589    FRawAsString: boolean;
 590    FNumberAsString: boolean;
 591    FIntegerPrecision: Integer;
 592    FLargeIntPrecision: Integer;
 593    FFloatPrecision: Integer;
 594    FForceUnprepare: boolean;
 595    FGCHandle: IntPtr;
 596    FDisableParamScan: boolean; // prevents updating of ParamDescs in SetSQL (used in CreateProcCall)
 597    FTemporaryLobUpdate: boolean;
 598    FStatementCache: boolean;
 599  {$IFDEF MSWINDOWS}
 600    FChangeNotification: TOCIChangeNotification;
 601  {$ENDIF}
 602
 603  { OCI8 }
 604    hOCIError: pOCIError;  // local error handle
 605
 606  {$IFDEF MSWINDOWS}
 607    hBusy: THandle;
 608  {$ENDIF}
 609  {$IFDEF MSWINDOWS}
 610    hExecThread: TThread;
 611  {$ENDIF}
 612  {$IFDEF WIN32}
 613    hExecuted: TEvent;
 614  {$ENDIF}
 615
 616    function GetGCHandle: IntPtr;
 617    function RemoveCRSymbols(SQLText: string; var ErrorOffset: integer): string;
 618
 619  protected
 620    FConnection: TOCIConnection;
 621
 622    procedure DoExecute;
 623    procedure EndExecute(E: Exception);
 624
 625    //neaded for trial call
 626    procedure CheckOCI;
 627    procedure CheckOCI73;
 628    procedure CheckOCI80;
 629
 630    procedure CheckActive;
 631    procedure CheckInactive;
 632    procedure CheckSession;
 633
 634    procedure Check(Status: sword);
 635
 636  { OCI73 }
 637    function GetOraType7(DataType: integer; SubDataType: integer{ = 0}): integer;
 638    function GetFieldDesc7(FieldNo: integer; var Field: TFieldDesc; LongString: boolean; FlatBuffer: boolean): boolean;
 639    function InternalFetch7(Rows: word): word;
 640    function InternalFetchPiece7: integer;
 641    procedure InitProcParams7(Name: string; Overload: integer);
 642
 643  { OCI80 }
 644    function GetOraType8(DataType: integer; SubDataType: integer): integer;
 645    function GetFieldDesc8(FieldNo: integer; var Field: TFieldDesc; LongString: boolean; FlatBuffer: boolean): boolean;
 646    function InternalFetch8(Rows: word; Orientation: integer; Offset: integer): word;
 647    function InternalExecuteFetch8(Rows: word): word;    
 648    function InternalFetchPiece8(Orientation: integer; Offset: integer): integer;
 649    procedure InitProcParams8(Name: string; Overload: integer);
 650
 651    function CallbackInBind(Bind: pOCIBind; Iter: ub4; Index: ub4; var Buf: IntPtr;
 652      var BufLen: ub4; var PieceStatus: ub1; var Ind: IntPtr): sb4;
 653    function CallbackOutBind(Bind: pOCIBind; Iter: ub4; Index: ub4; var Buf: IntPtr;
 654      var BufLen: pub4; var PieceStatus: ub1; var Ind: IntPtr): sb4;
 655
 656    procedure SetArrayLength(Value: integer);
 657    function GetActive: boolean;
 658
 659    property Params;
 660    property Executing;
 661    property GCHandle: IntPtr read GetGCHandle;
 662
 663  public
 664    constructor Create; override;
 665    destructor Destroy; override;
 666
 667    function GetOraType(DataType: integer; SubDataType: integer): integer;
 668
 669    procedure InternalOpen;
 670    procedure InternalParse;
 671    procedure InternalPrepare;
 672
 673    procedure BindParam(Param: TOraParamDesc);
 674    function InternalExecute(Mode: integer; Rows: Integer = 0): sword;
 675    procedure Exec;
 676    function GetFieldDesc(FieldNo: integer; var Field: TFieldDesc; LongString: boolean; FlatBuffer: boolean): boolean;
 677    procedure DefineData(Field: TFieldDesc; Buf: IntPtr; Ind: psb2);
 678    procedure DefineArrayData(Field: TFieldDesc; Buf: IntPtr; Ind: psb2; BufSkip: integer;
 679      IndSkip: integer);
 680    procedure DefinePieceData(Field: TFieldDesc; Buf: IntPtr; Ind: psb2);
 681    procedure DefineDynamic(Field: TFieldDesc; Owner: IntPtr; Proc: IntPtr; CharsetId: Integer);
 682
 683    function InternalFetch(Rows: word; Orientation: integer = OCI_FETCH_NEXT; Offset: integer = 0): word;
 684    function InternalFetchPiece(Orientation: integer = OCI_FETCH_NEXT; Offset: integer = 0): integer;
 685    procedure InternalCancel;
 686    procedure InternalClose;
 687    procedure Finish;
 688
 689    procedure GetPI(var Handle: pOCIHandle; var Piece: byte; var Buf: IntPtr;
 690      var Iteration: cardinal; var Index: cardinal; var Mode: TParamDirection);
 691    procedure SetPI(Handle: pOCIHandle; HType: cardinal; Piece: byte; Buf: IntPtr;
 692      var BufLen: cardinal; Ind: psb2);
 693
 694    function NativeCursor: boolean;
 695    function RowsReturn: boolean;
 696    procedure CheckRowsReturn;
 697
 698  { Params }
 699    function AddParam: TParamDesc; override;
 700    procedure ScanParams;
 701    procedure BindParams;
 702    procedure InitProcParams(Name: string; Overload: integer);
 703    //procedure DisconnectParams;
 704    function GetParam(Index: integer): TOraParamDesc;
 705
 706    procedure BreakExec;
 707    procedure HardBreak;
 708
 709    procedure Busy;
 710    procedure Release;
 711
 712    function CreateProcCall(Name: PChar; Overload: integer;
 713      NeedDescribe: boolean = True; PassByName: boolean = False): string;
 714
 715    procedure Prepare; override;
 716    procedure Unprepare; override;
 717    function GetPrepared: boolean; override;
 718
 719    procedure Execute(Iters: integer = 1); override;
 720
 721    procedure SetConnection(Value: TCRConnection); override;
 722    procedure SetSQL(const Value: string); override;
 723    function GetCursor: TOraCursor;
 724    procedure SetCursor(Value: TOraCursor);
 725    procedure SetOCICallStyle(Value: TOCICallStyle);
 726    function GetCursorState: TCursorState; override;
 727    procedure SetCursorState(Value: TCursorState); override;
 728    function GetSQLType: integer;
 729    procedure SetSQLType(Value: integer);
 730    function GetRowId: string;
 731
 732    function SetProp(Prop: integer; const Value: variant): boolean; override;
 733    function GetProp(Prop: integer; var Value: variant): boolean; override;
 734
 735  {$IFDEF MSWINDOWS}
 736    property ChangeNotification: TOCIChangeNotification read FChangeNotification write FChangeNotification;
 737  {$ENDIF}
 738  end;
 739
 740{ TOCITableInfo }
 741
 742{$IFNDEF LITE}
 743  TOCITableInfo = class(TCRTableInfo)
 744  public
 745    class function NormalizeName(Value: string; const QuoteNames: boolean): string; overload; override;
 746    class function NormalizeName(Value: string; const LeftQ: char; const RightQ: char; const QuoteNames: boolean = False): string; overload; override;
 747    class function NormalizeName(Value: string; const LeftQ: char; const RightQ: char; const QuoteNames, UnQuoteNames: boolean): string; overload;
 748    class function NormalizeName(Value: string; const QuoteNames, UnQuoteNames: boolean): string; overload;
 749  {$IFDEF VER8}
 750    class function LeftQuote: Char; override;
 751    class function RightQuote: Char; override;
 752
 753    class function IsQuoted(const Value: string): boolean; override;
 754    class function QuotesNeeded(Value: string): boolean; override;
 755  {$ENDIF}
 756  end;
 757{$ENDIF}
 758
 759{ TOCIRecordSet }
 760
 761  TModifyAction = procedure of object;
 762
 763  TOCIRecordSet = class (TCRRecordSet)
 764  private
 765    FAutoClose: boolean;
 766    FDeferredLobRead: boolean;
 767    hExecFetchThread: TThread;
 768    hFetchAllThread: TThread;
 769    FFetchCursor: TOraCursor;
 770    FFetchBlock: IntPtr;
 771    FFetchBlockItemSize: integer;
 772    FPieceFetch: boolean;
 773    FFetchItems: IntPtr;  // for callback fetch
 774    // for backward fetch
 775    FFetchAbsolute: boolean;
 776    FFetchStart: integer;
 777    FFetchEnd: integer;
 778    FNoData: boolean;
 779    FGCHandle: IntPtr;
 780    FHasLargeIntFields: boolean;
 781
 782  {$IFDEF MSWINDOWS}
 783    hEvent: TEvent;
 784  {$ENDIF}
 785    FStopFetch : boolean;
 786    FFetching : boolean;
 787
 788    FHasObjectFields: boolean;
 789    FTempFilterText: string;
 790
 791    //PreCached FConection properties
 792    FDisconnectedMode: boolean;
 793    FUseUnicode: boolean;
 794    FCharLength: integer;
 795
 796    procedure InitFetchCursor;
 797
 798    function FetchArray(FetchBack: boolean = False): boolean;
 799    function FetchPiece(FetchBack: boolean = False): boolean;
 800
 801    procedure AllocFetchBlock;
 802    procedure FreeFetchBlock;
 803
 804    function GetNonBlocking: boolean;
 805    function GetGCHandle: IntPtr;
 806    function GetDisconnectedMode: boolean;
 807    function GetUseUnicode: boolean;
 808    function GetCharLength: integer;
 809
 810    function IsConvertedFieldType(DataType: word): boolean;
 811  protected
 812    FCommand: TOCICommand;
 813    FConnection: TOCIConnection;  // for perf
 814
 815    procedure CreateCommand; override;
 816    procedure SetCommand(Value: TCRCommand); override;
 817
 818  { Open/Close }
 819    procedure InternalPrepare; override;
 820    procedure InternalUnPrepare; override;
 821    procedure InternalOpen; override;
 822    procedure InternalClose; override;
 823    procedure InternalInitFields; override;
 824
 825    procedure ExecFetch; override;
 826
 827    function GetIndicatorSize: word; override;
 828
 829    function GetEOF: boolean; override;
 830
 831  { Filter/Find/Locate/Sorting }
 832  {$IFNDEF CLR}
 833    function InternalAnsiStrComp(const Value1, Value2: IntPtr;
 834      const Options: TLocateExOptions): integer; override;
 835  {$ENDIF}
 836    function InternalAnsiCompareText(const Value1, Value2: string;
 837      const Options: TLocateExOptions): integer; override;
 838    function InternalWStrLComp(const Value1, Value2: WideString;
 839      const Options: TLocateExOptions): integer; override;
 840    function InternalWStrComp(const Value1, Value2: WideString;
 841      const Options: TLocateExOptions): integer; override;
 842
 843    procedure SetFilterText(Value: string); override;
 844          
 845  { Fetch }
 846    function Fetch(FetchBack: boolean = False): boolean; override;
 847    function CanFetchBack: boolean; override;
 848
 849  { Items }
 850    procedure FreeAllItems;
 851
 852  { Edit }
 853    procedure DoExecFetch;
 854    procedure EndExecFetch(E: Exception);
 855    procedure DoFetchAll;
 856    procedure DoFetchAllPulse;
 857    procedure EndFetchAll(E: Exception);
 858
 859    function CallbackDefine(Define: pOCIDefine; Iter: cardinal; var Buf: IntPtr;
 860      var BufLen: pub4; var PieceStatus: ub1; var Ind: IntPtr): sb4;
 861  {$IFNDEF LITE}
 862  { TablesInfo }
 863    class function GetTableInfoClass: TTableInfoClass; override;
 864  {$ENDIF}
 865
 866    property GCHandle: IntPtr read GetGCHandle;
 867    //PreCached FConection properties
 868    property DisconnectedMode: boolean read GetDisconnectedMode;
 869    property UseUnicode: boolean read GetUseUnicode;
 870    property CharLength: integer read GetCharLength;
 871
 872  public
 873    constructor Create; override;
 874    destructor Destroy; override;
 875
 876  { Open/Close }
 877    function IsFullReopen: boolean; override;
 878    procedure Reopen; override;
 879    procedure SetCommandType;
 880    procedure ExecCommand; override; // Execute command
 881    procedure BreakExec;
 882    procedure Disconnect; override;    
 883
 884  { Fetch }
 885    procedure FetchAll; override;
 886
 887    function RowsReturn: boolean; override;
 888  { Fields }
 889    procedure SetNull(FieldNo: word; RecBuf: IntPtr; Value: boolean); override;
 890    function GetNull(FieldNo: word; RecBuf: IntPtr): boolean; override;
 891
 892    procedure GetDateFromBuf(Buf: IntPtr; Offset: integer; Date: IntPtr; Format: TDateFormat); override;
 893    procedure PutDateToBuf(Buf: IntPtr; Offset: integer; Date: IntPtr; Format: TDateFormat); override;
 894
 895    function IsBlobFieldType(DataType: word): boolean; override;
 896    function IsComplexFieldType(DataType: word): boolean; override;
 897
 898    procedure GetFieldData(Field: TFieldDesc; RecBuf: IntPtr; Dest: IntPtr); override;
 899    procedure GetFieldAsVariant(FieldNo: word; RecBuf: IntPtr; var Value: variant); override;
 900    procedure PutFieldAsVariant(FieldNo: word; RecBuf: IntPtr; const Value: variant); override;
 901
 902  { Records }
 903    procedure CreateComplexFields(RecBuf: IntPtr; WithBlob: boolean); override;
 904    procedure FreeComplexFields(RecBuf: IntPtr; WithBlob: boolean); override;
 905    procedure CopyComplexFields(Source: IntPtr; Dest: IntPtr; WithBlob: boolean); override;
 906
 907    function CompareFieldValue(ValuePtr: IntPtr; const ValueType: integer; FieldDesc: TFieldDesc; RecBuf: IntPtr; const Options: TLocateExOptions): integer; override;
 908    function CompareFields(RecBuf1: IntPtr; RecBuf2: IntPtr; FieldDesc: TFieldDesc; Options: TLocateExOptions = []): integer; override;
 909    procedure SortItems; override;
 910    procedure FilterUpdated; override;
 911
 912  { Navigation }
 913    procedure SetToBegin; override;
 914    procedure SetToEnd; override;
 915
 916  { BookMarks }
 917    procedure GetBookmark(Bookmark: PRecBookmark); override;
 918    procedure SetToBookmark(Bookmark: PRecBookmark); override;
 919    function GetBlockFetchPos(Block: PBlockHeader): integer;
 920    function GetItemFetchPos(Item: PItemHeader): integer;
 921
 922  { Blobs }
 923    procedure SetConnection(Value: TCRConnection); override;
 924
 925    function SetProp(Prop: integer; const Value: variant): boolean; override;
 926    function GetProp(Prop: integer; var Value: variant): boolean; override;
 927  end;
 928
 929{ TOraLob }
 930
 931  TLobType = (ltBlob, ltClob, ltNClob);
 932
 933  TOraLob = class (TCompressedBlob)
 934  private
 935    phLobLocator: ppOCILobLocator;
 936    FSvcCtx: pOCISvcCtx;
 937    hOCIEnv: pOCIEnv;
 938    FNativeHandle: boolean;
 939    FCached: boolean;
 940    FCharsetForm: integer;
 941    FLobType: TLobType;
 942    FCharLength: byte;
 943
 944    function GetOCILobLocator: pOCILobLocator;
 945    function GethOCILobLocator: pOCIStmt;
 946    procedure SethOCILobLocator(Value: pOCIStmt);
 947    procedure SetOCILobLocator(Value: pOCILobLocator);
 948    function GetOCILobLocatorPtr: ppOCILobLocator;
 949    procedure SetCached(const Value: boolean);
 950    procedure SetOCISvcCtx(const Value: pOCISvcCtx);
 951
 952    property hLobLocator: pOCILobLocator read GethOCILobLocator write SethOCILobLocator;
 953
 954  protected
 955    FNeedReadLob: boolean;
 956
 957    procedure CheckValue; override;
 958    function GetSize: cardinal; override;
 959    procedure CheckAlloc;
 960    procedure CheckSession;
 961    procedure CheckInit;
 962    procedure CheckCharSetForm;
 963    function CharSize: Byte; virtual;
 964
 965  public
 966    constructor Create(ASvcCtx: pOCISvcCtx);
 967    destructor Destroy; override;
 968
 969    procedure AllocLob; virtual;
 970    procedure FreeLob; virtual;
 971
 972    procedure Init;
 973    procedure CreateTemporary(LobType: TLobType);
 974    procedure FreeTemporary;
 975    function IsTemporary: LongBool;
 976    function IsInit: boolean;
 977
 978    function LengthLob: longint;
 979
 980    procedure EnableBuffering;
 981    procedure DisableBuffering;
 982
 983    procedure ReadLob;
 984    procedure WriteLob;
 985
 986    function Read(Position, Count: cardinal; Dest: IntPtr): cardinal; override;
 987    procedure Write(Position, Count: cardinal; Source: IntPtr); override;
 988    procedure Clear; override;
 989    procedure Truncate(NewSize: cardinal); override;
 990
 991    procedure LoadFromStream(Stream: TStream); override;
 992    procedure SaveToStream(Stream: TStream); override;
 993
 994    property OCILobLocator: pOCILobLocator read GetOCILobLocator write SetOCILobLocator;
 995    property OCILobLocatorPtr: ppOCILobLocator read GetOCILobLocatorPtr;
 996    property OCISvcCtx: pOCISvcCtx read FSvcCtx write SetOCISvcCtx;
 997    property Cached: boolean read FCached write SetCached;
 998    property LobType: TLobType read FLobType write FLobType;
 999  end;
1000
1001{ TOraFile }
1002
1003  TOraFile = class (TOraLob)
1004  private
1005    FNeedRollback: boolean;
1006    FRollbackFileDir: string;
1007    FRollbackFileName: string;
1008
1009    function GetFileDir: string;
1010    procedure SetFileDir(Value: string);
1011    function GetFileName: string;
1012    procedure SetFileName(Value: string);
1013
1014  protected
1015    CanRollback: boolean;
1016
1017    procedure CheckValue; override;
1018    function CharSize: Byte; override;
1019
1020    procedure SaveToRollback; override;
1021  public
1022    destructor Destroy; override;
1023
1024    procedure AllocLob; override;
1025    procedure FreeLob; override;
1026
1027    procedure Open;
1028    procedure Close;
1029    procedure EnableRollback;
1030
1031    procedure Commit; override;
1032    procedure Cancel; override;
1033
1034    procedure Refresh;
1035
1036    function IsOpen: boolean;
1037
1038    function Exists: boolean;
1039
1040    property FileDir: string read GetFileDir write SetFileDir;
1041    property FileName: string read GetFileName write SetFileName;
1042  end;
1043
1044{ TOraTimeStamp }
1045
1046  TOraTimeStamp = class (TSharedObject)
1047  private
1048    phOCIDateTime: ppOCIDateTime;
1049    FDescriptorType: cardinal;
1050    FPrecision: byte;
1051    FFormat: string;
1052    FNativeHandle: boolean;
1053    FIndicator: IntPtr;
1054
1055    function GetAsString: string;
1056    procedure SetAsString(const Value: string);
1057    function GetAsDateTime: TDateTime;
1058    procedure SetAsDateTime(Value: TDateTime);
1059    function GetTimeZone: string;
1060    function GethOCIDateTime: pOCIDateTime;
1061    procedure SethOCIDateTime(Value: pOCIDateTime);
1062    function GetOCIDateTime: pOCIDateTime;
1063    procedure SetOCIDateTime(const Value: pOCIDateTime);
1064    procedure SetDescriptorType(const Value: cardinal);
1065    function GetOCIDateTimePtr: ppOCIDateTime;
1066
1067    procedure CheckValid;
1068
1069    procedure SetFormat(const AFormat: string);
1070
1071    property hOCIDateTime: pOCIDateTime read GethOCIDateTime write SethOCIDateTime;
1072
1073  public
1074    constructor Create(DataType: word);
1075    destructor Destroy; override;
1076
1077    procedure AllocDateTime;
1078    procedure FreeDateTime;
1079
1080    procedure AssignTo(Dest: TOraTimeStamp);
1081    function Compare(Dest: TOraTimeStamp): integer;
1082
1083    function GetIsNull: boolean;
1084    procedure SetIsNull(Value: boolean);
1085
1086    procedure Construct(Year: smallint; Month, Day, Hour, Min, Sec: byte;
1087      FSec: cardinal; TimeZone: string);
1088
1089    procedure GetDate(var Year: smallint; var Month, Day: byte);
1090    procedure SetDate(Year: smallint; Month, Day: byte);
1091
1092    procedure GetTime(var Hour, Min, Sec: byte; var FSec: cardinal);
1093    procedure SetTime(Hour, Min, Sec: byte; FSec: cardinal);
1094
1095    procedure GetTimeZoneOffset(var Hour, Min: shortint);
1096    procedure SetTimeZoneOffset(TZHour, TZMin: shortint);
1097
1098    property DescriptorType: cardinal read FDescriptorType write SetDescriptorType;
1099    property OCIDateTime: pOCIDateTime read GetOCIDateTime write SetOCIDateTime;
1100    property OCIDateTimePtr: ppOCIDateTime read GetOCIDateTimePtr;
1101    property Format: string read FFormat write SetFormat;
1102    property Precision: byte read FPrecision write FPrecision;
1103    property TimeZone: string read GetTimeZone;
1104    property AsString: string read GetAsString write SetAsString;
1105    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
1106    property IsNull: boolean read GetIsNull write SetIsNull;
1107  end;
1108
1109  TOraInterval = class (TSharedObject)
1110  private
1111    phOCIInterval: ppOCIInterval;
1112    FDescriptorType: cardinal;
1113    FNativeHandle: boolean;
1114    FFracPrecision: byte;
1115    FLeadPrecision: byte;
1116    FIndicator: IntPtr;
1117
1118    procedure Init;
1119    procedure CheckValid;
1120    function GetAsString: string;
1121    function GethOCIInterval: pOCIInterval;
1122    procedure SethOCIInterval(Value: pOCIInterval);
1123    function GetOCIInterval: pOCIInterval;
1124    function GetOCIIntervalPtr: ppOCIInterval;
1125    procedure SetAsString(const Value: string);
1126    procedure SetDescriptorType(const Value: cardinal);
1127    procedure SetOCIInterval(const Value: pOCIInterval);
1128
1129    property hOCIInterval: pOCIInterval read GethOCIInterval write SethOCIInterval;
1130  public
1131    constructor Create(DataType: word);
1132    destructor Destroy; override;
1133
1134    procedure AllocInterval;
1135    procedure FreeInterval;
1136
1137    procedure AssignTo(Dest: TOraInterval);
1138    function Compare(Dest: TOraInterval): integer;
1139
1140    function GetIsNull: boolean;
1141    procedure SetIsNull(Value: boolean);
1142
1143    procedure GetYearMonth(var Year, Month: integer);
1144    procedure SetYearMonth(Year, Month: integer);
1145
1146    procedure GetDaySecond(var Day, Hour, Min, Sec, FSec: integer);
1147    procedure SetDaySecond(Day, Hour, Min, Sec, FSec: integer);
1148
1149    property DescriptorType: cardinal read FDescriptorType write SetDescriptorType;
1150    property OCIInterval: pOCIInterval read GetOCIInterval write SetOCIInterval;
1151    property OCIIntervalPtr: ppOCIInterval read GetOCIIntervalPtr;
1152    property LeadPrecision: byte read FLeadPrecision write FLeadPrecision;
1153    property FracPrecision: byte read FFracPrecision write FFracPrecision;
1154    property AsString: string read GetAsString write SetAsString;
1155    property IsNull: boolean read GetIsNull write SetIsNull;
1156  end;
1157
1158  TOraNumber = class (TSharedObject)
1159  private
1160    phOCINumber: pOCINumber;
1161    FIndicator: IntPtr;
1162    FNativeHandle: boolean;
1163
1164    function GetOCINumberPtr: pOCINumber;
1165    procedure SetOCINumberPtr(Value: pOCINumber);
1166    function GetOCINumber: OCINumber;
1167    procedure SetOCINumber(Value: OCINumber);
1168    function GetAsString: string;
1169    procedure SetAsString(const Value: string);
1170    function GetAsInteger: integer;
1171    procedure SetAsInteger(const Value: integer);
1172    function GetAsLargeInt: int64;
1173    procedure SetAsLargeInt(const Value: int64);
1174    function GetAsFloat: double;
1175    procedure SetAsFloat(const Value: double);
1176    function GetIsNull: boolean;
1177    procedure SetIsNull(Value: boolean);
1178{$IFDEF LITE}
1179    function GetAsBCD: TBCD;
1180    procedure SetAsBCD(const Value: TBCD);
1181{$ENDIF}
1182
1183  public
1184    constructor Create;
1185    destructor Destroy; override;
1186    procedure AssignTo(Dest: TOraNumber);
1187    function Compare(Dest: TOraNumber): integer;
1188
1189    property OCINumber: OCINumber read GetOCINumber write SetOCINumber;
1190    property OCINumberPtr: pOCINumber read GetOCINumberPtr write SetOCINumberPtr;
1191    property AsString: string read GetAsString write SetAsString;
1192    property AsInteger: integer read GetAsInteger write SetAsInteger;
1193    property AsLargeInt: Int64 read GetAsLargeInt write SetAsLargeInt;
1194    property AsFloat: double read GetAsFloat write SetAsFloat;
1195    property IsNull: boolean read GetIsNull write SetIsNull;
1196{$IFDEF LITE}
1197    property AsBCD: TBCD read GetAsBCD write SetAsBCD;
1198{$ENDIF}
1199  end;
1200
1201{$IFNDEF LITE}
1202{ TOCITransaction }
1203
1204  TGlobalCoordinator = (gcInternal{$IFDEF MSWINDOWS}, gcMTS{$ENDIF});
1205  TOraIsolationLevel = (ilReadCommitted, ilSerializable, ilReadOnly);
1206  TOraTransactionAction = (taCommit, taRollback);
1207
1208  TOraTransactionState = (tsInactive, tsActive, tsPrepared, tsFinished);
1209
1210  TTransactionLink = class
1211    Connection: TOCIConnection;
1212    BranchQualifier: TBytes;
1213    State: TOraTransactionState;
1214    OCITrans: pOCITrans;
1215  {$IFDEF MSWINDOWS}
1216    MTSSvcCtx: pOCISvcCtx;
1217  {$ENDIF}
1218  end;
1219
1220  TTransactionLinks = class (TDAList)
1221  private
1222    function GetItems(Index: integer): TTransactionLink;
1223  public
1224    procedure Clear; override;
1225    function IndexOfConnection(Connection: TOCIConnection): integer;
1226    function AddConnection(Connection: TOCIConnection; BranchQualifier: TBytes): boolean;
1227    function RemoveConnection(Connection: TOCIConnection): boolean;
1228    property Items[Index: Integer]: TTransactionLink read GetItems; default;
1229  end;
1230
1231  TOCITransaction = class
1232  private
1233    FOnError: TErrorProc;
1234    FTransactionLinks: TTransactionLinks;
1235
1236    FActive: boolean;
1237
1238    FInactiveTimeOut: integer;
1239    FResumeTimeOut: integer;
1240    FTransactionName: string;
1241    FXID: IntPtr;
1242    FTransactionId: TBytes;
1243
1244    FGlobalCoordinator: TGlobalCoordinator;
1245    FIsolationLevel: TOraIsolationLevel;
1246    FDefaultCloseAction: TOraTransactionAction;
1247
1248  {$IFDEF MSWINDOWS}
1249    FMTSGC: ICRTransactionDispenserSC;
1250    FMTSTrans: ICRTransactionSC;
1251  {$ENDIF}
1252
1253    procedure WriteTransactionId;
1254    procedure WriteBranchQualifier(TransactionLink: TTransactionLink);
1255
1256    procedure FreeTransaction;
1257
1258  {$IFDEF MSWINDOWS}
1259    procedure StartMTSTransaction;
1260    procedure CompleteMTSTransaction(Commit: boolean);
1261  {$ENDIF}
1262  public
1263    constructor Create;
1264    destructor Destroy; override;
1265    procedure CloseTransaction;
1266
1267    procedure Check(Status: sword);
1268    procedure OraError(var ErrorCode: sword; UseCallback: boolean);
1269  {$IFDEF MSWINDOWS}
1270    procedure MTSCheck(status: sword);
1271    procedure MTSError(var ErrorCode: sword; UseCallback: boolean);
1272  {$ENDIF}
1273
1274    procedure CheckState(State: boolean);
1275    procedure SetTransactionId(TransactionId: TBytes);
1276    function AddConnection(Connection: TOCIConnection; BranchQualifier: TBytes): boolean;
1277    function RemoveConnection(Connection: TOCIConnection): boolean;
1278
1279    function SetProp(Prop: integer; const Value: variant): boolean;
1280    function GetProp(Prop: integer; var Value: variant): boolean;
1281
1282    procedure StartTransaction(Resume: boolean);
1283    procedure Commit;
1284    procedure Rollback;
1285    procedure Detach;
1286    procedure Resume;
1287
1288    property Active: boolean read FActive;
1289    property OnError: TErrorProc read FOnError write FOnError;
1290  end;
1291{$ENDIF}
1292
1293  TOraClassesUtils = class
1294  public
1295    class procedure InternalUnPrepare(Obj: TOCIRecordSet);
1296  end;
1297
1298const
1299  IntegerPrecision: integer = 9;
1300  LargeIntPrecision: integer = 0;
1301  FloatPrecision: integer   = 15;
1302
1303var
1304  UseOCI7ProcDesc: boolean;
1305  TimeFormat: string;
1306
1307  function OraDateToDateTime(Buf: IntPtr): TDateTime;
1308  function OraDateToMSecs(Buf: IntPtr): double;
1309  procedure DateTimeToOraDate(DateTime: TDateTime; Buf: IntPtr);
1310  procedure MSecsToOraDate(MSecs: double; Buf: IntPtr);
1311
1312  procedure OCIInit;
1313  procedure OCIFinish;
1314
1315  procedure GetTimeFormat;
1316
1317  function QuotedOCIName(Name: string): string;
1318  function QuotedSQLName(Name: string): string;
1319
1320{$IFNDEF LITE}
1321  function GetTablesInfo(SQL: string; TablesInfo: TCRTablesInfo): integer;  
1322{$ENDIF}
1323
1324implementation
1325uses
1326  {$IFDEF PROF}OraProf, {$ENDIF}
1327{$IFDEF CLR}
1328  System.Runtime.InteropServices, System.Text, System.Threading,
1329{$ELSE}
1330  {$IFDEF VER6P}Variants,{$ENDIF}
1331{$ENDIF}
1332{$IFDEF MSWINDOWS}
1333{$IFNDEF LITE}
1334  ComObj,
1335{$ENDIF}
1336{$ENDIF}
1337  DAConsts, OraConsts, OraObjects, CRParser, OraParser, Math;
1338
1339const
1340  WM_ENDTHREAD      = $400;
1341  WM_EXCEPTTHREAD   = $401;
1342  WM_ENDEXECUTE     = $402;  // WAR
1343  WM_AFTERFETCH     = $404;
1344  WM_CHANGENOTIFY   = $405;
1345
1346type
1347  TArr = array [0..100] of byte;  // DEBUG TEMP
1348  PArr = ^TArr;
1349  TArrC = array [0..100] of char;  // DEBUG TEMP
1350  PArrC = ^TArrC;
1351
1352{$IFNDEF LINUX}
1353type
1354  TExecThread =  class(TThread)
1355  protected
1356    FMethodDesc: TMethodDesc;
1357    FException: Exception;
1358  public
1359    constructor Create(MethodDesc: TMethodDesc; CreateSuspended: Boolean);
1360    destructor Destroy; override;
1361    procedure Execute; override;
1362  end;
1363{$ENDIF}
1364
1365var
1366{$IFDEF LINUX}
1367  hLockConnect: TCriticalSection;
1368{$ENDIF}
1369
1370  OCICallbackDefinePtr: IntPtr;
1371  OCICallbackInBindPtr: IntPtr;
1372  OCICallbackOutBindPtr: IntPtr;
1373  OCICallbackFailoverPtr: IntPtr;
1374{$IFDEF MSWINDOWS}
1375  OCICallbackChangeNotifyPtr: IntPtr;
1376{$ENDIF}
1377
1378{$IFDEF CLR}
1379  HOCICallbackDefine: GCHandle;
1380  HOCICallbackInBind: GCHandle;
1381  HOCICallbackOutBind: GCHandle;
1382  HOCICallbackFailover: GCHandle;
1383  HOCICallbackChangeNotify: GCHandle;
1384  HWndProc: GCHandle;
1385{$ENDIF}
1386
1387procedure OCIInit;
1388begin
1389  OraCall.InitOCI;
1390end;
1391
1392procedure OCIFinish;
1393begin
1394  FinishOCI;
1395end;
1396
1397function Shift(Value: cardinal): cardinal;
1398begin
1399  Result := Value;
1400  if Result <> 0 then
1401    if (Result and $FF) = 0 then  // while do
1402      Result := Result shr 8;
1403end;
1404
1405function Reverse2(Value: word): TBytes;
1406begin
1407  SetLength(Result, 2);
1408  Result[0] := byte(Value shr 8);
1409  Result[1] := byte(Value);
1410end;
1411
1412function Reverse4(Value: cardinal): TBytes;
1413begin
1414  SetLength(Result, 4);
1415  Result[0] := byte(Value shr 24);
1416  Result[1] := byte(Value shr 16);
1417  Result[2] := byte(Value shr 8);
1418  Result[3] := byte(Value);
1419end;
1420
1421// Converts Count bytes from memory pointed by Bytes to 64 base string. Starting
1422// digit (6-bit chunk) may be shifted by -4, -2, 0 or 2 bits. Missing bits
1423// assumed to be zero.
1424// Bytes are converted in the following way (example for Shift = 0):
1425// 0 byte   1 byte   hi    lo
1426// 00000100|00000000|01000001|01000011|...
1427// ------++ ++++---- --++++++ ------++ +++
1428//  B(1)   A(0)   B(1)  B(1)   Q(16)
1429function BytesTo64BaseString(Bytes: TBytes; Count: integer; Shift: integer): string;
1430const
1431  Map = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
1432var
1433  i, RestBits: cardinal;
1434  CurByte, Digit, NextDigit: byte;
1435begin
1436  Result :='';
1437  RestBits := 2 - Shift;
1438  NextDigit := $FF;
1439
1440  for i := 0 to Count - 1 do begin
1441    CurByte := Bytes[i];
1442
1443    Digit := CurByte shr RestBits;
1444    if NextDigit <> $FF then
1445      Digit := Digit or NextDigit;
1446
1447    Result := Result + Map[Digit + 1];
1448
1449    NextDigit := (CurByte and ($FF shr (8 - RestBits))) shl (6 - RestBits);
1450
1451    if RestBits = 6 then begin
1452      Result := Result + Map[NextDigit + 1];
1453      NextDigit := $FF;
1454      RestBits := 2;
1455    end
1456    else
1457      RestBits := RestBits + 2;
1458  end;
1459
1460  if NextDigit <> $FF then
1461    Result := Result + Map[NextDigit + 1];
1462end;
1463
1464function RowId7ToString(RowId: PRowId7): string;
1465var
1466  Buf: TBytes;
1467begin
1468  Buf := nil;
1469  if (RowId.rd.rcs4 = 0) then begin // obj num
1470  // restricted (Oracle 7)
1471    Result :=
1472      IntToHex(Shift(RowId.rcs7), 8) + '.' +
1473      IntToHex(Shift(RowId.rcs8), 4) + '.' +  // use 2 byte
1474      IntToHex(RowId.rd.rcs5, 4)
1475  end
1476  else begin
1477  // extended (Oracle 8 and higher)
1478    Buf := Reverse4(RowId.rd.rcs4);
1479    Result := BytesTo64BaseString(Buf, 4, -4);
1480
1481    Buf := Reverse2(RowId.rd.rcs5);
1482    Result := Result + BytesTo64BaseString(Buf, 2, -2);
1483
1484    Buf := Reverse4(Shift(RowId.rcs7));
1485    Result := Result + BytesTo64BaseString(Buf, 4, -4);
1486
1487    Buf := Reverse2(Shift(RowId.rcs8)); // use 3 byte
1488    Result := Result + BytesTo64BaseString(Buf, 2, -2);
1489  end;
1490end;
1491
1492function RowId8ToString(RowId: PRowId8): string;
1493var
1494  Buf: TBytes;
1495begin
1496  Buf := nil;
1497  if (RowId.ridobjnum = 0) then
1498  // restricted (Oracle 7)
1499    Result :=
1500      IntToHex(Shift(RowId.ridblocknum), 8) + '.' +
1501      IntToHex(Shift(RowId.ridslotnum), 4) + '.' +
1502      IntToHex(RowId.ridfilenum, 4)
1503  else begin
1504  // extended (Oracle 8 and higher)
1505    Buf := Reverse4(RowId.ridobjnum);
1506    Result := BytesTo64BaseString(Buf, 4, -4);
1507
1508    Buf := Reverse2(RowId.ridfilenum);
1509    Result := Result + BytesTo64BaseString(Buf, 2, -2);
1510
1511    Buf := Reverse4(RowId.ridblocknum);
1512    Result := Result + BytesTo64BaseString(Buf, 4, -4);
1513
1514    Buf := Reverse2(RowId.ridslotnum);
1515    Result := Result + BytesTo64BaseString(Buf, 2, -2);
1516  end;
1517end;
1518
1519function RowId81ToString(RowIdPtr: PRowId81): string;
1520var
1521  Bytes: TBytes;
1522begin
1523  if RowIdPtr.ridobjnum = 0 then begin
1524  // restricted (Oracle 7)
1525    Result :=
1526      IntToHex(BitConverter.ToInt32(Reverse4(RowIdPtr.ridblocknum), 0), 8) + '.' +
1527      IntToHex(BitConverter.ToInt16(Reverse2(RowIdPtr.ridslotnum), 0), 4) + '.' +
1528      IntToHex(BitConverter.ToInt16(Reverse2(RowIdPtr.ridfilenum), 0), 4)
1529  end
1530  else begin
1531  // extended (Oracle 8 and higher)
1532    SetLength(Bytes, 4);
1533    Marshal.Copy(IntPtr(Integer(IntPtr(RowIdPtr)) + 1{TRowId81.ridobjnum}), Bytes, 0, 4);
1534    Result := BytesTo64BaseString(Bytes, 4, -4);
1535    Marshal.Copy(IntPtr(Integer(IntPtr(RowIdPtr)) + 5{TRowId81.ridfilenum}), Bytes, 0, 2);
1536    Result := Result + BytesTo64BaseString(Bytes, 2, -2);
1537    Marshal.Copy(IntPtr(Integer(IntPtr(RowIdPtr)) + 7{TRowId81.ridblocknum}), Bytes, 0, 4);
1538    Result := Result + BytesTo64BaseString(Bytes, 4, -4);
1539    Marshal.Copy(IntPtr(Integer(IntPtr(RowIdPtr)) + 11{TRowId81.ridslotnum}), Bytes, 0, 2);
1540    Result := Result + BytesTo64BaseString(Bytes, 2, -2);
1541  end;
1542end;
1543
1544function URowIdToString(RowIdPtr: PRowId81; Length: integer): string;
1545var
1546  Bytes: TBytes;
1547begin
1548  SetLength(Bytes, Length - 1);
1549  Marshal.Copy(IntPtr(Integer(IntPtr(RowIdPtr)) + 1), Bytes, 0, Length - 1);
1550  Result := '*' + BytesTo64BaseString(Bytes, Length - 1, 0);
1551end;
1552
1553{ Data convertion }
1554
1555function OraDateToDateTime(Buf: IntPtr): TDateTime;
1556var
1557  Time: TDateTime;
1558  OraDate: TBytes;
1559begin
1560  SetLength(OraDate, 7);
1561  Marshal.Copy(Buf, OraDate, 0, 7);
1562  Result := EncodeDate(Abs((OraDate[0] - 100) * 100 + OraDate[1] - 100),
1563    OraDate[2], OraDate[3]);
1564  Time := EncodeTime(OraDate[4] - 1, OraDate[5] - 1, OraDate[6] - 1, 0);
1565  if Result < 0 then
1566    Result := Result - Time
1567  else
1568    Result := Result + Time;
1569end;
1570
1571function OraDateToMSecs(Buf: IntPtr): double;
1572begin
1573  Result := TimeStampToMSecs(DateTimeToTimeStamp(OraDateToDateTime(Buf)));//{$IFNDEF CLR}BitConverter.DoubleToInt64Bits{$ENDIF}
1574end;
1575
1576procedure DateTimeToOraDate(DateTime: TDateTime; Buf: IntPtr);
1577var
1578  Year, Month, Day, Hour, Min, Sec, MSec: word;
1579  OraDate: TBytes;
1580begin
1581  SetLength(OraDate, 8);
1582  DecodeDate(DateTime, Year, Month, Day);
1583  DecodeTime(DateTime, Hour, Min, Sec, MSec);
1584  OraDate[0] := Year div 100 + 100;
1585

Large files files are truncated, but you can click here to view the full file