oracleconnection.pp 46 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320
  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. x_flags : ub4;
  691. i : Integer;
  692. s : string;
  693. locTrans : TOracleTrans;
  694. begin
  695. locTrans := TOracleTrans(trans);
  696. if ( Length(AParams) = 0 ) then begin
  697. x_flags := OCI_TRANS_NEW or OCI_TRANS_READWRITE;
  698. end else begin
  699. x_flags := OCI_DEFAULT;
  700. i := 1;
  701. s := ExtractSubStr(AParams,i,StdWordDelims);
  702. while ( s <> '' ) do begin
  703. if ( s = 'readonly' ) then
  704. x_flags := x_flags and OCI_TRANS_READONLY
  705. else if ( s = 'serializable' ) then
  706. x_flags := x_flags and OCI_TRANS_SERIALIZABLE
  707. else if ( s = 'readwrite' ) then
  708. x_flags := x_flags and OCI_TRANS_READWRITE;
  709. s := ExtractSubStr(AParams,i,StdWordDelims);
  710. end;
  711. x_flags := x_flags and OCI_TRANS_NEW;
  712. end;
  713. locTrans.FOciFlags := x_flags;
  714. InternalStartDBTransaction(locTrans);
  715. Result := True;
  716. end;
  717. function TOracleConnection.Commit(trans: TSQLHandle): boolean;
  718. begin
  719. if OCITransCommit(TOracleTrans(trans).FOciSvcCtx,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
  720. HandleError();
  721. Result := True;
  722. end;
  723. function TOracleConnection.Rollback(trans: TSQLHandle): boolean;
  724. begin
  725. if OCITransRollback(TOracleTrans(trans).FOciSvcCtx,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
  726. HandleError();
  727. Result := True;
  728. end;
  729. procedure TOracleConnection.CommitRetaining(trans: TSQLHandle);
  730. begin
  731. Commit(trans);
  732. InternalStartDBTransaction(TOracleTrans(trans));
  733. end;
  734. procedure TOracleConnection.RollbackRetaining(trans: TSQLHandle);
  735. begin
  736. Rollback(trans);
  737. InternalStartDBTransaction(TOracleTrans(trans));
  738. end;
  739. procedure TOracleConnection.Execute(cursor: TSQLCursor; ATransaction: TSQLTransaction; AParams: TParams);
  740. procedure FreeParameters;
  741. var i: integer;
  742. begin
  743. with cursor as TOracleCursor do
  744. for i:=0 to high(ParamBuffers) do
  745. if ParamBuffers[i].DescType = OCI_DTYPE_LOB then
  746. if OciLobFreeTemporary(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, ParamBuffers[i].Buffer) = OCI_ERROR then
  747. HandleError;
  748. end;
  749. begin
  750. if Assigned(AParams) and (AParams.Count > 0) then SetParameters(cursor, ATransaction, AParams);
  751. if cursor.FStatementType = stSelect then
  752. begin
  753. if OCIStmtExecute(TOracleTrans(ATransaction.Handle).FOciSvcCtx,(cursor as TOracleCursor).FOciStmt,FOciError,0,0,nil,nil,OCI_DEFAULT) = OCI_ERROR then
  754. HandleError;
  755. end
  756. else
  757. begin
  758. if OCIStmtExecute(TOracleTrans(ATransaction.Handle).FOciSvcCtx,(cursor as TOracleCursor).FOciStmt,FOciError,1,0,nil,nil,OCI_DEFAULT) = OCI_ERROR then
  759. HandleError;
  760. if Assigned(AParams) and (AParams.Count > 0) then GetParameters(cursor, ATransaction, AParams);
  761. end;
  762. FreeParameters;
  763. end;
  764. function TOracleConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;
  765. var rowcount: ub4;
  766. begin
  767. if Assigned(cursor) and (OCIAttrGet((cursor as TOracleCursor).FOciStmt, OCI_HTYPE_STMT, @rowcount, nil, OCI_ATTR_ROW_COUNT, FOciError) = OCI_SUCCESS) then
  768. Result:=rowcount
  769. else
  770. Result:=inherited RowsAffected(cursor);
  771. end;
  772. procedure TOracleConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);
  773. var Param : POCIParam;
  774. counter : ub4;
  775. FieldType : TFieldType;
  776. FieldName : string;
  777. FieldSize : cardinal;
  778. OFieldType : ub2;
  779. OFieldName : Pchar;
  780. OFieldSize : ub4;
  781. OFNameLength : ub4;
  782. NumCols : ub4;
  783. FOciDefine : POCIDefine;
  784. OPrecision : sb2;
  785. OScale : sb1;
  786. ODescType : ub4;
  787. OBuffer : pointer;
  788. begin
  789. Param := nil;
  790. with cursor as TOracleCursor do
  791. begin
  792. if OCIAttrGet(FOciStmt,OCI_HTYPE_STMT,@numcols,nil,OCI_ATTR_PARAM_COUNT,FOciError) = OCI_ERROR then
  793. HandleError;
  794. // Note: needs to be cleared then allocated in one go.
  795. Setlength(FieldBuffers,numcols);
  796. for counter := 1 to numcols do
  797. begin
  798. // Clear OFieldSize. Oracle 9i, 10g doc says *ub4 but some clients use *ub2 leaving
  799. // high 16 bit untouched resulting in huge values and ORA-01062
  800. // WARNING: this does not work on big endian systems !!!!
  801. // To be tested if BE systems have this *ub2<->*ub4 problem
  802. OFieldSize:=0;
  803. ODescType :=0;
  804. if OCIParamGet(FOciStmt,OCI_HTYPE_STMT,FOciError,Param,counter) = OCI_ERROR then
  805. HandleError;
  806. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldType,nil,OCI_ATTR_DATA_TYPE,FOciError) = OCI_ERROR then
  807. HandleError;
  808. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldSize,nil,OCI_ATTR_DATA_SIZE,FOciError) = OCI_ERROR then
  809. HandleError;
  810. FieldSize := 0;
  811. case OFieldType of
  812. OCI_TYPECODE_NUMBER : begin
  813. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oprecision,nil,OCI_ATTR_PRECISION,FOciError) = OCI_ERROR then
  814. HandleError;
  815. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oscale,nil,OCI_ATTR_SCALE,FOciError) = OCI_ERROR then
  816. HandleError;
  817. if (Oscale = 0) and (Oprecision < 10) then
  818. begin
  819. if Oprecision=0 then //Number(0,0) = number(32,4)
  820. begin
  821. FieldType := ftFMTBCD;
  822. FieldSize := 4;
  823. OFieldType := SQLT_VNU;
  824. OFieldSize:= 22;
  825. end
  826. else if Oprecision < 5 then
  827. begin
  828. FieldType := ftSmallint;
  829. OFieldType := SQLT_INT;
  830. OFieldSize := sizeof(smallint);
  831. end
  832. else // OPrecision=5..9, OScale=0
  833. begin
  834. FieldType := ftInteger;
  835. OFieldType := SQLT_INT;
  836. OFieldSize:= sizeof(integer);
  837. end;
  838. end
  839. else if (Oscale = -127) {and (OPrecision=0)} then
  840. begin
  841. FieldType := ftFloat;
  842. OFieldType := SQLT_FLT;
  843. OFieldSize:=sizeof(double);
  844. end
  845. else if (Oscale >=0) and (Oscale <=4) and (OPrecision<=12) then
  846. begin
  847. FieldType := ftBCD;
  848. FieldSize := oscale;
  849. OFieldType := SQLT_VNU;
  850. OFieldSize:= 22;
  851. end
  852. else if (OPrecision-Oscale<64) and (Oscale < 64) then // limited to 63 digits before or after decimal point
  853. begin
  854. FieldType := ftFMTBCD;
  855. FieldSize := oscale;
  856. OFieldType := SQLT_VNU;
  857. OFieldSize:= 22;
  858. end
  859. else // approximation with double, best we can do
  860. begin
  861. FieldType := ftFloat;
  862. OFieldType := SQLT_FLT;
  863. OFieldSize:=sizeof(double);
  864. end;
  865. end;
  866. SQLT_LNG : begin
  867. FieldType := ftString;
  868. FieldSize := MaxSmallint; // OFieldSize is zero for LONG data type
  869. OFieldSize:= MaxSmallint+1;
  870. OFieldType:=SQLT_STR;
  871. end;
  872. OCI_TYPECODE_CHAR,
  873. OCI_TYPECODE_VARCHAR,
  874. OCI_TYPECODE_VARCHAR2 : begin
  875. FieldType := ftString;
  876. FieldSize := OFieldSize;
  877. inc(OFieldSize);
  878. OFieldType:=SQLT_STR;
  879. end;
  880. OCI_TYPECODE_DATE : FieldType := ftDate;
  881. OCI_TYPECODE_TIMESTAMP,
  882. OCI_TYPECODE_TIMESTAMP_LTZ,
  883. OCI_TYPECODE_TIMESTAMP_TZ :
  884. begin
  885. FieldType := ftDateTime;
  886. OFieldType := SQLT_TIMESTAMP;
  887. ODescType := OCI_DTYPE_TIMESTAMP;
  888. end;
  889. OCI_TYPECODE_BFLOAT,
  890. OCI_TYPECODE_BDOUBLE : begin
  891. FieldType := ftFloat;
  892. OFieldType := SQLT_BDOUBLE;
  893. OFieldSize := sizeof(double);
  894. end;
  895. SQLT_BLOB : begin
  896. FieldType := ftBlob;
  897. ODescType := OCI_DTYPE_LOB;
  898. end;
  899. SQLT_CLOB : begin
  900. FieldType := ftMemo;
  901. ODescType := OCI_DTYPE_LOB;
  902. end
  903. else
  904. FieldType := ftUnknown;
  905. end;
  906. FieldBuffers[counter-1].DescType := ODescType;
  907. if ODescType <> 0 then
  908. begin
  909. OBuffer := @FieldBuffers[counter-1].buffer;
  910. OCIDescriptorAlloc(FOciEnvironment, OBuffer, ODescType, 0, nil);
  911. OFieldSize := sizeof(pointer);
  912. end
  913. else
  914. begin
  915. OBuffer := getmem(OFieldSize);
  916. FieldBuffers[counter-1].buffer := OBuffer;
  917. end;
  918. if FieldType <> ftUnknown then
  919. begin
  920. FOciDefine := nil;
  921. if OciDefineByPos(FOciStmt,FOciDefine,FOciError,counter,OBuffer,OFieldSize,OFieldType,@FieldBuffers[counter-1].ind,nil,nil,OCI_DEFAULT) = OCI_ERROR then
  922. HandleError;
  923. end;
  924. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldName,@OFNameLength,OCI_ATTR_NAME,FOciError) <> OCI_SUCCESS then
  925. HandleError;
  926. setlength(Fieldname,OFNameLength);
  927. move(OFieldName^,Fieldname[1],OFNameLength);
  928. FieldDefs.Add(FieldDefs.MakeNameUnique(FieldName), FieldType, FieldSize, False, counter);
  929. end;
  930. end;
  931. end;
  932. function TOracleConnection.Fetch(cursor: TSQLCursor): boolean;
  933. begin
  934. case OCIStmtFetch2((cursor as TOracleCursor).FOciStmt,FOciError,1,OCI_FETCH_NEXT,1,OCI_DEFAULT) of
  935. OCI_ERROR : begin
  936. Result := False;
  937. HandleError;
  938. end;
  939. OCI_NO_DATA : Result := False;
  940. OCI_SUCCESS : Result := True;
  941. OCI_SUCCESS_WITH_INFO : Begin
  942. Result := True;
  943. HandleError;
  944. end;
  945. end; {case}
  946. end;
  947. function TOracleConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer; out CreateBlob : boolean): boolean;
  948. var
  949. b : pbyte;
  950. size,i : byte;
  951. exp : shortint;
  952. cur : Currency;
  953. odt : TODateTime;
  954. begin
  955. CreateBlob := False;
  956. with cursor as TOracleCursor do if fieldbuffers[FieldDef.FieldNo-1].ind = -1 then
  957. Result := False
  958. else
  959. begin
  960. Result := True;
  961. case FieldDef.DataType of
  962. ftString :
  963. move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,FieldDef.Size);
  964. ftBCD :
  965. begin
  966. b := fieldbuffers[FieldDef.FieldNo-1].buffer;
  967. size := b[0];
  968. cur := 0;
  969. if (b[1] and $80)=$80 then // the number is positive
  970. begin
  971. exp := (b[1] and $7f)-65;
  972. for i := 2 to size do
  973. cur := cur + (b[i]-1) * intpower(100,-(i-2)+exp);
  974. end
  975. else
  976. begin
  977. exp := (not(b[1]) and $7f)-65;
  978. for i := 2 to size-1 do
  979. cur := cur + (101-b[i]) * intpower(100,-(i-2)+exp);
  980. cur := -cur;
  981. end;
  982. move(cur,buffer^,SizeOf(Currency));
  983. end;
  984. ftFmtBCD :
  985. pBCD(buffer)^:= Nvu2FmtBCD(fieldbuffers[FieldDef.FieldNo-1].buffer);
  986. ftFloat :
  987. move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(double));
  988. ftSmallInt :
  989. move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(smallint));
  990. ftInteger :
  991. move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(integer));
  992. ftDate :
  993. begin
  994. b := fieldbuffers[FieldDef.FieldNo-1].buffer;
  995. 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));
  996. end;
  997. ftDateTime :
  998. begin
  999. OCIDateTimeGetDate(FOciUserSession, FOciError, FieldBuffers[FieldDef.FieldNo-1].buffer, @odt.year, @odt.month, @odt.day);
  1000. OCIDateTimeGetTime(FOciUserSession, FOciError, FieldBuffers[FieldDef.FieldNo-1].buffer, @odt.hour, @odt.min, @odt.sec, @odt.fsec);
  1001. PDateTime(buffer)^ := ComposeDateTime(EncodeDate(odt.year,odt.month,odt.day), EncodeTime(odt.hour,odt.min,odt.sec,odt.fsec div 1000000));
  1002. end;
  1003. ftBlob,
  1004. ftMemo :
  1005. CreateBlob := True;
  1006. else
  1007. Result := False;
  1008. end;
  1009. end;
  1010. end;
  1011. procedure TOracleConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
  1012. var LobLocator: pointer;
  1013. LobCharSetForm: ub1;
  1014. LobLength: ub4;
  1015. begin
  1016. LobLocator := (cursor as TOracleCursor).FieldBuffers[FieldDef.FieldNo-1].Buffer;
  1017. //if OCILobLocatorIsInit(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, LobLocator, @is_init) = OCI_ERROR then
  1018. // HandleError;
  1019. // For character LOBs, it is the number of characters, for binary LOBs and BFILEs it is the number of bytes
  1020. if OciLobGetLength(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, LobLocator, @LobLength) = OCI_ERROR then
  1021. HandleError;
  1022. if OCILobCharSetForm(FOciEnvironment, FOciError, LobLocator, @LobCharSetForm) = OCI_ERROR then
  1023. HandleError;
  1024. ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer, LobLength);
  1025. ABlobBuf^.BlobBuffer^.Size := LobLength;
  1026. if (LobLength > 0) and (OciLobRead(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, LobLocator, @LobLength, 1, ABlobBuf^.BlobBuffer^.Buffer, LobLength, nil, nil, 0, LobCharSetForm) = OCI_ERROR) then
  1027. HandleError;
  1028. end;
  1029. procedure TOracleConnection.FreeFldBuffers(cursor: TSQLCursor);
  1030. begin
  1031. // inherited FreeFldBuffers(cursor);
  1032. end;
  1033. procedure TOracleConnection.UpdateIndexDefs(IndexDefs: TIndexDefs;
  1034. TableName: string);
  1035. var qry : TSQLQuery;
  1036. begin
  1037. if not assigned(Transaction) then
  1038. DatabaseError(SErrConnTransactionnSet);
  1039. // Get table name into canonical format
  1040. if (length(TableName)>2) and (TableName[1]=ObjectQuote) and (TableName[length(TableName)]=ObjectQuote) then
  1041. TableName := AnsiDequotedStr(TableName, ObjectQuote)
  1042. else
  1043. 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.
  1044. qry := tsqlquery.Create(nil);
  1045. qry.transaction := Transaction;
  1046. qry.database := Self;
  1047. with qry do
  1048. begin
  1049. ReadOnly := True;
  1050. sql.clear;
  1051. sql.add('SELECT '+
  1052. 'i.INDEX_NAME, '+
  1053. 'c.COLUMN_NAME, '+
  1054. 'p.CONSTRAINT_TYPE '+
  1055. 'FROM ALL_INDEXES i, ALL_IND_COLUMNS c,ALL_CONSTRAINTS p '+
  1056. 'WHERE '+
  1057. 'i.OWNER=c.INDEX_OWNER AND '+
  1058. 'i.INDEX_NAME=c.INDEX_NAME AND '+
  1059. 'p.INDEX_NAME(+)=i.INDEX_NAME AND '+
  1060. 'c.TABLE_NAME = ''' + TableName + ''' '+
  1061. 'ORDER by i.INDEX_NAME,c.COLUMN_POSITION');
  1062. open;
  1063. end;
  1064. while not qry.eof do with IndexDefs.AddIndexDef do
  1065. begin
  1066. Name := trim(qry.fields[0].asstring);
  1067. Fields := trim(qry.Fields[1].asstring);
  1068. If UpperCase(qry.fields[2].asstring)='P' then options := options + [ixPrimary];
  1069. If UpperCase(qry.fields[2].asstring)='U' then options := options + [ixUnique];
  1070. qry.next;
  1071. while (name = qry.fields[0].asstring) and (not qry.eof) do
  1072. begin
  1073. Fields := Fields + ';' + trim(qry.Fields[2].asstring);
  1074. qry.next;
  1075. end;
  1076. end;
  1077. qry.close;
  1078. qry.free;
  1079. end;
  1080. function TOracleConnection.GetSchemaInfoSQL(SchemaType: TSchemaType;
  1081. SchemaObjectName, SchemaPattern: string): string;
  1082. var
  1083. s : string;
  1084. begin
  1085. case SchemaType of
  1086. stTables : s := 'SELECT '+
  1087. '''' + DatabaseName + ''' as catalog_name, '+
  1088. 'sys_context( ''userenv'', ''current_schema'' ) as schema_name, '+
  1089. 'TABLE_NAME,'+
  1090. 'TABLE_TYPE '+
  1091. 'FROM USER_CATALOG ' +
  1092. 'WHERE '+
  1093. 'TABLE_TYPE<>''SEQUENCE'' '+
  1094. 'ORDER BY TABLE_NAME';
  1095. stSysTables : s := 'SELECT '+
  1096. '''' + DatabaseName + ''' as catalog_name, '+
  1097. 'OWNER as schema_name, '+
  1098. 'TABLE_NAME,'+
  1099. 'TABLE_TYPE '+
  1100. 'FROM ALL_CATALOG ' +
  1101. 'WHERE '+
  1102. 'TABLE_TYPE<>''SEQUENCE'' '+
  1103. 'ORDER BY TABLE_NAME';
  1104. stColumns : s := 'SELECT '+
  1105. 'OWNER as schema_name, '+
  1106. 'COLUMN_NAME, '+
  1107. 'DATA_TYPE as column_datatype, '+
  1108. 'CHARACTER_SET_NAME, '+
  1109. 'NULLABLE as column_nullable, '+
  1110. 'DATA_LENGTH as column_length, '+
  1111. 'DATA_PRECISION as column_precision, '+
  1112. 'DATA_SCALE as column_scale, '+
  1113. 'DATA_DEFAULT as column_default '+
  1114. 'FROM ALL_TAB_COLUMNS '+
  1115. 'WHERE Upper(TABLE_NAME) = '''+UpperCase(SchemaObjectName)+''' '+
  1116. 'ORDER BY COLUMN_NAME';
  1117. // Columns of tables, views and clusters accessible to user; hidden columns are filtered out.
  1118. stProcedures : s := 'SELECT '+
  1119. 'case when PROCEDURE_NAME is null then OBJECT_NAME ELSE OBJECT_NAME || ''.'' || PROCEDURE_NAME end AS procedure_name '+
  1120. 'FROM USER_PROCEDURES ';
  1121. else
  1122. DatabaseError(SMetadataUnavailable)
  1123. end; {case}
  1124. result := s;
  1125. end;
  1126. constructor TOracleConnection.Create(AOwner: TComponent);
  1127. begin
  1128. inherited Create(AOwner);
  1129. FConnOptions := FConnOptions + [sqEscapeRepeat];
  1130. FOciEnvironment := nil;
  1131. FOciError := nil;
  1132. FOciServer := nil;
  1133. FOciUserSession := nil;
  1134. FUserMem := nil;
  1135. end;
  1136. { TOracleConnectionDef }
  1137. class function TOracleConnectionDef.TypeName: String;
  1138. begin
  1139. Result:='Oracle';
  1140. end;
  1141. class function TOracleConnectionDef.ConnectionClass: TSQLConnectionClass;
  1142. begin
  1143. Result:=TOracleConnection;
  1144. end;
  1145. class function TOracleConnectionDef.Description: String;
  1146. begin
  1147. Result:='Connect to an Oracle database directly via the client library';
  1148. end;
  1149. class function TOracleConnectionDef.DefaultLibraryName: String;
  1150. begin
  1151. {$IfDef LinkDynamically}
  1152. Result:=ocilib;
  1153. {$else}
  1154. Result:='';
  1155. {$endif}
  1156. end;
  1157. class function TOracleConnectionDef.LoadFunction: TLibraryLoadFunction;
  1158. begin
  1159. {$IfDef LinkDynamically}
  1160. Result:=@InitialiseOCI;
  1161. {$else}
  1162. Result:=Nil;
  1163. {$endif}
  1164. end;
  1165. class function TOracleConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
  1166. begin
  1167. {$IfDef LinkDynamically}
  1168. Result:=@ReleaseOCI;
  1169. {$else}
  1170. Result:=Nil;
  1171. {$endif}
  1172. end;
  1173. class function TOracleConnectionDef.LoadedLibraryName: string;
  1174. begin
  1175. {$IfDef LinkDynamically}
  1176. Result:=OCILoadedLibrary;
  1177. {$else}
  1178. Result:='';
  1179. {$endif}
  1180. end;
  1181. { TOracleTrans }
  1182. destructor TOracleTrans.Destroy();
  1183. begin
  1184. OCIHandleFree(FOciTrans,OCI_HTYPE_TRANS);
  1185. OCIHandleFree(FOciSvcCtx,OCI_HTYPE_SVCCTX);
  1186. inherited Destroy();
  1187. end;
  1188. initialization
  1189. RegisterConnection(TOracleConnectionDef);
  1190. finalization
  1191. UnRegisterConnection(TOracleConnectionDef);
  1192. end.