oracleconnection.pp 47 KB

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