oracleconnection.pp 46 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317
  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 Nvu2FmtBCD(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
  299. errcode : sb4;
  300. buf : array[0..1023] of char;
  301. begin
  302. OCIErrorGet(FOciError,1,nil,errcode,@buf[0],1024,OCI_HTYPE_ERROR);
  303. raise EOraDatabaseError.CreateFmt(pchar(buf), [], Self, errcode, '')
  304. end;
  305. procedure TOracleConnection.GetParameters(cursor: TSQLCursor; ATransaction : TSQLTransaction; AParams: TParams);
  306. var
  307. i : integer;
  308. odt : TODateTime;
  309. s : string;
  310. begin
  311. with cursor as TOracleCursor do for i := 0 to High(ParamBuffers) do
  312. with AParams[i] do
  313. if ParamType=ptOutput then
  314. begin
  315. if ParamBuffers[i].ind = -1 then
  316. Value:=null;
  317. case DataType of
  318. ftInteger : AsInteger := PInteger(ParamBuffers[i].buffer)^;
  319. ftFloat : AsFloat := PDouble(ParamBuffers[i].buffer)^;
  320. ftString : begin
  321. SetLength(s,ParamBuffers[i].Len);
  322. move(ParamBuffers[i].buffer^,s[1],length(s)+1);
  323. AsString:=s;
  324. end;
  325. ftDate, ftDateTime: begin
  326. OCIDateTimeGetDate(FOciUserSession, FOciError, ParamBuffers[i].buffer, @odt.year, @odt.month, @odt.day);
  327. OCIDateTimeGetTime(FOciUserSession, FOciError, ParamBuffers[i].buffer, @odt.hour, @odt.min, @odt.sec, @odt.fsec);
  328. AsDateTime := ComposeDateTime(EncodeDate(odt.year,odt.month,odt.day), EncodeTime(odt.hour,odt.min,odt.sec,odt.fsec div 1000000));
  329. end;
  330. ftFMTBcd : begin
  331. AsFMTBCD:=Nvu2FmtBCD(ParamBuffers[i].buffer);
  332. end;
  333. end;
  334. end;
  335. end;
  336. procedure TOracleConnection.DoInternalConnect;
  337. var
  338. ConnectString : string;
  339. TempServiceContext : POCISvcCtx;
  340. IsConnected : boolean;
  341. begin
  342. {$IfDef LinkDynamically}
  343. InitialiseOCI;
  344. {$EndIf}
  345. inherited DoInternalConnect;
  346. //todo: get rid of FUserMem, as it isn't used
  347. FUserMem := nil;
  348. IsConnected := false;
  349. try
  350. // Create environment handle
  351. if OCIEnvCreate(FOciEnvironment,OCI_DEFAULT,nil,nil,nil,nil,0,FUserMem) <> OCI_SUCCESS then
  352. DatabaseError(SErrEnvCreateFailed,self);
  353. // Create error handle
  354. if OciHandleAlloc(FOciEnvironment,FOciError,OCI_HTYPE_ERROR,0,FUserMem) <> OCI_SUCCESS then
  355. DatabaseError(SErrHandleAllocFailed,self);
  356. // Create server handle
  357. if OciHandleAlloc(FOciEnvironment,FOciServer,OCI_HTYPE_SERVER,0,FUserMem) <> OCI_SUCCESS then
  358. DatabaseError(SErrHandleAllocFailed,self);
  359. // Initialize server handle
  360. if hostname='' then
  361. connectstring := databasename
  362. else
  363. connectstring := '//'+hostname+'/'+databasename;
  364. if OCIServerAttach(FOciServer,FOciError,@(ConnectString[1]),Length(ConnectString),OCI_DEFAULT) <> OCI_SUCCESS then
  365. HandleError();
  366. try
  367. // Create temporary service-context handle for user authentication
  368. if OciHandleAlloc(FOciEnvironment,TempServiceContext,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
  369. DatabaseError(SErrHandleAllocFailed,self);
  370. try
  371. // Create user-session handle
  372. if OciHandleAlloc(FOciEnvironment,FOciUserSession,OCI_HTYPE_SESSION,0,FUserMem) <> OCI_SUCCESS then
  373. DatabaseError(SErrHandleAllocFailed,self);
  374. try
  375. // Set the server-handle in the service-context handle
  376. if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
  377. HandleError();
  378. // Set username and password in the user-session handle
  379. if OCIAttrSet(FOciUserSession,OCI_HTYPE_SESSION,@(Self.UserName[1]),Length(Self.UserName),OCI_ATTR_USERNAME,FOciError) <> OCI_SUCCESS then
  380. HandleError();
  381. if OCIAttrSet(FOciUserSession,OCI_HTYPE_SESSION,@(Self.Password[1]),Length(Self.Password),OCI_ATTR_PASSWORD,FOciError) <> OCI_SUCCESS then
  382. HandleError();
  383. // Authenticate
  384. if OCISessionBegin(TempServiceContext,FOciError,FOcIUserSession,OCI_CRED_RDBMS,OCI_DEFAULT) <> OCI_SUCCESS then
  385. HandleError();
  386. IsConnected := true;
  387. finally
  388. if not IsConnected then
  389. begin
  390. OCIHandleFree(FOciUserSession,OCI_HTYPE_SESSION);
  391. FOciUserSession := nil;
  392. end;
  393. end;
  394. finally
  395. // Free temporary service-context handle
  396. OCIHandleFree(TempServiceContext,OCI_HTYPE_SVCCTX);
  397. end;
  398. finally
  399. if not IsConnected then
  400. OCIServerDetach(FOciServer,FOciError,OCI_DEFAULT);
  401. end;
  402. finally
  403. if not IsConnected then
  404. begin
  405. if assigned(FOciServer) then
  406. OCIHandleFree(FOciServer,OCI_HTYPE_SERVER);
  407. if assigned(FOciError) then
  408. OCIHandleFree(FOciError,OCI_HTYPE_ERROR);
  409. if assigned(FOciEnvironment) then
  410. OCIHandleFree(FOciEnvironment,OCI_HTYPE_ENV);
  411. FOciEnvironment := nil;
  412. FOciError := nil;
  413. FOciServer := nil;
  414. end;
  415. end;
  416. end;
  417. procedure TOracleConnection.DoInternalDisconnect;
  418. var
  419. TempServiceContext : POCISvcCtx;
  420. begin
  421. inherited DoInternalDisconnect;
  422. if assigned(FOciEnvironment) then
  423. begin
  424. if assigned(FOciError) then
  425. begin
  426. if assigned(FOciServer) then
  427. begin
  428. if assigned(FOciUserSession) then
  429. begin
  430. try
  431. // Create temporary service-context handle for user-disconnect
  432. if OciHandleAlloc(FOciEnvironment,TempServiceContext,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
  433. DatabaseError(SErrHandleAllocFailed,self);
  434. // Set the server handle in the service-context handle
  435. if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
  436. HandleError();
  437. // Set the user session handle in the service-context handle
  438. if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciUserSession,0,OCI_ATTR_SESSION,FOciError) <> OCI_SUCCESS then
  439. HandleError();
  440. // Disconnect uses-session handle
  441. if OCISessionEnd(TempServiceContext,FOciError,FOcIUserSession,OCI_DEFAULT) <> OCI_SUCCESS then
  442. HandleError();
  443. finally
  444. // Free user-session handle
  445. OCIHandleFree(FOciUserSession,OCI_HTYPE_SESSION);
  446. // Free temporary service-context handle
  447. OCIHandleFree(TempServiceContext,OCI_HTYPE_SVCCTX);
  448. FOciUserSession := nil;
  449. end;
  450. end;
  451. try
  452. // Disconnect server handle
  453. if OCIServerDetach(FOciServer,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
  454. HandleError();
  455. finally
  456. // Free connection handles
  457. OCIHandleFree(FOciServer,OCI_HTYPE_SERVER);
  458. FOciServer := nil;
  459. end;
  460. end;
  461. OCIHandleFree(FOciError,OCI_HTYPE_ERROR);
  462. FOciError := nil;
  463. end;
  464. OCIHandleFree(FOciEnvironment,OCI_HTYPE_ENV);
  465. FOciEnvironment := nil;
  466. end;
  467. {$IfDef LinkDynamically}
  468. ReleaseOCI;
  469. {$EndIf}
  470. end;
  471. function TOracleConnection.AllocateCursorHandle: TSQLCursor;
  472. var
  473. Cursor : TOracleCursor;
  474. begin
  475. Cursor:=TOracleCursor.Create;
  476. Result := cursor;
  477. end;
  478. procedure TOracleConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
  479. procedure FreeOraFieldBuffers(b: array of TOraFieldBuf);
  480. var i : integer;
  481. begin
  482. if Length(b) > 0 then
  483. for i := low(b) to high(b) do
  484. if b[i].DescType <> 0 then
  485. OciDescriptorFree(b[i].buffer, b[i].DescType)
  486. else
  487. freemem(b[i].buffer);
  488. end;
  489. begin
  490. with cursor as TOracleCursor do
  491. begin
  492. FreeOraFieldBuffers(FieldBuffers);
  493. FreeOraFieldBuffers(ParamBuffers);
  494. end;
  495. FreeAndNil(cursor);
  496. end;
  497. function TOracleConnection.AllocateTransactionHandle: TSQLHandle;
  498. var
  499. locRes : TOracleTrans;
  500. begin
  501. locRes := TOracleTrans.Create();
  502. try
  503. // Allocate service-context handle
  504. if OciHandleAlloc(FOciEnvironment,locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
  505. DatabaseError(SErrHandleAllocFailed,self);
  506. // Set the server-handle in the service-context handle
  507. if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
  508. HandleError();
  509. // Set the user-session handle in the service-context handle
  510. if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,FOciUserSession,0,OCI_ATTR_SESSION,FOciError) <> OCI_SUCCESS then
  511. HandleError();
  512. // Allocate transaction handle
  513. if OciHandleAlloc(FOciEnvironment,locRes.FOciTrans,OCI_HTYPE_TRANS,0,FUserMem) <> OCI_SUCCESS then
  514. DatabaseError(SErrHandleAllocFailed,self);
  515. // Set the transaction handle in the service-context handle
  516. if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,locRes.FOciTrans,0,OCI_ATTR_TRANS,FOciError) <> OCI_SUCCESS then
  517. HandleError();
  518. except
  519. locRes.Free();
  520. raise;
  521. end;
  522. Result := locRes;
  523. end;
  524. procedure TOracleConnection.PrepareStatement(cursor: TSQLCursor;
  525. ATransaction: TSQLTransaction; buf: string; AParams: TParams);
  526. var i : integer;
  527. FOcibind : POCIDefine;
  528. OFieldType : ub2;
  529. OFieldSize : sb4;
  530. ODescType : ub4;
  531. OBuffer : pointer;
  532. stmttype : ub2;
  533. begin
  534. with cursor as TOracleCursor do
  535. begin
  536. if OCIStmtPrepare2(TOracleTrans(ATransaction.Handle).FOciSvcCtx,FOciStmt,FOciError,@buf[1],length(buf),nil,0,OCI_NTV_SYNTAX,OCI_DEFAULT) = OCI_ERROR then
  537. HandleError;
  538. // Get statement type
  539. if OCIAttrGet(FOciStmt,OCI_HTYPE_STMT,@stmttype,nil,OCI_ATTR_STMT_TYPE,FOciError) = OCI_ERROR then
  540. HandleError;
  541. case stmttype of
  542. OCI_STMT_SELECT: FStatementType := stSelect;
  543. OCI_STMT_UPDATE: FStatementType := stUpdate;
  544. OCI_STMT_DELETE: FStatementType := stDelete;
  545. OCI_STMT_INSERT: FStatementType := stInsert;
  546. OCI_STMT_CREATE,
  547. OCI_STMT_DROP,
  548. OCI_STMT_DECLARE,
  549. OCI_STMT_ALTER: FStatementType := stDDL;
  550. else
  551. FStatementType := stUnknown;
  552. end;
  553. if FStatementType in [stUpdate,stDelete,stInsert,stDDL] then
  554. FSelectable:=false;
  555. if assigned(AParams) then
  556. begin
  557. setlength(ParamBuffers,AParams.Count);
  558. for i := 0 to AParams.Count-1 do
  559. begin
  560. ODescType := 0;
  561. case AParams[i].DataType of
  562. ftSmallInt, ftInteger :
  563. begin OFieldType := SQLT_INT; OFieldSize := sizeof(integer); end;
  564. ftLargeInt :
  565. begin OFieldType := SQLT_INT; OFieldSize := sizeof(int64); end;
  566. ftFloat :
  567. begin OFieldType := SQLT_FLT; OFieldSize := sizeof(double); end;
  568. ftDate, ftDateTime :
  569. begin OFieldType := SQLT_TIMESTAMP; OFieldSize := sizeof(pointer); ODescType := OCI_DTYPE_TIMESTAMP; end;
  570. ftFixedChar, ftString :
  571. begin OFieldType := SQLT_STR; OFieldSize := 4000; end;
  572. ftFMTBcd, ftBCD :
  573. begin OFieldType := SQLT_VNU; OFieldSize := 22; end;
  574. ftBlob :
  575. //begin OFieldType := SQLT_LVB; OFieldSize := 65535; end;
  576. begin OFieldType := SQLT_BLOB; OFieldSize := sizeof(pointer); ODescType := OCI_DTYPE_LOB; end;
  577. ftMemo :
  578. begin OFieldType := SQLT_LVC; OFieldSize := 65535; end;
  579. else
  580. DatabaseErrorFmt(SUnsupportedParameter,[Fieldtypenames[AParams[i].DataType]],self);
  581. end;
  582. ParamBuffers[i].DescType := ODescType;
  583. ParamBuffers[i].Len := OFieldSize;
  584. ParamBuffers[i].Size := OFieldSize;
  585. if ODescType <> 0 then
  586. begin
  587. OBuffer := @ParamBuffers[i].buffer;
  588. OCIDescriptorAlloc(FOciEnvironment, OBuffer, ODescType, 0, nil);
  589. end
  590. else
  591. begin
  592. OBuffer := getmem(OFieldSize);
  593. ParamBuffers[i].buffer := OBuffer;
  594. end;
  595. FOciBind := nil;
  596. if AParams[i].ParamType=ptInput then
  597. begin
  598. 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
  599. HandleError;
  600. end
  601. else if AParams[i].ParamType=ptOutput then
  602. begin
  603. 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
  604. HandleError;
  605. if OCIBindDynamic(FOcibind, FOciError, nil, @cbf_no_data, @parambuffers[i], @cbf_get_data) <> OCI_SUCCESS then
  606. HandleError;
  607. end;
  608. end;
  609. end;
  610. FPrepared := True;
  611. end;
  612. end;
  613. procedure TOracleConnection.SetParameters(cursor : TSQLCursor; ATransaction : TSQLTransaction; AParams : TParams);
  614. var i : integer;
  615. year, month, day, hour, min, sec, msec : word;
  616. s : string;
  617. LobBuffer : string;
  618. LobLength : ub4;
  619. begin
  620. with cursor as TOracleCursor do for i := 0 to High(ParamBuffers) do with AParams[i] do
  621. if ParamType=ptInput then
  622. begin
  623. if IsNull then ParamBuffers[i].ind := -1 else ParamBuffers[i].ind := 0;
  624. case DataType of
  625. ftSmallInt,
  626. ftInteger : PInteger(ParamBuffers[i].buffer)^ := AsInteger;
  627. ftLargeInt : PInt64(ParamBuffers[i].buffer)^ := AsLargeInt;
  628. ftFloat : PDouble(ParamBuffers[i].buffer)^ := AsFloat;
  629. ftString,
  630. ftFixedChar : begin
  631. s := asString+#0;
  632. move(s[1],parambuffers[i].buffer^,length(s)+1);
  633. end;
  634. ftDate, ftDateTime: begin
  635. DecodeDate(asDateTime,year,month,day);
  636. DecodeTime(asDateTime,hour,min,sec,msec);
  637. if OCIDateTimeConstruct(FOciUserSession, FOciError, ParamBuffers[i].buffer, year, month, day, hour, min, sec, msec*1000000, nil, 0) = OCI_ERROR then
  638. HandleError;
  639. { pb := ParamBuffers[i].buffer;
  640. pb[0] := (year div 100)+100;
  641. pb[1] := (year mod 100)+100;
  642. pb[2] := month;
  643. pb[3] := day;
  644. pb[4] := hour+1;
  645. pb[5] := minute+1;
  646. pb[6] := second+1;
  647. }
  648. end;
  649. ftFmtBCD, ftBCD : begin
  650. FmtBCD2Nvu(asFmtBCD,parambuffers[i].buffer);
  651. end;
  652. ftBlob : begin
  653. LobBuffer := AsBlob; // todo: use AsBytes
  654. LobLength := length(LobBuffer);
  655. // create empty temporary LOB with zero length
  656. if OciLobCreateTemporary(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, ParamBuffers[i].Buffer, OCI_DEFAULT, OCI_DEFAULT, OCI_TEMP_BLOB, False, OCI_DURATION_SESSION) = OCI_ERROR then
  657. HandleError;
  658. 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
  659. HandleError;
  660. end;
  661. ftMemo : begin
  662. LobBuffer := AsString;
  663. LobLength := length(LobBuffer);
  664. if LobLength > 65531 then LobLength := 65531;
  665. PInteger(ParamBuffers[i].Buffer)^ := LobLength;
  666. Move(LobBuffer[1], (ParamBuffers[i].Buffer+sizeof(integer))^, LobLength);
  667. end;
  668. else
  669. DatabaseErrorFmt(SUnsupportedParameter,[DataType],self);
  670. end;
  671. end;
  672. end;
  673. procedure TOracleConnection.UnPrepareStatement(cursor: TSQLCursor);
  674. begin
  675. if OCIStmtRelease(TOracleCursor(cursor).FOciStmt,FOciError,nil,0,OCI_DEFAULT)<> OCI_SUCCESS then
  676. HandleError();
  677. cursor.FPrepared:=False;
  678. end;
  679. procedure TOracleConnection.InternalStartDBTransaction(trans : TOracleTrans);
  680. begin
  681. if OCITransStart(trans.FOciSvcCtx,FOciError,DefaultTimeOut,trans.FOciFlags) <> OCI_SUCCESS then
  682. HandleError();
  683. end;
  684. function TOracleConnection.GetTransactionHandle(trans: TSQLHandle): pointer;
  685. begin
  686. Result := trans;
  687. end;
  688. function TOracleConnection.StartDBTransaction(trans: TSQLHandle; AParams: string): boolean;
  689. var
  690. flags : ub4;
  691. i : Integer;
  692. s : string;
  693. locTrans : TOracleTrans;
  694. begin
  695. flags := OCI_TRANS_READWRITE;
  696. if AParams <> '' then begin
  697. i := 1;
  698. s := ExtractSubStr(AParams,i,StdWordDelims);
  699. while ( s <> '' ) do begin
  700. if ( s = 'readonly' ) then
  701. flags := OCI_TRANS_READONLY
  702. else if ( s = 'serializable' ) then
  703. flags := OCI_TRANS_SERIALIZABLE
  704. else if ( s = 'readwrite' ) then
  705. flags := OCI_TRANS_READWRITE;
  706. s := ExtractSubStr(AParams,i,StdWordDelims);
  707. end;
  708. end;
  709. locTrans := TOracleTrans(trans);
  710. locTrans.FOciFlags := flags or OCI_TRANS_NEW;
  711. InternalStartDBTransaction(locTrans);
  712. Result := True;
  713. end;
  714. function TOracleConnection.Commit(trans: TSQLHandle): boolean;
  715. begin
  716. if OCITransCommit(TOracleTrans(trans).FOciSvcCtx,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
  717. HandleError();
  718. Result := True;
  719. end;
  720. function TOracleConnection.Rollback(trans: TSQLHandle): boolean;
  721. begin
  722. if OCITransRollback(TOracleTrans(trans).FOciSvcCtx,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
  723. HandleError();
  724. Result := True;
  725. end;
  726. procedure TOracleConnection.CommitRetaining(trans: TSQLHandle);
  727. begin
  728. Commit(trans);
  729. InternalStartDBTransaction(TOracleTrans(trans));
  730. end;
  731. procedure TOracleConnection.RollbackRetaining(trans: TSQLHandle);
  732. begin
  733. Rollback(trans);
  734. InternalStartDBTransaction(TOracleTrans(trans));
  735. end;
  736. procedure TOracleConnection.Execute(cursor: TSQLCursor; ATransaction: TSQLTransaction; AParams: TParams);
  737. procedure FreeParameters;
  738. var i: integer;
  739. begin
  740. with cursor as TOracleCursor do
  741. for i:=0 to high(ParamBuffers) do
  742. if ParamBuffers[i].DescType = OCI_DTYPE_LOB then
  743. if OciLobFreeTemporary(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, ParamBuffers[i].Buffer) = OCI_ERROR then
  744. HandleError;
  745. end;
  746. begin
  747. if Assigned(AParams) and (AParams.Count > 0) then SetParameters(cursor, ATransaction, AParams);
  748. if cursor.FStatementType = stSelect then
  749. begin
  750. if OCIStmtExecute(TOracleTrans(ATransaction.Handle).FOciSvcCtx,(cursor as TOracleCursor).FOciStmt,FOciError,0,0,nil,nil,OCI_DEFAULT) = OCI_ERROR then
  751. HandleError;
  752. end
  753. else
  754. begin
  755. if OCIStmtExecute(TOracleTrans(ATransaction.Handle).FOciSvcCtx,(cursor as TOracleCursor).FOciStmt,FOciError,1,0,nil,nil,OCI_DEFAULT) = OCI_ERROR then
  756. HandleError;
  757. if Assigned(AParams) and (AParams.Count > 0) then GetParameters(cursor, ATransaction, AParams);
  758. end;
  759. FreeParameters;
  760. end;
  761. function TOracleConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;
  762. var rowcount: ub4;
  763. begin
  764. if Assigned(cursor) and (OCIAttrGet((cursor as TOracleCursor).FOciStmt, OCI_HTYPE_STMT, @rowcount, nil, OCI_ATTR_ROW_COUNT, FOciError) = OCI_SUCCESS) then
  765. Result:=rowcount
  766. else
  767. Result:=inherited RowsAffected(cursor);
  768. end;
  769. procedure TOracleConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);
  770. var Param : POCIParam;
  771. counter : ub4;
  772. FieldType : TFieldType;
  773. FieldName : string;
  774. FieldSize : cardinal;
  775. OFieldType : ub2;
  776. OFieldName : Pchar;
  777. OFieldSize : ub4;
  778. OFNameLength : ub4;
  779. NumCols : ub4;
  780. FOciDefine : POCIDefine;
  781. OPrecision : sb2;
  782. OScale : sb1;
  783. ODescType : ub4;
  784. OBuffer : pointer;
  785. begin
  786. Param := nil;
  787. with cursor as TOracleCursor do
  788. begin
  789. if OCIAttrGet(FOciStmt,OCI_HTYPE_STMT,@numcols,nil,OCI_ATTR_PARAM_COUNT,FOciError) = OCI_ERROR then
  790. HandleError;
  791. // Note: needs to be cleared then allocated in one go.
  792. Setlength(FieldBuffers,numcols);
  793. for counter := 1 to numcols do
  794. begin
  795. // Clear OFieldSize. Oracle 9i, 10g doc says *ub4 but some clients use *ub2 leaving
  796. // high 16 bit untouched resulting in huge values and ORA-01062
  797. // WARNING: this does not work on big endian systems !!!!
  798. // To be tested if BE systems have this *ub2<->*ub4 problem
  799. OFieldSize:=0;
  800. ODescType :=0;
  801. if OCIParamGet(FOciStmt,OCI_HTYPE_STMT,FOciError,Param,counter) = OCI_ERROR then
  802. HandleError;
  803. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldType,nil,OCI_ATTR_DATA_TYPE,FOciError) = OCI_ERROR then
  804. HandleError;
  805. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldSize,nil,OCI_ATTR_DATA_SIZE,FOciError) = OCI_ERROR then
  806. HandleError;
  807. FieldSize := 0;
  808. case OFieldType of
  809. OCI_TYPECODE_NUMBER : begin
  810. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oprecision,nil,OCI_ATTR_PRECISION,FOciError) = OCI_ERROR then
  811. HandleError;
  812. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oscale,nil,OCI_ATTR_SCALE,FOciError) = OCI_ERROR then
  813. HandleError;
  814. if (Oscale = 0) and (Oprecision < 10) then
  815. begin
  816. if Oprecision=0 then //Number(0,0) = number(32,4)
  817. begin
  818. FieldType := ftFMTBCD;
  819. FieldSize := 4;
  820. OFieldType := SQLT_VNU;
  821. OFieldSize:= 22;
  822. end
  823. else if Oprecision < 5 then
  824. begin
  825. FieldType := ftSmallint;
  826. OFieldType := SQLT_INT;
  827. OFieldSize := sizeof(smallint);
  828. end
  829. else // OPrecision=5..9, OScale=0
  830. begin
  831. FieldType := ftInteger;
  832. OFieldType := SQLT_INT;
  833. OFieldSize:= sizeof(integer);
  834. end;
  835. end
  836. else if (Oscale = -127) {and (OPrecision=0)} then
  837. begin
  838. FieldType := ftFloat;
  839. OFieldType := SQLT_FLT;
  840. OFieldSize:=sizeof(double);
  841. end
  842. else if (Oscale >=0) and (Oscale <=4) and (OPrecision<=12) then
  843. begin
  844. FieldType := ftBCD;
  845. FieldSize := oscale;
  846. OFieldType := SQLT_VNU;
  847. OFieldSize:= 22;
  848. end
  849. else if (OPrecision-Oscale<64) and (Oscale < 64) then // limited to 63 digits before or after decimal point
  850. begin
  851. FieldType := ftFMTBCD;
  852. FieldSize := oscale;
  853. OFieldType := SQLT_VNU;
  854. OFieldSize:= 22;
  855. end
  856. else // approximation with double, best we can do
  857. begin
  858. FieldType := ftFloat;
  859. OFieldType := SQLT_FLT;
  860. OFieldSize:=sizeof(double);
  861. end;
  862. end;
  863. SQLT_LNG : begin
  864. FieldType := ftString;
  865. FieldSize := MaxSmallint; // OFieldSize is zero for LONG data type
  866. OFieldSize:= MaxSmallint+1;
  867. OFieldType:=SQLT_STR;
  868. end;
  869. OCI_TYPECODE_CHAR,
  870. OCI_TYPECODE_VARCHAR,
  871. OCI_TYPECODE_VARCHAR2 : begin
  872. FieldType := ftString;
  873. FieldSize := OFieldSize;
  874. inc(OFieldSize);
  875. OFieldType:=SQLT_STR;
  876. end;
  877. OCI_TYPECODE_DATE : FieldType := ftDate;
  878. OCI_TYPECODE_TIMESTAMP,
  879. OCI_TYPECODE_TIMESTAMP_LTZ,
  880. OCI_TYPECODE_TIMESTAMP_TZ :
  881. begin
  882. FieldType := ftDateTime;
  883. OFieldType := SQLT_TIMESTAMP;
  884. ODescType := OCI_DTYPE_TIMESTAMP;
  885. end;
  886. OCI_TYPECODE_BFLOAT,
  887. OCI_TYPECODE_BDOUBLE : begin
  888. FieldType := ftFloat;
  889. OFieldType := SQLT_BDOUBLE;
  890. OFieldSize := sizeof(double);
  891. end;
  892. SQLT_BLOB : begin
  893. FieldType := ftBlob;
  894. ODescType := OCI_DTYPE_LOB;
  895. end;
  896. SQLT_CLOB : begin
  897. FieldType := ftMemo;
  898. ODescType := OCI_DTYPE_LOB;
  899. end
  900. else
  901. FieldType := ftUnknown;
  902. end;
  903. FieldBuffers[counter-1].DescType := ODescType;
  904. if ODescType <> 0 then
  905. begin
  906. OBuffer := @FieldBuffers[counter-1].buffer;
  907. OCIDescriptorAlloc(FOciEnvironment, OBuffer, ODescType, 0, nil);
  908. OFieldSize := sizeof(pointer);
  909. end
  910. else
  911. begin
  912. OBuffer := getmem(OFieldSize);
  913. FieldBuffers[counter-1].buffer := OBuffer;
  914. end;
  915. if FieldType <> ftUnknown then
  916. begin
  917. FOciDefine := nil;
  918. if OciDefineByPos(FOciStmt,FOciDefine,FOciError,counter,OBuffer,OFieldSize,OFieldType,@FieldBuffers[counter-1].ind,nil,nil,OCI_DEFAULT) = OCI_ERROR then
  919. HandleError;
  920. end;
  921. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldName,@OFNameLength,OCI_ATTR_NAME,FOciError) <> OCI_SUCCESS then
  922. HandleError;
  923. setlength(Fieldname,OFNameLength);
  924. move(OFieldName^,Fieldname[1],OFNameLength);
  925. FieldDefs.Add(FieldDefs.MakeNameUnique(FieldName), FieldType, FieldSize, False, counter);
  926. end;
  927. end;
  928. end;
  929. function TOracleConnection.Fetch(cursor: TSQLCursor): boolean;
  930. begin
  931. case OCIStmtFetch2((cursor as TOracleCursor).FOciStmt,FOciError,1,OCI_FETCH_NEXT,1,OCI_DEFAULT) of
  932. OCI_ERROR : begin
  933. Result := False;
  934. HandleError;
  935. end;
  936. OCI_NO_DATA : Result := False;
  937. OCI_SUCCESS : Result := True;
  938. OCI_SUCCESS_WITH_INFO : Begin
  939. Result := True;
  940. HandleError;
  941. end;
  942. end; {case}
  943. end;
  944. function TOracleConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer; out CreateBlob : boolean): boolean;
  945. var
  946. b : pbyte;
  947. size,i : byte;
  948. exp : shortint;
  949. cur : Currency;
  950. odt : TODateTime;
  951. begin
  952. CreateBlob := False;
  953. with cursor as TOracleCursor do if fieldbuffers[FieldDef.FieldNo-1].ind = -1 then
  954. Result := False
  955. else
  956. begin
  957. Result := True;
  958. case FieldDef.DataType of
  959. ftString :
  960. move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,FieldDef.Size);
  961. ftBCD :
  962. begin
  963. b := fieldbuffers[FieldDef.FieldNo-1].buffer;
  964. size := b[0];
  965. cur := 0;
  966. if (b[1] and $80)=$80 then // the number is positive
  967. begin
  968. exp := (b[1] and $7f)-65;
  969. for i := 2 to size do
  970. cur := cur + (b[i]-1) * intpower(100,-(i-2)+exp);
  971. end
  972. else
  973. begin
  974. exp := (not(b[1]) and $7f)-65;
  975. for i := 2 to size-1 do
  976. cur := cur + (101-b[i]) * intpower(100,-(i-2)+exp);
  977. cur := -cur;
  978. end;
  979. move(cur,buffer^,SizeOf(Currency));
  980. end;
  981. ftFmtBCD :
  982. pBCD(buffer)^:= Nvu2FmtBCD(fieldbuffers[FieldDef.FieldNo-1].buffer);
  983. ftFloat :
  984. move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(double));
  985. ftSmallInt :
  986. move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(smallint));
  987. ftInteger :
  988. move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(integer));
  989. ftDate :
  990. begin
  991. b := fieldbuffers[FieldDef.FieldNo-1].buffer;
  992. 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));
  993. end;
  994. ftDateTime :
  995. begin
  996. OCIDateTimeGetDate(FOciUserSession, FOciError, FieldBuffers[FieldDef.FieldNo-1].buffer, @odt.year, @odt.month, @odt.day);
  997. OCIDateTimeGetTime(FOciUserSession, FOciError, FieldBuffers[FieldDef.FieldNo-1].buffer, @odt.hour, @odt.min, @odt.sec, @odt.fsec);
  998. PDateTime(buffer)^ := ComposeDateTime(EncodeDate(odt.year,odt.month,odt.day), EncodeTime(odt.hour,odt.min,odt.sec,odt.fsec div 1000000));
  999. end;
  1000. ftBlob,
  1001. ftMemo :
  1002. CreateBlob := True;
  1003. else
  1004. Result := False;
  1005. end;
  1006. end;
  1007. end;
  1008. procedure TOracleConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
  1009. var LobLocator: pointer;
  1010. LobCharSetForm: ub1;
  1011. LobLength: ub4;
  1012. begin
  1013. LobLocator := (cursor as TOracleCursor).FieldBuffers[FieldDef.FieldNo-1].Buffer;
  1014. //if OCILobLocatorIsInit(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, LobLocator, @is_init) = OCI_ERROR then
  1015. // HandleError;
  1016. // For character LOBs, it is the number of characters, for binary LOBs and BFILEs it is the number of bytes
  1017. if OciLobGetLength(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, LobLocator, @LobLength) = OCI_ERROR then
  1018. HandleError;
  1019. if OCILobCharSetForm(FOciEnvironment, FOciError, LobLocator, @LobCharSetForm) = OCI_ERROR then
  1020. HandleError;
  1021. ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer, LobLength);
  1022. ABlobBuf^.BlobBuffer^.Size := LobLength;
  1023. if (LobLength > 0) and (OciLobRead(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, LobLocator, @LobLength, 1, ABlobBuf^.BlobBuffer^.Buffer, LobLength, nil, nil, 0, LobCharSetForm) = OCI_ERROR) then
  1024. HandleError;
  1025. end;
  1026. procedure TOracleConnection.FreeFldBuffers(cursor: TSQLCursor);
  1027. begin
  1028. // inherited FreeFldBuffers(cursor);
  1029. end;
  1030. procedure TOracleConnection.UpdateIndexDefs(IndexDefs: TIndexDefs;
  1031. TableName: string);
  1032. var qry : TSQLQuery;
  1033. begin
  1034. if not assigned(Transaction) then
  1035. DatabaseError(SErrConnTransactionnSet);
  1036. // Get table name into canonical format
  1037. if (length(TableName)>2) and (TableName[1]=ObjectQuote) and (TableName[length(TableName)]=ObjectQuote) then
  1038. TableName := AnsiDequotedStr(TableName, ObjectQuote)
  1039. else
  1040. 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.
  1041. qry := tsqlquery.Create(nil);
  1042. qry.transaction := Transaction;
  1043. qry.database := Self;
  1044. with qry do
  1045. begin
  1046. ReadOnly := True;
  1047. sql.clear;
  1048. sql.add('SELECT '+
  1049. 'i.INDEX_NAME, '+
  1050. 'c.COLUMN_NAME, '+
  1051. 'p.CONSTRAINT_TYPE '+
  1052. 'FROM ALL_INDEXES i, ALL_IND_COLUMNS c,ALL_CONSTRAINTS p '+
  1053. 'WHERE '+
  1054. 'i.OWNER=c.INDEX_OWNER AND '+
  1055. 'i.INDEX_NAME=c.INDEX_NAME AND '+
  1056. 'p.INDEX_NAME(+)=i.INDEX_NAME AND '+
  1057. 'c.TABLE_NAME = ''' + TableName + ''' '+
  1058. 'ORDER by i.INDEX_NAME,c.COLUMN_POSITION');
  1059. open;
  1060. end;
  1061. while not qry.eof do with IndexDefs.AddIndexDef do
  1062. begin
  1063. Name := trim(qry.fields[0].asstring);
  1064. Fields := trim(qry.Fields[1].asstring);
  1065. If UpperCase(qry.fields[2].asstring)='P' then options := options + [ixPrimary];
  1066. If UpperCase(qry.fields[2].asstring)='U' then options := options + [ixUnique];
  1067. qry.next;
  1068. while (name = qry.fields[0].asstring) and (not qry.eof) do
  1069. begin
  1070. Fields := Fields + ';' + trim(qry.Fields[2].asstring);
  1071. qry.next;
  1072. end;
  1073. end;
  1074. qry.close;
  1075. qry.free;
  1076. end;
  1077. function TOracleConnection.GetSchemaInfoSQL(SchemaType: TSchemaType;
  1078. SchemaObjectName, SchemaPattern: string): string;
  1079. var
  1080. s : string;
  1081. begin
  1082. case SchemaType of
  1083. stTables : s := 'SELECT '+
  1084. '''' + DatabaseName + ''' as catalog_name, '+
  1085. 'sys_context( ''userenv'', ''current_schema'' ) as schema_name, '+
  1086. 'TABLE_NAME,'+
  1087. 'TABLE_TYPE '+
  1088. 'FROM USER_CATALOG ' +
  1089. 'WHERE '+
  1090. 'TABLE_TYPE<>''SEQUENCE'' '+
  1091. 'ORDER BY TABLE_NAME';
  1092. stSysTables : s := 'SELECT '+
  1093. '''' + DatabaseName + ''' as catalog_name, '+
  1094. 'OWNER as schema_name, '+
  1095. 'TABLE_NAME,'+
  1096. 'TABLE_TYPE '+
  1097. 'FROM ALL_CATALOG ' +
  1098. 'WHERE '+
  1099. 'TABLE_TYPE<>''SEQUENCE'' '+
  1100. 'ORDER BY TABLE_NAME';
  1101. stColumns : s := 'SELECT '+
  1102. 'OWNER as schema_name, '+
  1103. 'COLUMN_NAME, '+
  1104. 'DATA_TYPE as column_datatype, '+
  1105. 'CHARACTER_SET_NAME, '+
  1106. 'NULLABLE as column_nullable, '+
  1107. 'DATA_LENGTH as column_length, '+
  1108. 'DATA_PRECISION as column_precision, '+
  1109. 'DATA_SCALE as column_scale, '+
  1110. 'DATA_DEFAULT as column_default '+
  1111. 'FROM ALL_TAB_COLUMNS '+
  1112. 'WHERE Upper(TABLE_NAME) = '''+UpperCase(SchemaObjectName)+''' '+
  1113. 'ORDER BY COLUMN_NAME';
  1114. // Columns of tables, views and clusters accessible to user; hidden columns are filtered out.
  1115. stProcedures : s := 'SELECT '+
  1116. 'case when PROCEDURE_NAME is null then OBJECT_NAME ELSE OBJECT_NAME || ''.'' || PROCEDURE_NAME end AS procedure_name '+
  1117. 'FROM USER_PROCEDURES ';
  1118. else
  1119. DatabaseError(SMetadataUnavailable)
  1120. end; {case}
  1121. result := s;
  1122. end;
  1123. constructor TOracleConnection.Create(AOwner: TComponent);
  1124. begin
  1125. inherited Create(AOwner);
  1126. FConnOptions := FConnOptions + [sqEscapeRepeat];
  1127. FOciEnvironment := nil;
  1128. FOciError := nil;
  1129. FOciServer := nil;
  1130. FOciUserSession := nil;
  1131. FUserMem := nil;
  1132. end;
  1133. { TOracleConnectionDef }
  1134. class function TOracleConnectionDef.TypeName: String;
  1135. begin
  1136. Result:='Oracle';
  1137. end;
  1138. class function TOracleConnectionDef.ConnectionClass: TSQLConnectionClass;
  1139. begin
  1140. Result:=TOracleConnection;
  1141. end;
  1142. class function TOracleConnectionDef.Description: String;
  1143. begin
  1144. Result:='Connect to an Oracle database directly via the client library';
  1145. end;
  1146. class function TOracleConnectionDef.DefaultLibraryName: String;
  1147. begin
  1148. {$IfDef LinkDynamically}
  1149. Result:=ocilib;
  1150. {$else}
  1151. Result:='';
  1152. {$endif}
  1153. end;
  1154. class function TOracleConnectionDef.LoadFunction: TLibraryLoadFunction;
  1155. begin
  1156. {$IfDef LinkDynamically}
  1157. Result:=@InitialiseOCI;
  1158. {$else}
  1159. Result:=Nil;
  1160. {$endif}
  1161. end;
  1162. class function TOracleConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
  1163. begin
  1164. {$IfDef LinkDynamically}
  1165. Result:=@ReleaseOCI;
  1166. {$else}
  1167. Result:=Nil;
  1168. {$endif}
  1169. end;
  1170. class function TOracleConnectionDef.LoadedLibraryName: string;
  1171. begin
  1172. {$IfDef LinkDynamically}
  1173. Result:=OCILoadedLibrary;
  1174. {$else}
  1175. Result:='';
  1176. {$endif}
  1177. end;
  1178. { TOracleTrans }
  1179. destructor TOracleTrans.Destroy();
  1180. begin
  1181. OCIHandleFree(FOciTrans,OCI_HTYPE_TRANS);
  1182. OCIHandleFree(FOciSvcCtx,OCI_HTYPE_SVCCTX);
  1183. inherited Destroy();
  1184. end;
  1185. initialization
  1186. RegisterConnection(TOracleConnectionDef);
  1187. finalization
  1188. UnRegisterConnection(TOracleConnectionDef);
  1189. end.