1unit oracleconnection;
2
3{
4    Copyright (c) 2006-2019 by Joost van der Sluis, FPC contributors
5
6    Oracle RDBMS connector using the OCI protocol
7
8    See the file COPYING.FPC, included in this distribution,
9    for details about the copyright.
10
11 **********************************************************************}
12
13{$mode objfpc}{$H+}
14
15{$Define LinkDynamically}
16
17interface
18
19uses
20  Classes, SysUtils, db, dbconst, sqldb, bufdataset,
21{$IfDef LinkDynamically}
22  ocidyn,
23{$ELSE}
24  oci,
25{$ENDIF}
26  oratypes;
27
28const
29  DefaultTimeOut = 60;
30
31type
32  EOraDatabaseError = class(ESQLDatabaseError)
33    public
34      property ORAErrorCode: integer read ErrorCode; deprecated 'Please use ErrorCode instead of ORAErrorCode'; // June 2014
35  end;
36
37  TOracleTrans = Class(TSQLHandle)
38  protected
39    FOciSvcCtx  : POCISvcCtx;
40    FOciTrans   : POCITrans;
41    FOciFlags   : ub4;
42  public
43    destructor Destroy(); override;
44  end;
45
46  TOraFieldBuf = record
47    DescType : ub4;      // descriptor type
48    Buffer   : pointer;
49    Ind      : sb2;      // indicator
50    Len      : ub4;
51    Size     : ub4;
52  end;
53
54  TOracleCursor = Class(TSQLCursor)
55    protected
56      FOciStmt     : POCIStmt;
57      FieldBuffers : array of TOraFieldBuf;
58      ParamBuffers : array of TOraFieldBuf;
59    end;
60
61  { TOracleConnection }
62
63  TOracleConnection = class (TSQLConnection)
64  private
65    FOciEnvironment : POciEnv;
66    FOciError       : POCIError;
67    FOciServer      : POCIServer;
68    FOciUserSession : POCISession;
69    FUserMem        : pointer;
70    procedure HandleError;
71    procedure GetParameters(cursor : TSQLCursor; ATransaction : TSQLTransaction; AParams : TParams);
72    procedure SetParameters(cursor : TSQLCursor; ATransaction : TSQLTransaction; AParams : TParams);
73  protected
74    // - Connect/disconnect
75    procedure DoInternalConnect; override;
76    procedure DoInternalDisconnect; override;
77    // - Handle (de)allocation
78    function AllocateCursorHandle:TSQLCursor; override;
79    procedure DeAllocateCursorHandle(var cursor:TSQLCursor); override;
80    function AllocateTransactionHandle:TSQLHandle; override;
81    // - Statement handling
82    procedure PrepareStatement(cursor:TSQLCursor; ATransaction:TSQLTransaction; buf:string; AParams:TParams); override;
83    procedure UnPrepareStatement(cursor:TSQLCursor); override;
84    // - Transaction handling
85    procedure InternalStartDBTransaction(trans:TOracleTrans);
86    function GetTransactionHandle(trans:TSQLHandle):pointer; override;
87    function StartDBTransaction(trans:TSQLHandle; AParams:string):boolean; override;
88    function Commit(trans:TSQLHandle):boolean; override;
89    function Rollback(trans:TSQLHandle):boolean; override;
90    procedure CommitRetaining(trans:TSQLHandle); override;
91    procedure RollbackRetaining(trans:TSQLHandle); override;
92    // - Statement execution
93    procedure Execute(cursor:TSQLCursor; ATransaction:TSQLTransaction; AParams:TParams); override;
94    function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
95    // - Result retrieval
96    procedure AddFieldDefs(cursor:TSQLCursor; FieldDefs:TFieldDefs); override;
97    function Fetch(cursor:TSQLCursor):boolean; override;
98    function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer; out CreateBlob : boolean):boolean; override;
99    procedure LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction); override;
100    procedure FreeFldBuffers(cursor:TSQLCursor); override;
101    procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); override;
102    function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
103
104  public
105    constructor Create(AOwner : TComponent); override;
106  end;
107
108  { TOracleConnectionDef }
109
110  TOracleConnectionDef = Class(TConnectionDef)
111    Class Function TypeName : String; override;
112    Class Function ConnectionClass : TSQLConnectionClass; override;
113    Class Function Description : String; override;
114    Class Function DefaultLibraryName : String; override;
115    Class Function LoadFunction : TLibraryLoadFunction; override;
116    Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
117    Class Function LoadedLibraryName: string; override;
118  end;
119
120implementation
121
122uses
123  math, StrUtils, FmtBCD;
124
125const
126  ObjectQuote='"'; //beginning and ending quote for objects such as table names. Note: can be different from quotes around field names
127
128ResourceString
129  SErrEnvCreateFailed = 'The creation of an Oracle environment failed.';
130  SErrHandleAllocFailed = 'The allocation of the error handle failed.';
131  SErrOracle = 'Oracle returned error %s:';
132
133type
134  TODateTime = record
135    year  : sb2;
136    month : ub1;
137    day   : ub1;
138    hour  : ub1;
139    min   : ub1;
140    sec   : ub1;
141    fsec  : ub4;
142  end;
143
144// Callback functions
145
146function cbf_no_data(ictxp:Pdvoid; bindp:POCIBind; iter:ub4; index:ub4; bufpp:PPdvoid;
147             alenp:Pub4; piecep:Pub1; indp:PPdvoid):sb4;cdecl;
148
149begin
150  bufpp^ := nil;
151  alenp^ := 0;
152  indp^ := nil;
153  piecep^ := OCI_ONE_PIECE;
154  result:=OCI_CONTINUE;
155end;
156
157
158function cbf_get_data(octxp:Pdvoid; bindp:POCIBind; iter:ub4; index:ub4; bufpp:PPdvoid;
159             alenp:PPub4; piecep:Pub1; indp:PPdvoid; rcodep:PPub2):sb4;cdecl;
160
161begin
162// Only 1 row can be stored. No support for multiple rows: only the last row is kept.
163  bufpp^:=TOraFieldBuf(octxp^).Buffer;
164  indp^ := @TOraFieldBuf(octxp^).Ind;
165  TOraFieldBuf(octxp^).Len:=TOraFieldBuf(octxp^).Size;   //reset size to full buffer
166  alenp^ := @TOraFieldBuf(octxp^).Len;
167  rcodep^:=nil;
168  piecep^ := OCI_ONE_PIECE;
169  result:=OCI_CONTINUE;
170end;
171
172// Conversions
173
174Procedure FmtBCD2Nvu(bcd:tBCD;b:pByte);
175var
176  i,j,cnt   : integer;
177  nibbles   : array [0..maxfmtbcdfractionsize-1] of byte;
178  exp       : shortint;
179  bb        : byte;
180begin
181  fillchar(b[0],22,#0);
182  if BCDPrecision(bcd)=0 then // zero, special case
183    begin
184    b[0]:=1;
185    b[1]:=$80;
186    end
187  else
188    begin
189    if (BCDPrecision(bcd)-BCDScale(bcd)) mod 2 <>0 then // odd number before decimal point
190      begin
191      nibbles[0]:=0;
192      j:=1;
193      end
194    else
195      j:=0;
196    for i:=0 to bcd.Precision -1 do
197      if i mod 2 =0 then
198        nibbles[i+j]:=bcd.Fraction[i div 2] shr 4
199      else
200        nibbles[i+j]:=bcd.Fraction[i div 2] and $0f;
201    nibbles[bcd.Precision+j]:=0; // make sure last nibble is also 0 in case we have odd scale
202    exp:=(BCDPrecision(bcd)-BCDScale(bcd)+1) div 2;
203    cnt:=exp+(BCDScale(bcd)+1) div 2;
204    // to avoid "ora 01438: value larger than specified precision allowed for this column"
205    // remove trailing zeros (scale < 0)...
206    while (nibbles[cnt*2-2]*10+nibbles[cnt*2-1])=0 do
207      cnt:=cnt-1;
208    // ... and remove leading zeros (scale > precision)
209    j:=0;
210    while (nibbles[j*2]*10+nibbles[j*2+1])=0 do
211      begin
212      j:=j+1;
213      exp:=exp-1;
214      end;
215    if IsBCDNegative(bcd) then
216      begin
217      b[0]:=cnt-j+1;
218      b[1]:=not(exp+64) and $7f ;
219      for i:=j to cnt-1 do
220        begin
221        bb:=nibbles[i*2]*10+nibbles[i*2+1];
222        b[2+i-j]:=101-bb;
223        end;
224      if 2+cnt-j<22 then  // add a 102 at the end of the number if place left.
225        begin
226        b[0]:=b[0]+1;
227        b[2+cnt-j]:=102;
228        end;
229      end
230    else
231      begin
232      b[0]:=cnt-j+1;
233      b[1]:=(exp+64) or $80 ;
234      for i:=j to cnt-1 do
235        begin
236        bb:=nibbles[i*2]*10+nibbles[i*2+1];
237        b[2+i-j]:=1+bb;
238        end;
239      end;
240    end;
241end;
242
243function Nvu2FmtBCD(b:pbyte):tBCD;
244var
245  i,j       : integer;
246  bb,size   : byte;
247  exp       : shortint;
248  nibbles   : array [0..maxfmtbcdfractionsize-1] of byte;
249  scale     : integer;
250begin
251  size := b[0];
252  if (size=1) and (b[1]=$80) then // special representation for 0
253    result:=IntegerToBCD(0)
254  else
255    begin
256    result.SignSpecialPlaces:=0; //sign positive, non blank, scale 0
257    result.Precision:=1;         //BCDNegate works only if Precision <>0
258    if (b[1] and $80)=$80 then // then the number is positive
259      begin
260      exp := (b[1] and $7f)-65;
261      for i := 0 to size-2 do
262        begin
263        bb := b[i+2]-1;
264        nibbles[i*2]:=bb div 10;
265        nibbles[i*2+1]:=(bb mod 10);
266        end;
267      end
268    else
269      begin
270      BCDNegate(result);
271      exp := (not(b[1]) and $7f)-65;
272      if b[size]=102 then  // last byte doesn't count if = 102
273        size:=size-1;
274      for i := 0 to size-2 do
275        begin
276        bb := 101-b[i+2];
277        nibbles[i*2]:=bb div 10;
278        nibbles[i*2+1]:=(bb mod 10);
279        end;
280      end;
281    nibbles[(size-1)*2]:=0;
282    result.Precision:=(size-1)*2;
283    scale:=result.Precision-(exp*2+2);
284    if scale>=0 then
285      begin
286      if (scale>result.Precision) then  // need to add leading 0s
287        begin
288        for i:=0 to (scale-result.Precision+1) div 2 do
289          result.Fraction[i]:=0;
290        i:=scale-result.Precision;
291        result.Precision:=scale;
292        end
293      else
294        i:=0;
295      j:=i;
296      if (i=0) and (nibbles[0]=0) then // get rid of leading zero received from oci
297        begin
298        result.Precision:=result.Precision-1;
299        j:=-1;
300        end;
301      while i<=result.Precision do // copy nibbles
302        begin
303        if i mod 2 =0 then
304          result.Fraction[i div 2]:=nibbles[i-j] shl 4
305        else
306          result.Fraction[i div 2]:=result.Fraction[i div 2] or nibbles[i-j];
307        i:=i+1;
308        end;
309      result.SignSpecialPlaces:=result.SignSpecialPlaces or scale;
310      end
311    else
312      begin // add trailing zeroes, increase precision to take them into account
313      i:=0;
314      while i<=result.Precision do // copy nibbles
315        begin
316        if i mod 2 =0 then
317          result.Fraction[i div 2]:=nibbles[i] shl 4
318        else
319          result.Fraction[i div 2]:=result.Fraction[i div 2] or nibbles[i];
320        i:=i+1;
321        end;
322      result.Precision:=result.Precision-scale;
323      for i := size -1 to High(result.Fraction) do
324        result.Fraction[i] := 0;
325      end;
326    end;
327end;
328
329
330
331// TOracleConnection
332
333procedure TOracleConnection.HandleError;
334
335var
336    errcode : sb4;
337    buf     : array[0..1023] of char;
338
339begin
340  OCIErrorGet(FOciError,1,nil,errcode,@buf[0],1024,OCI_HTYPE_ERROR);
341
342  raise EOraDatabaseError.CreateFmt(pchar(buf), [], Self, errcode, '')
343end;
344
345procedure TOracleConnection.GetParameters(cursor: TSQLCursor; ATransaction : TSQLTransaction; AParams: TParams);
346var
347    i    : integer;
348    odt  : TODateTime;
349    s    : string;
350
351begin
352  with cursor as TOracleCursor do for i := 0 to High(ParamBuffers) do
353    with AParams[i] do
354      if ParamType=ptOutput then
355      begin
356      if ParamBuffers[i].ind = -1 then
357        Value:=null;
358
359      case DataType of
360        ftInteger         : AsInteger := PInteger(ParamBuffers[i].buffer)^;
361        ftLargeint        : AsLargeInt := PInt64(ParamBuffers[i].buffer)^;
362        ftFloat           : AsFloat := PDouble(ParamBuffers[i].buffer)^;
363        ftString          : begin
364                            SetLength(s,ParamBuffers[i].Len);
365                            move(ParamBuffers[i].buffer^,s[1],length(s)+1);
366                            AsString:=s;
367                            end;
368        ftDate, ftDateTime: begin
369                            OCIDateTimeGetDate(FOciUserSession, FOciError, ParamBuffers[i].buffer, @odt.year, @odt.month, @odt.day);
370                            OCIDateTimeGetTime(FOciUserSession, FOciError, ParamBuffers[i].buffer, @odt.hour, @odt.min, @odt.sec, @odt.fsec);
371                            AsDateTime := ComposeDateTime(EncodeDate(odt.year,odt.month,odt.day), EncodeTime(odt.hour,odt.min,odt.sec,odt.fsec div 1000000));
372                            end;
373        ftFMTBcd          : begin
374                            AsFMTBCD:=Nvu2FmtBCD(ParamBuffers[i].buffer);
375                            end;
376        end;
377
378      end;
379
380end;
381
382procedure TOracleConnection.DoInternalConnect;
383var
384  ConnectString : string;
385  TempServiceContext : POCISvcCtx;
386  IsConnected : boolean;
387  CharSetId: ub2;
388begin
389{$IfDef LinkDynamically}
390  InitialiseOCI;
391{$EndIf}
392
393  inherited DoInternalConnect;
394  //ToDo: get rid of FUserMem, as it isn't used
395  FUserMem := nil;
396  IsConnected := false;
397
398  try
399    case GetConnectionCharSet of
400      'utf8': CharSetId := 873;
401      else    CharSetId := 0; // if it is 0, the NLS_LANG and NLS_NCHAR environment variables are used
402    end;
403    // Create environment handle
404    if OCIEnvNlsCreate(FOciEnvironment,OCI_DEFAULT,nil,nil,nil,nil,0,FUserMem,CharSetId,CharSetId) <> OCI_SUCCESS then
405      DatabaseError(SErrEnvCreateFailed,self);
406    // Create error handle
407    if OciHandleAlloc(FOciEnvironment,FOciError,OCI_HTYPE_ERROR,0,FUserMem) <> OCI_SUCCESS then
408      DatabaseError(SErrHandleAllocFailed,self);
409    // Create server handle
410    if OciHandleAlloc(FOciEnvironment,FOciServer,OCI_HTYPE_SERVER,0,FUserMem) <> OCI_SUCCESS then
411      DatabaseError(SErrHandleAllocFailed,self);
412
413    // Initialize server handle
414    if HostName='' then
415      ConnectString := DatabaseName
416    else
417      ConnectString := '//'+HostName+'/'+DatabaseName;
418    if OCIServerAttach(FOciServer,FOciError,@(ConnectString[1]),Length(ConnectString),OCI_DEFAULT) <> OCI_SUCCESS then
419      HandleError();
420
421    try
422      // Create temporary service-context handle for user authentication
423      if OciHandleAlloc(FOciEnvironment,TempServiceContext,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
424        DatabaseError(SErrHandleAllocFailed,self);
425
426      try
427        // Create user-session handle
428        if OciHandleAlloc(FOciEnvironment,FOciUserSession,OCI_HTYPE_SESSION,0,FUserMem) <> OCI_SUCCESS then
429          DatabaseError(SErrHandleAllocFailed,self);
430        try
431          // Set the server-handle in the service-context handle
432          if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
433            HandleError();
434          // Set username and password in the user-session handle
435          if OCIAttrSet(FOciUserSession,OCI_HTYPE_SESSION,@(Self.UserName[1]),Length(Self.UserName),OCI_ATTR_USERNAME,FOciError) <> OCI_SUCCESS then
436            HandleError();
437          if OCIAttrSet(FOciUserSession,OCI_HTYPE_SESSION,@(Self.Password[1]),Length(Self.Password),OCI_ATTR_PASSWORD,FOciError) <> OCI_SUCCESS then
438            HandleError();
439          // Authenticate
440          if OCISessionBegin(TempServiceContext,FOciError,FOcIUserSession,OCI_CRED_RDBMS,OCI_DEFAULT) <> OCI_SUCCESS then
441            HandleError();
442          IsConnected := true;
443        finally
444          if not IsConnected then
445          begin
446            OCIHandleFree(FOciUserSession,OCI_HTYPE_SESSION);
447            FOciUserSession := nil;
448          end;
449        end;
450      finally
451        // Free temporary service-context handle
452        OCIHandleFree(TempServiceContext,OCI_HTYPE_SVCCTX);
453      end;
454    finally
455      if not IsConnected then
456        OCIServerDetach(FOciServer,FOciError,OCI_DEFAULT);
457    end;
458  finally
459    if not IsConnected then
460    begin
461      if assigned(FOciServer) then
462        OCIHandleFree(FOciServer,OCI_HTYPE_SERVER);
463      if assigned(FOciError) then
464        OCIHandleFree(FOciError,OCI_HTYPE_ERROR);
465      if assigned(FOciEnvironment) then
466        OCIHandleFree(FOciEnvironment,OCI_HTYPE_ENV);
467      FOciEnvironment := nil;
468      FOciError := nil;
469      FOciServer := nil;
470    end;
471  end;
472end;
473
474procedure TOracleConnection.DoInternalDisconnect;
475var
476  TempServiceContext : POCISvcCtx;
477begin
478  inherited DoInternalDisconnect;
479
480  if assigned(FOciEnvironment) then
481  begin
482    if assigned(FOciError) then
483    begin
484      if assigned(FOciServer) then
485      begin
486        if assigned(FOciUserSession) then
487        begin
488          try
489            // Create temporary service-context handle for user-disconnect
490            if OciHandleAlloc(FOciEnvironment,TempServiceContext,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
491              DatabaseError(SErrHandleAllocFailed,self);
492
493            // Set the server handle in the service-context handle
494            if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
495              HandleError();
496            // Set the user session handle in the service-context handle
497            if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciUserSession,0,OCI_ATTR_SESSION,FOciError) <> OCI_SUCCESS then
498              HandleError();
499            // Disconnect uses-session handle
500            if OCISessionEnd(TempServiceContext,FOciError,FOcIUserSession,OCI_DEFAULT) <> OCI_SUCCESS then
501              HandleError();
502          finally
503            // Free user-session handle
504            OCIHandleFree(FOciUserSession,OCI_HTYPE_SESSION);
505            // Free temporary service-context handle
506            OCIHandleFree(TempServiceContext,OCI_HTYPE_SVCCTX);
507            FOciUserSession := nil;
508          end;
509        end;
510
511        try
512          // Disconnect server handle
513          if OCIServerDetach(FOciServer,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
514            HandleError();
515        finally
516          // Free connection handles
517          OCIHandleFree(FOciServer,OCI_HTYPE_SERVER);
518          FOciServer := nil;
519        end;
520      end;
521      OCIHandleFree(FOciError,OCI_HTYPE_ERROR);
522      FOciError := nil;
523    end;
524    OCIHandleFree(FOciEnvironment,OCI_HTYPE_ENV);
525    FOciEnvironment := nil;
526  end;
527{$IfDef LinkDynamically}
528  ReleaseOCI;
529{$EndIf}
530end;
531
532function TOracleConnection.AllocateCursorHandle: TSQLCursor;
533
534var
535  Cursor : TOracleCursor;
536begin
537  Cursor:=TOracleCursor.Create;
538  Result := cursor;
539end;
540
541procedure TOracleConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
542
543  procedure FreeOraFieldBuffers(b: array of TOraFieldBuf);
544  var i : integer;
545  begin
546    if Length(b) > 0 then
547      for i := low(b) to high(b) do
548        if b[i].DescType <> 0 then
549          OciDescriptorFree(b[i].buffer, b[i].DescType)
550        else
551          freemem(b[i].buffer);
552  end;
553
554begin
555  with cursor as TOracleCursor do
556    begin
557    FreeOraFieldBuffers(FieldBuffers);
558    FreeOraFieldBuffers(ParamBuffers);
559    end;
560  FreeAndNil(cursor);
561end;
562
563function TOracleConnection.AllocateTransactionHandle: TSQLHandle;
564var
565  locRes : TOracleTrans;
566begin
567  locRes := TOracleTrans.Create();
568  try
569    // Allocate service-context handle
570    if OciHandleAlloc(FOciEnvironment,locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
571      DatabaseError(SErrHandleAllocFailed,self);
572    // Set the server-handle in the service-context handle
573    if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
574      HandleError();
575    // Set the user-session handle in the service-context handle
576    if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,FOciUserSession,0,OCI_ATTR_SESSION,FOciError) <> OCI_SUCCESS then
577      HandleError();
578
579    // Allocate transaction handle
580    if OciHandleAlloc(FOciEnvironment,locRes.FOciTrans,OCI_HTYPE_TRANS,0,FUserMem) <> OCI_SUCCESS then
581      DatabaseError(SErrHandleAllocFailed,self);
582    // Set the transaction handle in the service-context handle
583    if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,locRes.FOciTrans,0,OCI_ATTR_TRANS,FOciError) <> OCI_SUCCESS then
584      HandleError();
585  except
586    locRes.Free();
587    raise;
588  end;
589  Result := locRes;
590end;
591
592procedure TOracleConnection.PrepareStatement(cursor: TSQLCursor;
593  ATransaction: TSQLTransaction; buf: string; AParams: TParams);
594
595var i        : integer;
596    FOcibind : POCIDefine;
597
598    OFieldType   : ub2;
599    OFieldSize   : sb4;
600    ODescType    : ub4;
601    OBuffer      : pointer;
602
603    stmttype     : ub2;
604
605begin
606  with cursor as TOracleCursor do
607    begin
608    if LogEvent(detActualSQL) then
609      Log(detActualSQL,Buf);
610    if OCIStmtPrepare2(TOracleTrans(ATransaction.Handle).FOciSvcCtx,FOciStmt,FOciError,@buf[1],length(buf),nil,0,OCI_NTV_SYNTAX,OCI_DEFAULT) = OCI_ERROR then
611      HandleError;
612    // Get statement type
613    if OCIAttrGet(FOciStmt,OCI_HTYPE_STMT,@stmttype,nil,OCI_ATTR_STMT_TYPE,FOciError) = OCI_ERROR then
614      HandleError;
615    case stmttype of
616      OCI_STMT_SELECT: FStatementType := stSelect;
617      OCI_STMT_UPDATE: FStatementType := stUpdate;
618      OCI_STMT_DELETE: FStatementType := stDelete;
619      OCI_STMT_INSERT: FStatementType := stInsert;
620      OCI_STMT_CREATE,
621      OCI_STMT_DROP,
622      OCI_STMT_DECLARE,
623      OCI_STMT_ALTER:  FStatementType := stDDL;
624    else
625      FStatementType := stUnknown;
626    end;
627    if FStatementType in [stUpdate,stDelete,stInsert,stDDL] then
628      FSelectable:=false;
629
630    if assigned(AParams) then
631      begin
632      setlength(ParamBuffers,AParams.Count);
633      for i := 0 to AParams.Count-1 do
634        begin
635        ODescType := 0;
636        case AParams[i].DataType of
637          ftSmallInt, ftInteger :
638            begin OFieldType := SQLT_INT; OFieldSize := sizeof(integer); end;
639          ftLargeInt :
640            begin OFieldType := SQLT_INT; OFieldSize := sizeof(int64); end;
641          ftFloat :
642            begin OFieldType := SQLT_FLT; OFieldSize := sizeof(double); end;
643          ftDate, ftDateTime :
644            begin OFieldType := SQLT_TIMESTAMP; OFieldSize := sizeof(pointer); ODescType := OCI_DTYPE_TIMESTAMP; end;
645          ftFixedChar, ftString :
646            begin OFieldType := SQLT_STR; OFieldSize := 4000; end;
647          ftFMTBcd, ftBCD :
648            begin OFieldType := SQLT_VNU; OFieldSize := 22; end;
649          ftBlob :
650            //begin OFieldType := SQLT_LVB; OFieldSize := 65535; end;
651            begin OFieldType := SQLT_BLOB; OFieldSize := sizeof(pointer); ODescType := OCI_DTYPE_LOB; end;
652          ftMemo :
653            begin OFieldType := SQLT_LVC; OFieldSize := 65535; end;
654        else
655          DatabaseErrorFmt(SUnsupportedParameter,[Fieldtypenames[AParams[i].DataType]],self);
656        end;
657
658        ParamBuffers[i].DescType := ODescType;
659        ParamBuffers[i].Len      := OFieldSize;
660        ParamBuffers[i].Size     := OFieldSize;
661        if ODescType <> 0 then
662          begin
663          OBuffer := @ParamBuffers[i].buffer;
664          OCIDescriptorAlloc(FOciEnvironment, OBuffer, ODescType, 0, nil);
665          end
666        else
667          begin
668          OBuffer := getmem(OFieldSize);
669          ParamBuffers[i].buffer := OBuffer;
670          end;
671
672        FOciBind := nil;
673
674        if AParams[i].ParamType=ptInput then
675          begin
676          if OCIBindByName(FOciStmt,FOcibind,FOciError,pchar(AParams[i].Name),length(AParams[i].Name),OBuffer,OFieldSize,OFieldType,@ParamBuffers[i].ind,nil,nil,0,nil,OCI_DEFAULT )= OCI_ERROR then
677            HandleError;
678          end
679        else if AParams[i].ParamType=ptOutput then
680          begin
681          if OCIBindByName(FOciStmt,FOcibind,FOciError,pchar(AParams[i].Name),length(AParams[i].Name),nil,OFieldSize,OFieldType,nil,nil,nil,0,nil,OCI_DATA_AT_EXEC )= OCI_ERROR then
682            HandleError;
683          if OCIBindDynamic(FOcibind, FOciError, nil, @cbf_no_data, @parambuffers[i], @cbf_get_data) <> OCI_SUCCESS then
684            HandleError;
685          end;
686        end;
687      end;
688    FPrepared := True;
689    end;
690end;
691
692procedure TOracleConnection.SetParameters(cursor : TSQLCursor; ATransaction : TSQLTransaction; AParams : TParams);
693
694var i         : integer;
695    year, month, day, hour, min, sec, msec : word;
696    s         : string;
697    LobBuffer : TBytes;
698    LobLength : ub4;
699
700begin
701  with cursor as TOracleCursor do for i := 0 to High(ParamBuffers) do with AParams[i] do
702    if ParamType=ptInput then
703      begin
704      if IsNull then ParamBuffers[i].ind := -1 else ParamBuffers[i].ind := 0;
705
706      case DataType of
707        ftSmallInt,
708        ftInteger         : PInteger(ParamBuffers[i].buffer)^ := AsInteger;
709        ftLargeInt        : PInt64(ParamBuffers[i].buffer)^ := AsLargeInt;
710        ftFloat           : PDouble(ParamBuffers[i].buffer)^ := AsFloat;
711        ftString,
712        ftFixedChar       : begin
713                            s := asString+#0;
714                            move(s[1],parambuffers[i].buffer^,length(s)+1);
715                            end;
716        ftDate, ftDateTime: begin
717                            DecodeDate(asDateTime,year,month,day);
718                            DecodeTime(asDateTime,hour,min,sec,msec);
719                            if OCIDateTimeConstruct(FOciUserSession, FOciError, ParamBuffers[i].buffer, year, month, day, hour, min, sec, msec*1000000, nil, 0) = OCI_ERROR then
720                              HandleError;
721{                           pb := ParamBuffers[i].buffer;
722                            pb[0] := (year div 100)+100;
723                            pb[1] := (year mod 100)+100;
724                            pb[2] := month;
725                            pb[3] := day;
726                            pb[4] := hour+1;
727                            pb[5] := minute+1;
728                            pb[6] := second+1;
729}
730                            end;
731        ftFmtBCD, ftBCD   : begin
732                            FmtBCD2Nvu(asFmtBCD,parambuffers[i].buffer);
733                            end;
734        ftBlob            : begin
735                            LobBuffer := AsBlob; // todo: use AsBytes
736                            LobLength := length(LobBuffer);
737                            // create empty temporary LOB with zero length
738                            if OciLobCreateTemporary(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, ParamBuffers[i].Buffer, OCI_DEFAULT, OCI_DEFAULT, OCI_TEMP_BLOB, False, OCI_DURATION_SESSION) = OCI_ERROR then
739                              HandleError;
740                            if (LobLength > 0) and (OciLobWrite(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, ParamBuffers[i].Buffer, @LobLength, 1, @LobBuffer[0], LobLength, OCI_ONE_PIECE, nil, nil, 0, SQLCS_IMPLICIT) = OCI_ERROR) then
741                              HandleError;
742                            end;
743        ftMemo            : begin
744                            LobBuffer := AsBytes;
745                            LobLength := length(LobBuffer);
746                            if LobLength > 65531 then LobLength := 65531;
747                            PInteger(ParamBuffers[i].Buffer)^ := LobLength;
748                            Move(LobBuffer[0], (ParamBuffers[i].Buffer+sizeof(integer))^, LobLength);
749                            end;
750        else
751          DatabaseErrorFmt(SUnsupportedParameter,[DataType],self);
752      end;
753
754      end;
755
756end;
757
758procedure TOracleConnection.UnPrepareStatement(cursor: TSQLCursor);
759begin
760  if OCIStmtRelease(TOracleCursor(cursor).FOciStmt,FOciError,nil,0,OCI_DEFAULT)<> OCI_SUCCESS then
761    HandleError();
762  cursor.FPrepared:=False;
763end;
764
765procedure TOracleConnection.InternalStartDBTransaction(trans : TOracleTrans);
766begin
767  if OCITransStart(trans.FOciSvcCtx,FOciError,DefaultTimeOut,trans.FOciFlags) <> OCI_SUCCESS then
768    HandleError();
769end;
770
771function TOracleConnection.GetTransactionHandle(trans: TSQLHandle): pointer;
772begin
773  Result := trans;
774end;
775
776function TOracleConnection.StartDBTransaction(trans: TSQLHandle; AParams: string): boolean;
777var
778  flags : ub4;
779  i : Integer;
780  s : string;
781  locTrans : TOracleTrans;
782begin
783  flags := OCI_TRANS_READWRITE;
784  if AParams <> '' then begin
785    i := 1;
786    s := ExtractSubStr(AParams,i,StdWordDelims);
787    while ( s <> '' ) do begin
788      if ( s = 'readonly' ) then
789        flags := OCI_TRANS_READONLY
790      else if ( s = 'serializable' ) then
791        flags := OCI_TRANS_SERIALIZABLE
792      else if ( s = 'readwrite' ) then
793        flags := OCI_TRANS_READWRITE;
794      s := ExtractSubStr(AParams,i,StdWordDelims);
795    end;
796  end;
797  locTrans := TOracleTrans(trans);
798  locTrans.FOciFlags := flags or OCI_TRANS_NEW;
799  InternalStartDBTransaction(locTrans);
800  Result := True;
801end;
802
803function TOracleConnection.Commit(trans: TSQLHandle): boolean;
804begin
805  if OCITransCommit(TOracleTrans(trans).FOciSvcCtx,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
806    HandleError();
807  Result := True;
808end;
809
810function TOracleConnection.Rollback(trans: TSQLHandle): boolean;
811begin
812  if OCITransRollback(TOracleTrans(trans).FOciSvcCtx,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
813    HandleError();
814  Result := True;
815end;
816
817procedure TOracleConnection.CommitRetaining(trans: TSQLHandle);
818begin
819  Commit(trans);
820  InternalStartDBTransaction(TOracleTrans(trans));
821end;
822
823procedure TOracleConnection.RollbackRetaining(trans: TSQLHandle);
824begin
825  Rollback(trans);
826  InternalStartDBTransaction(TOracleTrans(trans));
827end;
828
829procedure TOracleConnection.Execute(cursor: TSQLCursor; ATransaction: TSQLTransaction; AParams: TParams);
830  procedure FreeParameters;
831  var i: integer;
832  begin
833    with cursor as TOracleCursor do
834      for i:=0 to high(ParamBuffers) do
835        if ParamBuffers[i].DescType = OCI_DTYPE_LOB then
836          if OciLobFreeTemporary(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, ParamBuffers[i].Buffer) = OCI_ERROR then
837            HandleError;
838  end;
839begin
840  if Assigned(AParams) and (AParams.Count > 0) then SetParameters(cursor, ATransaction, AParams);
841  if LogEvent(detParamValue) then
842    LogParams(AParams);
843  if cursor.FStatementType = stSelect then
844    begin
845    if OCIStmtExecute(TOracleTrans(ATransaction.Handle).FOciSvcCtx,(cursor as TOracleCursor).FOciStmt,FOciError,0,0,nil,nil,OCI_DEFAULT) = OCI_ERROR then
846      HandleError;
847    end
848  else
849    begin
850    if OCIStmtExecute(TOracleTrans(ATransaction.Handle).FOciSvcCtx,(cursor as TOracleCursor).FOciStmt,FOciError,1,0,nil,nil,OCI_DEFAULT) = OCI_ERROR then
851      HandleError;
852    if Assigned(AParams) and (AParams.Count > 0) then GetParameters(cursor, ATransaction, AParams);
853    end;
854  FreeParameters;
855end;
856
857function TOracleConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;
858var rowcount: ub4;
859begin
860  if Assigned(cursor) and (OCIAttrGet((cursor as TOracleCursor).FOciStmt, OCI_HTYPE_STMT, @rowcount, nil, OCI_ATTR_ROW_COUNT, FOciError) = OCI_SUCCESS) then
861    Result:=rowcount
862  else
863    Result:=inherited RowsAffected(cursor);
864end;
865
866procedure TOracleConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);
867
868var Param      : POCIParam;
869    counter    : ub4;
870
871    FieldType  : TFieldType;
872    FieldName  : string;
873    FieldSize  : cardinal;
874
875    OFieldType   : ub2;
876    OFieldName   : Pchar;
877    OFieldSize   : ub4;
878    OFNameLength : ub4;
879    NumCols      : ub4;
880    FOciDefine   : POCIDefine;
881    OPrecision   : sb2;
882    OScale       : sb1;
883    ODescType    : ub4;
884    OBuffer      : pointer;
885
886begin
887  Param := nil;
888  with cursor as TOracleCursor do
889    begin
890    if OCIAttrGet(FOciStmt,OCI_HTYPE_STMT,@numcols,nil,OCI_ATTR_PARAM_COUNT,FOciError) = OCI_ERROR then
891      HandleError;
892
893    // Note: needs to be cleared then allocated in one go.
894    Setlength(FieldBuffers,numcols);
895
896    for counter := 1 to numcols do
897      begin
898      // Clear OFieldSize. Oracle 9i, 10g doc says *ub4 but some clients use *ub2 leaving
899      // high 16 bit untouched resulting in huge values and ORA-01062
900      // WARNING: this does not work on big endian systems !!!!
901      // To be tested if BE systems have this *ub2<->*ub4 problem
902      OFieldSize:=0;
903      ODescType :=0;
904
905      if OCIParamGet(FOciStmt,OCI_HTYPE_STMT,FOciError,Param,counter) = OCI_ERROR then
906        HandleError;
907
908      if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldType,nil,OCI_ATTR_DATA_TYPE,FOciError) = OCI_ERROR then
909        HandleError;
910
911      if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldSize,nil,OCI_ATTR_DATA_SIZE,FOciError) = OCI_ERROR then
912        HandleError;
913
914      FieldSize := 0;
915
916      case OFieldType of
917        OCI_TYPECODE_NUMBER   : begin
918                                if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oprecision,nil,OCI_ATTR_PRECISION,FOciError) = OCI_ERROR then
919                                  HandleError;
920                                if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oscale,nil,OCI_ATTR_SCALE,FOciError) = OCI_ERROR then
921                                  HandleError;
922                                if (Oscale = 0) and (Oprecision < 10) then
923                                  begin
924                                  if Oprecision=0 then //Number(0,0) = number(32,4)
925                                    begin
926                                    FieldType := ftFMTBCD;
927                                    FieldSize := 4;
928                                    OFieldType := SQLT_VNU;
929                                    OFieldSize:= 22;
930                                    end
931                                  else if Oprecision < 5 then
932                                    begin
933                                    FieldType := ftSmallint;
934                                    OFieldType := SQLT_INT;
935                                    OFieldSize := sizeof(smallint);
936                                    end
937                                  else // OPrecision=5..9, OScale=0
938                                    begin
939                                    FieldType := ftInteger;
940                                    OFieldType := SQLT_INT;
941                                    OFieldSize:= sizeof(integer);
942                                    end;
943                                  end
944                                else if (Oscale = -127) {and (OPrecision=0)} then
945                                  begin
946                                  FieldType := ftFloat;
947                                  OFieldType := SQLT_FLT;
948                                  OFieldSize:=sizeof(double);
949                                  end
950                                else if (Oscale >=0) and (Oscale <=4) and (OPrecision<=12) then
951                                  begin
952                                  FieldType := ftBCD;
953                                  FieldSize := oscale;
954                                  OFieldType := SQLT_VNU;
955                                  OFieldSize:= 22;
956                                  end
957                                else if (OPrecision-Oscale<64) and (Oscale < 64) then // limited to 63 digits before or after decimal point
958                                  begin
959                                  FieldType := ftFMTBCD;
960                                  FieldSize := oscale;
961                                  OFieldType := SQLT_VNU;
962                                  OFieldSize:= 22;
963                                  end
964                                else // approximation with double, best we can do
965                                  begin
966                                  FieldType := ftFloat;
967                                  OFieldType := SQLT_FLT;
968                                  OFieldSize:=sizeof(double);
969                                  end;
970                                end;
971        SQLT_LNG              : begin
972                                FieldType := ftString;
973                                FieldSize := MaxSmallint; // OFieldSize is zero for LONG data type
974                                OFieldSize:= MaxSmallint+1;
975                                OFieldType:=SQLT_STR;
976                                end;
977        OCI_TYPECODE_CHAR,
978        OCI_TYPECODE_VARCHAR,
979        OCI_TYPECODE_VARCHAR2 : begin
980                                FieldType := ftString;
981                                FieldSize := OFieldSize;
982                                inc(OFieldSize);
983                                OFieldType:=SQLT_STR;
984                                end;
985        OCI_TYPECODE_DATE     : FieldType := ftDate;
986        OCI_TYPECODE_TIMESTAMP,
987        OCI_TYPECODE_TIMESTAMP_LTZ,
988        OCI_TYPECODE_TIMESTAMP_TZ :
989                                begin
990                                FieldType := ftDateTime;
991                                OFieldType := SQLT_TIMESTAMP;
992                                ODescType := OCI_DTYPE_TIMESTAMP;
993                                end;
994        OCI_TYPECODE_BFLOAT,
995        OCI_TYPECODE_BDOUBLE  : begin
996                                FieldType := ftFloat;
997                                OFieldType := SQLT_BDOUBLE;
998                                OFieldSize := sizeof(double);
999                                end;
1000        SQLT_BLOB             : begin
1001                                FieldType := ftBlob;
1002                                ODescType := OCI_DTYPE_LOB;
1003                                end;
1004        SQLT_CLOB             : begin
1005                                FieldType := ftMemo;
1006                                ODescType := OCI_DTYPE_LOB;
1007                                end
1008      else
1009        FieldType := ftUnknown;
1010      end;
1011
1012      FieldBuffers[counter-1].DescType := ODescType;
1013      if ODescType <> 0 then
1014        begin
1015        OBuffer := @FieldBuffers[counter-1].buffer;
1016        OCIDescriptorAlloc(FOciEnvironment, OBuffer, ODescType, 0, nil);
1017        OFieldSize := sizeof(pointer);
1018        end
1019      else
1020        begin
1021        OBuffer := getmem(OFieldSize);
1022        FieldBuffers[counter-1].buffer := OBuffer;
1023        end;
1024
1025      if FieldType <> ftUnknown then
1026        begin
1027        FOciDefine := nil;
1028        if OciDefineByPos(FOciStmt,FOciDefine,FOciError,counter,OBuffer,OFieldSize,OFieldType,@FieldBuffers[counter-1].ind,nil,nil,OCI_DEFAULT) = OCI_ERROR then
1029          HandleError;
1030        end;
1031
1032      if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldName,@OFNameLength,OCI_ATTR_NAME,FOciError) <> OCI_SUCCESS then
1033        HandleError;
1034
1035      setlength(Fieldname,OFNameLength);
1036      move(OFieldName^,Fieldname[1],OFNameLength);
1037
1038      FieldDefs.Add(FieldDefs.MakeNameUnique(FieldName), FieldType, FieldSize, False, counter);
1039      end;
1040  end;
1041end;
1042
1043function TOracleConnection.Fetch(cursor: TSQLCursor): boolean;
1044begin
1045  case OCIStmtFetch2((cursor as TOracleCursor).FOciStmt,FOciError,1,OCI_FETCH_NEXT,1,OCI_DEFAULT) of
1046    OCI_ERROR   : begin
1047                  Result := False;
1048                  HandleError;
1049                  end;
1050    OCI_NO_DATA : Result := False;
1051    OCI_SUCCESS : Result := True;
1052    OCI_SUCCESS_WITH_INFO : Begin
1053                            Result := True;
1054                            // HandleError;
1055                            end;
1056  end; {case}
1057end;
1058
1059function TOracleConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer; out CreateBlob : boolean): boolean;
1060
1061var
1062  b       : pbyte;
1063  size,i  : byte;
1064  exp     : shortint;
1065  cur     : Currency;
1066  odt     : TODateTime;
1067
1068begin
1069  CreateBlob := False;
1070  with cursor as TOracleCursor do if fieldbuffers[FieldDef.FieldNo-1].ind = -1 then
1071    Result := False
1072  else
1073    begin
1074    Result := True;
1075    case FieldDef.DataType of
1076      ftString :
1077        move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,FieldDef.Size);
1078      ftBCD :
1079        begin
1080        b := fieldbuffers[FieldDef.FieldNo-1].buffer;
1081        size := b[0];
1082        cur := 0;
1083        if (b[1] and $80)=$80 then // the number is positive
1084          begin
1085          exp := (b[1] and $7f)-65;
1086          for i := 2 to size do
1087            cur := cur + (b[i]-1) * intpower(100,-(i-2)+exp);
1088          end
1089        else
1090          begin
1091          exp := (not(b[1]) and $7f)-65;
1092          for i := 2 to size-1 do
1093            cur := cur + (101-b[i]) * intpower(100,-(i-2)+exp);
1094          cur := -cur;
1095          end;
1096        move(cur,buffer^,SizeOf(Currency));
1097        end;
1098      ftFmtBCD :
1099        pBCD(buffer)^:= Nvu2FmtBCD(fieldbuffers[FieldDef.FieldNo-1].buffer);
1100      ftFloat :
1101        move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(double));
1102      ftSmallInt :
1103        move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(smallint));
1104      ftInteger :
1105        move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(integer));
1106      ftDate :
1107        begin
1108        b := fieldbuffers[FieldDef.FieldNo-1].buffer;
1109        PDateTime(buffer)^ := ComposeDateTime(EncodeDate((b[0]-100)*100+(b[1]-100),b[2],b[3]), EncodeTime(b[4]-1, b[5]-1, b[6]-1, 0));
1110        end;
1111      ftDateTime :
1112        begin
1113        OCIDateTimeGetDate(FOciUserSession, FOciError, FieldBuffers[FieldDef.FieldNo-1].buffer, @odt.year, @odt.month, @odt.day);
1114        OCIDateTimeGetTime(FOciUserSession, FOciError, FieldBuffers[FieldDef.FieldNo-1].buffer, @odt.hour, @odt.min, @odt.sec, @odt.fsec);
1115        PDateTime(buffer)^ := ComposeDateTime(EncodeDate(odt.year,odt.month,odt.day), EncodeTime(odt.hour,odt.min,odt.sec,odt.fsec div 1000000));
1116        end;
1117      ftBlob,
1118      ftMemo :
1119        CreateBlob := True;
1120    else
1121      Result := False;
1122    end;
1123    end;
1124end;
1125
1126procedure TOracleConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
1127var LobLocator: pointer;
1128    LobCharSetForm: ub1;
1129    LobLength, LobSize: ub4;
1130begin
1131  LobLocator := (cursor as TOracleCursor).FieldBuffers[FieldDef.FieldNo-1].Buffer;
1132  //if OCILobLocatorIsInit(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, LobLocator, @is_init) = OCI_ERROR then
1133  //  HandleError;
1134  // For character LOBs, it is the number of characters, for binary LOBs and BFILEs it is the number of bytes
1135  if OciLobGetLength(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, LobLocator, @LobLength) = OCI_ERROR then
1136    HandleError;
1137  if OCILobCharSetForm(FOciEnvironment, FOciError, LobLocator, @LobCharSetForm) = OCI_ERROR then
1138    HandleError;
1139  // Adjust initial buffer size (in bytes), while LobLength can be in characters
1140  case LobCharSetForm of
1141    0: ;            // BLOB
1142    SQLCS_IMPLICIT, // CLOB
1143    SQLCS_NCHAR:    // NCLOB
1144      LobLength := LobLength*4;
1145  end;
1146  ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer, LobLength);
1147  LobSize := 0;
1148  // For CLOBs and NCLOBs the total amount of data which should be readed is on input in characters, but on output is in bytes if client character set is varying-width
1149  // The application must call OCILobRead() (in streamed mode) over and over again to read more pieces of the LOB until the OCI_NEED_DATA error code is not returned.
1150  // If the LOB is a BLOB, the csid and csfrm parameters are ignored.
1151  if (LobLength > 0) and (OciLobRead(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, LobLocator, @LobSize, 1, ABlobBuf^.BlobBuffer^.Buffer, LobLength, nil, nil, 0, LobCharSetForm) = OCI_ERROR) then
1152    HandleError;
1153  // Shrink initial buffer if needed (we assume that LobSize is in bytes, what is true for CLOB,NCLOB if client character set is varying-width, but if client character set is fixed-width then it is in characters)
1154  if LobSize <> LobLength then
1155    ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer, LobSize);
1156  ABlobBuf^.BlobBuffer^.Size := LobSize;
1157end;
1158
1159procedure TOracleConnection.FreeFldBuffers(cursor: TSQLCursor);
1160begin
1161//  inherited FreeFldBuffers(cursor);
1162end;
1163
1164procedure TOracleConnection.UpdateIndexDefs(IndexDefs: TIndexDefs;
1165  TableName: string);
1166var qry : TSQLQuery;
1167
1168begin
1169  if not assigned(Transaction) then
1170    DatabaseError(SErrConnTransactionnSet);
1171
1172  // Get table name into canonical format
1173  if (length(TableName)>2) and (TableName[1]=ObjectQuote) and (TableName[length(TableName)]=ObjectQuote) then
1174    TableName := AnsiDequotedStr(TableName, ObjectQuote)
1175  else
1176    TableName := UpperCase(TableName); //ANSI SQL: the name of an identifier (such as table names) are implicitly converted to uppercase, unless double quotes are used when referring to the identifier.
1177
1178  qry := tsqlquery.Create(nil);
1179  qry.transaction := Transaction;
1180  qry.database := Self;
1181  with qry do
1182    begin
1183    ReadOnly := True;
1184    sql.clear;
1185    sql.add('SELECT '+
1186              'i.INDEX_NAME,  '+
1187              'c.COLUMN_NAME, '+
1188              'p.CONSTRAINT_TYPE '+
1189            'FROM ALL_INDEXES i, ALL_IND_COLUMNS c,ALL_CONSTRAINTS p  '+
1190            'WHERE '+
1191              'i.OWNER=c.INDEX_OWNER AND '+
1192              'i.INDEX_NAME=c.INDEX_NAME AND '+
1193              'p.INDEX_NAME(+)=i.INDEX_NAME AND '+
1194              'c.TABLE_NAME = ''' + TableName + ''' '+
1195            'ORDER by i.INDEX_NAME,c.COLUMN_POSITION');
1196    open;
1197    end;
1198  while not qry.eof do with IndexDefs.AddIndexDef do
1199    begin
1200    Name := trim(qry.fields[0].asstring);
1201    Fields := trim(qry.Fields[1].asstring);
1202    If UpperCase(qry.fields[2].asstring)='P' then options := options + [ixPrimary];
1203    If UpperCase(qry.fields[2].asstring)='U' then options := options + [ixUnique];
1204    qry.next;
1205    while (name = qry.fields[0].asstring) and (not qry.eof) do
1206      begin
1207      Fields := Fields + ';' + trim(qry.Fields[1].asstring);
1208      qry.next;
1209      end;
1210    end;
1211  qry.close;
1212  qry.free;
1213end;
1214
1215function TOracleConnection.GetSchemaInfoSQL(SchemaType: TSchemaType;
1216  SchemaObjectName, SchemaPattern: string): string;
1217var
1218  s : string;
1219begin
1220  case SchemaType of
1221    stTables     : s := 'SELECT '+
1222                          '''' + DatabaseName + ''' as catalog_name, '+
1223                          'sys_context( ''userenv'', ''current_schema'' ) as schema_name, '+
1224                          'TABLE_NAME,'+
1225                          'TABLE_TYPE '+
1226                        'FROM USER_CATALOG ' +
1227                        'WHERE '+
1228                          'TABLE_TYPE<>''SEQUENCE'' '+
1229                        'ORDER BY TABLE_NAME';
1230
1231    stSysTables  : s := 'SELECT '+
1232                          '''' + DatabaseName + ''' as catalog_name, '+
1233                          'OWNER as schema_name, '+
1234                          'TABLE_NAME,'+
1235                          'TABLE_TYPE '+
1236                        'FROM ALL_CATALOG ' +
1237                        'WHERE '+
1238                          'TABLE_TYPE<>''SEQUENCE'' '+
1239                        'ORDER BY TABLE_NAME';
1240    stColumns    : s := 'SELECT '+
1241                          'OWNER as schema_name, '+
1242                          'COLUMN_NAME, '+
1243                          'DATA_TYPE as column_datatype, '+
1244                          'CHARACTER_SET_NAME, '+
1245                          'NULLABLE as column_nullable, '+
1246                          'DATA_LENGTH as column_length, '+
1247                          'DATA_PRECISION as column_precision, '+
1248                          'DATA_SCALE as column_scale, '+
1249                          'DATA_DEFAULT as column_default '+
1250                        'FROM ALL_TAB_COLUMNS '+
1251                        'WHERE Upper(TABLE_NAME) = '''+UpperCase(SchemaObjectName)+''' '+
1252                        'ORDER BY COLUMN_NAME';
1253    // Columns of tables, views and clusters accessible to user; hidden columns are filtered out.
1254    stProcedures : s := 'SELECT '+
1255                          'case when PROCEDURE_NAME is null then OBJECT_NAME ELSE OBJECT_NAME || ''.'' || PROCEDURE_NAME end AS procedure_name '+
1256                        'FROM USER_PROCEDURES ';
1257  else
1258    DatabaseError(SMetadataUnavailable)
1259  end; {case}
1260  result := s;
1261end;
1262
1263constructor TOracleConnection.Create(AOwner: TComponent);
1264begin
1265  inherited Create(AOwner);
1266  FConnOptions := FConnOptions + [sqEscapeRepeat,sqSequences];
1267  FOciEnvironment := nil;
1268  FOciError := nil;
1269  FOciServer := nil;
1270  FOciUserSession := nil;
1271  FUserMem := nil;
1272end;
1273
1274{ TOracleConnectionDef }
1275
1276class function TOracleConnectionDef.TypeName: String;
1277begin
1278  Result:='Oracle';
1279end;
1280
1281class function TOracleConnectionDef.ConnectionClass: TSQLConnectionClass;
1282begin
1283  Result:=TOracleConnection;
1284end;
1285
1286class function TOracleConnectionDef.Description: String;
1287begin
1288  Result:='Connect to an Oracle database directly via the client library';
1289end;
1290
1291class function TOracleConnectionDef.DefaultLibraryName: String;
1292begin
1293  {$IfDef LinkDynamically}
1294  Result:=ocilib;
1295  {$else}
1296  Result:='';
1297  {$endif}
1298end;
1299
1300class function TOracleConnectionDef.LoadFunction: TLibraryLoadFunction;
1301begin
1302  {$IfDef LinkDynamically}
1303  Result:=@InitialiseOCI;
1304  {$else}
1305  Result:=Nil;
1306  {$endif}
1307end;
1308
1309class function TOracleConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
1310begin
1311  {$IfDef LinkDynamically}
1312  Result:=@ReleaseOCI;
1313  {$else}
1314  Result:=Nil;
1315  {$endif}
1316end;
1317
1318class function TOracleConnectionDef.LoadedLibraryName: string;
1319begin
1320  {$IfDef LinkDynamically}
1321  Result:=OCILoadedLibrary;
1322  {$else}
1323  Result:='';
1324  {$endif}
1325end;
1326
1327{ TOracleTrans }
1328
1329destructor TOracleTrans.Destroy();
1330begin
1331  OCIHandleFree(FOciTrans,OCI_HTYPE_TRANS);
1332  OCIHandleFree(FOciSvcCtx,OCI_HTYPE_SVCCTX);
1333  inherited Destroy();
1334end;
1335
1336initialization
1337  RegisterConnection(TOracleConnectionDef);
1338finalization
1339  UnRegisterConnection(TOracleConnectionDef);
1340end.
1341
1342