oracleconnection.pp 46 KB

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