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