oracleconnection.pp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672
  1. unit oracleconnection;
  2. {$mode objfpc}{$H+}
  3. {$Define LinkDynamically}
  4. interface
  5. uses
  6. Classes, SysUtils, sqldb,db,dbconst,
  7. {$IfDef LinkDynamically}
  8. ocidyn,
  9. {$ELSE}
  10. oci,
  11. {$ENDIF}
  12. oratypes;
  13. const
  14. DefaultTimeOut = 60;
  15. type
  16. EOraDatabaseError = class(EDatabaseError)
  17. public
  18. ORAErrorCode : Longint;
  19. end;
  20. TOracleTrans = Class(TSQLHandle)
  21. protected
  22. FOciSvcCtx : POCISvcCtx;
  23. FOciTrans : POCITrans;
  24. FOciFlags : ub4;
  25. public
  26. destructor Destroy(); override;
  27. end;
  28. TOraFieldBuf = record
  29. Buffer : pointer;
  30. Ind : sb2;
  31. end;
  32. TOracleCursor = Class(TSQLCursor)
  33. protected
  34. FOciStmt : POCIStmt;
  35. FieldBuffers : array of TOraFieldBuf;
  36. ParamBuffers : array of TOraFieldBuf;
  37. end;
  38. { TOracleConnection }
  39. TOracleConnection = class (TSQLConnection)
  40. private
  41. FOciEnvironment : POciEnv;
  42. FOciError : POCIError;
  43. FOciServer : POCIServer;
  44. FOciUserSession : POCISession;
  45. FUserMem : pointer;
  46. procedure HandleError;
  47. procedure SetParameters(cursor : TSQLCursor;AParams : TParams);
  48. protected
  49. // - Connect/disconnect
  50. procedure DoInternalConnect; override;
  51. procedure DoInternalDisconnect; override;
  52. // - Handle (de)allocation
  53. function AllocateCursorHandle:TSQLCursor; override;
  54. procedure DeAllocateCursorHandle(var cursor:TSQLCursor); override;
  55. function AllocateTransactionHandle:TSQLHandle; override;
  56. // - Statement handling
  57. procedure PrepareStatement(cursor:TSQLCursor; ATransaction:TSQLTransaction; buf:string; AParams:TParams); override;
  58. procedure UnPrepareStatement(cursor:TSQLCursor); override;
  59. // - Transaction handling
  60. procedure InternalStartDBTransaction(trans:TOracleTrans);
  61. function GetTransactionHandle(trans:TSQLHandle):pointer; override;
  62. function StartDBTransaction(trans:TSQLHandle; AParams:string):boolean; override;
  63. function Commit(trans:TSQLHandle):boolean; override;
  64. function Rollback(trans:TSQLHandle):boolean; override;
  65. procedure CommitRetaining(trans:TSQLHandle); override;
  66. procedure RollbackRetaining(trans:TSQLHandle); override;
  67. // - Statement execution
  68. procedure Execute(cursor:TSQLCursor; ATransaction:TSQLTransaction; AParams:TParams); override;
  69. function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
  70. // - Result retrieving
  71. procedure AddFieldDefs(cursor:TSQLCursor; FieldDefs:TFieldDefs); override;
  72. function Fetch(cursor:TSQLCursor):boolean; override;
  73. function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer; out CreateBlob : boolean):boolean; override;
  74. // function CreateBlobStream(Field:TField; Mode:TBlobStreamMode):TStream; override;
  75. procedure FreeFldBuffers(cursor:TSQLCursor); override;
  76. public
  77. constructor Create(AOwner : TComponent); override;
  78. end;
  79. TOracleConnectionDef = Class(TConnectionDef)
  80. Class Function TypeName : String; override;
  81. Class Function ConnectionClass : TSQLConnectionClass; override;
  82. Class Function Description : String; override;
  83. end;
  84. implementation
  85. uses
  86. math, StrUtils;
  87. ResourceString
  88. SErrEnvCreateFailed = 'The creation of an Oracle environment failed.';
  89. SErrHandleAllocFailed = 'The allocation of the error handle failed.';
  90. SErrOracle = 'Oracle returned error %s:';
  91. procedure TOracleConnection.HandleError;
  92. var errcode : sb4;
  93. buf : array[0..1023] of char;
  94. E : EOraDatabaseError;
  95. begin
  96. OCIErrorGet(FOciError,1,nil,errcode,@buf[0],1024,OCI_HTYPE_ERROR);
  97. if (Self.Name <> '') then
  98. E := EOraDatabaseError.CreateFmt('%s : %s',[Self.Name,pchar(buf)])
  99. else
  100. E := EOraDatabaseError.Create(pchar(buf));
  101. E.ORAErrorCode := errcode;
  102. Raise E;
  103. end;
  104. procedure TOracleConnection.DoInternalConnect;
  105. var
  106. ConnectString : string;
  107. TempServiceContext : POCISvcCtx;
  108. begin
  109. {$IfDef LinkDynamically}
  110. InitialiseOCI;
  111. {$EndIf}
  112. inherited DoInternalConnect;
  113. //todo: get rid of FUserMem, as it isn't used
  114. FUserMem := nil;
  115. // Create environment handle
  116. if OCIEnvCreate(FOciEnvironment,oci_default,nil,nil,nil,nil,0,FUserMem) <> OCI_SUCCESS then
  117. DatabaseError(SErrEnvCreateFailed,self);
  118. // Create error handle
  119. if OciHandleAlloc(FOciEnvironment,FOciError,OCI_HTYPE_ERROR,0,FUserMem) <> OCI_SUCCESS then
  120. DatabaseError(SErrHandleAllocFailed,self);
  121. // Create Server handle
  122. if OciHandleAlloc(FOciEnvironment,FOciServer,OCI_HTYPE_SERVER,0,FUserMem) <> OCI_SUCCESS then
  123. DatabaseError(SErrHandleAllocFailed,self);
  124. // Initialize Server handle
  125. if hostname='' then connectstring := databasename
  126. else connectstring := '//'+hostname+'/'+databasename;
  127. if OCIServerAttach(FOciServer,FOciError,@(ConnectString[1]),Length(ConnectString),OCI_DEFAULT) <> OCI_SUCCESS then
  128. HandleError();
  129. // Create temporary service-context handle for user-authentication
  130. if OciHandleAlloc(FOciEnvironment,TempServiceContext,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
  131. DatabaseError(SErrHandleAllocFailed,self);
  132. // Create user-session handle
  133. if OciHandleAlloc(FOciEnvironment,FOciUserSession,OCI_HTYPE_SESSION,0,FUserMem) <> OCI_SUCCESS then
  134. DatabaseError(SErrHandleAllocFailed,self);
  135. // Set the server-handle in the service-context handle
  136. if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
  137. HandleError();
  138. // Set username and password in the user-session handle
  139. if OCIAttrSet(FOciUserSession,OCI_HTYPE_SESSION,@(Self.UserName[1]),Length(Self.UserName),OCI_ATTR_USERNAME,FOciError) <> OCI_SUCCESS then
  140. HandleError();
  141. if OCIAttrSet(FOciUserSession,OCI_HTYPE_SESSION,@(Self.Password[1]),Length(Self.Password),OCI_ATTR_PASSWORD,FOciError) <> OCI_SUCCESS then
  142. HandleError();
  143. // Authenticate
  144. if OCISessionBegin(TempServiceContext,FOciError,FOcIUserSession,OCI_CRED_RDBMS,OCI_DEFAULT) <> OCI_SUCCESS then
  145. HandleError();
  146. // Free temporary service-context handle
  147. OCIHandleFree(TempServiceContext,OCI_HTYPE_SVCCTX);
  148. end;
  149. procedure TOracleConnection.DoInternalDisconnect;
  150. var
  151. TempServiceContext : POCISvcCtx;
  152. begin
  153. inherited DoInternalDisconnect;
  154. // Create temporary service-context handle for user-disconnect
  155. if OciHandleAlloc(FOciEnvironment,TempServiceContext,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
  156. DatabaseError(SErrHandleAllocFailed,self);
  157. // Set the server handle in the service-context handle
  158. if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
  159. HandleError();
  160. // Set the user session handle in the service-context handle
  161. if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciUserSession,0,OCI_ATTR_SESSION,FOciError) <> OCI_SUCCESS then
  162. HandleError();
  163. // Disconnect uses-session handle
  164. if OCISessionEnd(TempServiceContext,FOciError,FOcIUserSession,OCI_DEFAULT) <> OCI_SUCCESS then
  165. HandleError();
  166. // Free user-session handle
  167. OCIHandleFree(FOciUserSession,OCI_HTYPE_SESSION);
  168. // Free temporary service-context handle
  169. OCIHandleFree(TempServiceContext,OCI_HTYPE_SVCCTX);
  170. // Disconnect server handle
  171. if OCIServerDetach(FOciServer,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
  172. HandleError();
  173. // Free connection handles
  174. OCIHandleFree(FOciServer,OCI_HTYPE_SERVER);
  175. OCIHandleFree(FOciError,OCI_HTYPE_ERROR);
  176. OCIHandleFree(FOciEnvironment,OCI_HTYPE_ENV);
  177. {$IfDef LinkDynamically}
  178. ReleaseOCI;
  179. {$EndIf}
  180. end;
  181. function TOracleConnection.AllocateCursorHandle: TSQLCursor;
  182. var Cursor : TOracleCursor;
  183. begin
  184. Cursor:=TOracleCursor.Create;
  185. Result := cursor;
  186. end;
  187. procedure TOracleConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
  188. var tel : word;
  189. begin
  190. with cursor as TOracleCursor do
  191. begin
  192. if Length(FieldBuffers) > 0 then
  193. for tel := 0 to high(FieldBuffers) do freemem(FieldBuffers[tel].buffer);
  194. end;
  195. FreeAndNil(cursor);
  196. end;
  197. function TOracleConnection.AllocateTransactionHandle: TSQLHandle;
  198. var
  199. locRes : TOracleTrans;
  200. begin
  201. locRes := TOracleTrans.Create();
  202. try
  203. // Allocate service-context handle
  204. if OciHandleAlloc(FOciEnvironment,locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
  205. DatabaseError(SErrHandleAllocFailed,self);
  206. // Set the server-handle in the service-context handle
  207. if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
  208. HandleError();
  209. // Set the user-session handle in the service-context handle
  210. if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,FOciUserSession,0,OCI_ATTR_SESSION,FOciError) <> OCI_SUCCESS then
  211. HandleError();
  212. // Allocate transaction handle
  213. if OciHandleAlloc(FOciEnvironment,locRes.FOciTrans,OCI_HTYPE_TRANS,0,FUserMem) <> OCI_SUCCESS then
  214. DatabaseError(SErrHandleAllocFailed,self);
  215. // Set the transaction handle in the service-context handle
  216. if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,locRes.FOciTrans,0,OCI_ATTR_TRANS,FOciError) <> OCI_SUCCESS then
  217. HandleError();
  218. except
  219. locRes.Free();
  220. raise;
  221. end;
  222. Result := locRes;
  223. end;
  224. procedure TOracleConnection.PrepareStatement(cursor: TSQLCursor;
  225. ATransaction: TSQLTransaction; buf: string; AParams: TParams);
  226. var tel : integer;
  227. FOcibind : POCIDefine;
  228. OFieldType : ub2;
  229. OFieldSize : sb4;
  230. begin
  231. with cursor as TOracleCursor do
  232. begin
  233. if OCIStmtPrepare2(TOracleTrans(ATransaction.Handle).FOciSvcCtx,FOciStmt,FOciError,@buf[1],length(buf),nil,0,OCI_NTV_SYNTAX,OCI_DEFAULT) = OCI_ERROR then
  234. HandleError;
  235. if assigned(AParams) then
  236. begin
  237. setlength(ParamBuffers,AParams.Count);
  238. for tel := 0 to AParams.Count-1 do
  239. begin
  240. case AParams[tel].DataType of
  241. ftInteger : begin OFieldType := SQLT_INT; OFieldSize := sizeof(integer); end;
  242. ftFloat : begin OFieldType := SQLT_FLT; OFieldSize := sizeof(double); end;
  243. ftDate, ftDateTime : begin OFieldType := SQLT_DAT; OFieldSize := 7; end;
  244. ftString : begin OFieldType := SQLT_STR; OFieldSize := 4000; end;
  245. end;
  246. parambuffers[tel].buffer := getmem(OFieldSize);
  247. FOciBind := nil;
  248. if OCIBindByName(FOciStmt,FOcibind,FOciError,pchar(AParams[tel].Name),length(AParams[tel].Name),ParamBuffers[tel].buffer,OFieldSize,OFieldType,@ParamBuffers[tel].ind,nil,nil,0,nil,OCI_DEFAULT )= OCI_ERROR then
  249. HandleError;
  250. end;
  251. end;
  252. FPrepared := True;
  253. end;
  254. end;
  255. procedure TOracleConnection.SetParameters(cursor : TSQLCursor;AParams : TParams);
  256. var SQLVarNr : integer;
  257. i : integer;
  258. f : double;
  259. year,month,day : word;
  260. db : array[0..4] of byte;
  261. pb : pbyte;
  262. s : string;
  263. begin
  264. with cursor as TOracleCursor do for SQLVarNr := 0 to High(ParamBuffers) do with AParams[SQLVarNr] do
  265. begin
  266. if IsNull then parambuffers[SQLVarNr].ind := -1 else
  267. parambuffers[SQLVarNr].ind := 0;
  268. case DataType of
  269. ftInteger : begin
  270. i := asInteger;
  271. move(i,parambuffers[SQLVarNr].buffer^,sizeof(integer));
  272. end;
  273. ftFloat : begin
  274. f := asFloat;
  275. move(f,parambuffers[SQLVarNr].buffer^,sizeof(double));
  276. end;
  277. ftString : begin
  278. s := asString+#0;
  279. move(s[1],parambuffers[SQLVarNr].buffer^,length(s)+1);
  280. end;
  281. ftDate, ftDateTime: begin
  282. DecodeDate(asDateTime,year,month,day);
  283. pb := parambuffers[SQLVarNr].buffer;
  284. pb[0] := (year div 100)+100;
  285. pb[1] := (year mod 100)+100;
  286. pb[2] := month;
  287. pb[3] := day;
  288. pb[4] := 1;
  289. pb[5] := 1;
  290. pb[6] := 1;
  291. end;
  292. end;
  293. end;
  294. end;
  295. procedure TOracleConnection.UnPrepareStatement(cursor: TSQLCursor);
  296. begin
  297. if OCIStmtRelease(TOracleCursor(cursor).FOciStmt,FOciError,nil,0,OCI_DEFAULT)<> OCI_SUCCESS then
  298. HandleError();
  299. cursor.FPrepared:=False;
  300. end;
  301. procedure TOracleConnection.InternalStartDBTransaction(trans : TOracleTrans);
  302. begin
  303. if OCITransStart(trans.FOciSvcCtx,FOciError,DefaultTimeOut,trans.FOciFlags) <> OCI_SUCCESS then
  304. HandleError();
  305. end;
  306. function TOracleConnection.GetTransactionHandle(trans: TSQLHandle): pointer;
  307. begin
  308. Result := trans;
  309. end;
  310. function TOracleConnection.StartDBTransaction(trans: TSQLHandle; AParams: string): boolean;
  311. var
  312. x_flags : ub4;
  313. i : Integer;
  314. s : string;
  315. locTrans : TOracleTrans;
  316. begin
  317. locTrans := TOracleTrans(trans);
  318. if ( Length(AParams) = 0 ) then begin
  319. x_flags := OCI_TRANS_NEW or OCI_TRANS_READWRITE;
  320. end else begin
  321. x_flags := OCI_DEFAULT;
  322. i := 1;
  323. s := ExtractSubStr(AParams,i,StdWordDelims);
  324. while ( s <> '' ) do begin
  325. if ( s = 'readonly' ) then
  326. x_flags := x_flags and OCI_TRANS_READONLY
  327. else if ( s = 'serializable' ) then
  328. x_flags := x_flags and OCI_TRANS_SERIALIZABLE
  329. else if ( s = 'readwrite' ) then
  330. x_flags := x_flags and OCI_TRANS_READWRITE;
  331. s := ExtractSubStr(AParams,i,StdWordDelims);
  332. end;
  333. x_flags := x_flags and OCI_TRANS_NEW;
  334. end;
  335. locTrans.FOciFlags := x_flags;
  336. InternalStartDBTransaction(locTrans);
  337. Result := True;
  338. end;
  339. function TOracleConnection.Commit(trans: TSQLHandle): boolean;
  340. begin
  341. if OCITransCommit(TOracleTrans(trans).FOciSvcCtx,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
  342. HandleError();
  343. Result := True;
  344. end;
  345. function TOracleConnection.Rollback(trans: TSQLHandle): boolean;
  346. begin
  347. if OCITransRollback(TOracleTrans(trans).FOciSvcCtx,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
  348. HandleError();
  349. Result := True;
  350. end;
  351. procedure TOracleConnection.CommitRetaining(trans: TSQLHandle);
  352. begin
  353. Commit(trans);
  354. InternalStartDBTransaction(TOracleTrans(trans));
  355. end;
  356. procedure TOracleConnection.RollbackRetaining(trans: TSQLHandle);
  357. begin
  358. Rollback(trans);
  359. InternalStartDBTransaction(TOracleTrans(trans));
  360. end;
  361. procedure TOracleConnection.Execute(cursor: TSQLCursor; ATransaction: TSQLTransaction; AParams: TParams);
  362. begin
  363. if Assigned(APArams) and (AParams.count > 0) then SetParameters(cursor, AParams);
  364. if cursor.FStatementType = stSelect then
  365. begin
  366. if OCIStmtExecute(TOracleTrans(ATransaction.Handle).FOciSvcCtx,(cursor as TOracleCursor).FOciStmt,FOciError,0,0,nil,nil,OCI_DEFAULT) = OCI_ERROR then
  367. HandleError;
  368. end
  369. else
  370. begin
  371. if OCIStmtExecute(TOracleTrans(ATransaction.Handle).FOciSvcCtx,(cursor as TOracleCursor).FOciStmt,FOciError,1,0,nil,nil,OCI_DEFAULT) = OCI_ERROR then
  372. HandleError;
  373. end;
  374. end;
  375. function TOracleConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;
  376. var rowcount: ub4;
  377. begin
  378. if OCIAttrGet((cursor as TOracleCursor).FOciStmt, OCI_HTYPE_STMT, @rowcount, nil, OCI_ATTR_ROW_COUNT, FOciError) = OCI_SUCCESS then
  379. Result:=rowcount
  380. else
  381. Result:=inherited RowsAffected(cursor);
  382. end;
  383. procedure TOracleConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);
  384. var Param : POCIParam;
  385. tel : ub4;
  386. FieldType : TFieldType;
  387. FieldName : string;
  388. FieldSize : word;
  389. OFieldType : ub2;
  390. OFieldName : Pchar;
  391. OFieldSize : sb4;
  392. OFNameLength : ub4;
  393. NumCols : ub4;
  394. FOciDefine : POCIDefine;
  395. OPrecision : sb2;
  396. OScale : sb1;
  397. begin
  398. Param := nil;
  399. with cursor as TOracleCursor do
  400. begin
  401. if OCIAttrGet(FOciStmt,OCI_HTYPE_STMT,@numcols,nil,OCI_ATTR_PARAM_COUNT,FOciError) = OCI_ERROR then
  402. HandleError;
  403. // Let op, moet gewist worden. En in een keer gealloceerd
  404. Setlength(FieldBuffers,numcols);
  405. for tel := 1 to numcols do
  406. begin
  407. if OCIParamGet(FOciStmt,OCI_HTYPE_STMT,FOciError,Param,tel) = OCI_ERROR then
  408. HandleError;
  409. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldType,nil,OCI_ATTR_DATA_TYPE,FOciError) = OCI_ERROR then
  410. HandleError;
  411. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldSize,nil,OCI_ATTR_DATA_SIZE,FOciError) = OCI_ERROR then
  412. HandleError;
  413. FieldSize := 0;
  414. case OFieldType of
  415. OCI_TYPECODE_NUMBER : begin
  416. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oprecision,nil,OCI_ATTR_PRECISION,FOciError) = OCI_ERROR then
  417. HandleError;
  418. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oscale,nil,OCI_ATTR_SCALE,FOciError) = OCI_ERROR then
  419. HandleError;
  420. if Oscale = 0 then
  421. begin
  422. FieldType := ftInteger;
  423. OFieldType := SQLT_INT;
  424. OFieldSize:= sizeof(integer);
  425. end
  426. else if (oscale = -127) {and (OPrecision=0)} then
  427. begin
  428. FieldType := ftFloat;
  429. OFieldType := SQLT_FLT;
  430. OFieldSize:=sizeof(double);
  431. end
  432. else if (oscale <=4) and (OPrecision<=12) then
  433. begin
  434. FieldType := ftBCD;
  435. FieldSize := oscale;
  436. OFieldType := SQLT_VNU;
  437. OFieldSize:= 22;
  438. end
  439. else FieldType := ftUnknown;
  440. end;
  441. OCI_TYPECODE_CHAR,
  442. OCI_TYPECODE_VARCHAR,
  443. OCI_TYPECODE_VARCHAR2 : begin FieldType := ftString; FieldSize := OFieldSize; inc(OFieldsize) ;OFieldType:=SQLT_STR end;
  444. OCI_TYPECODE_DATE : FieldType := ftDate;
  445. OCI_TYPECODE_TIMESTAMP,
  446. OCI_TYPECODE_TIMESTAMP_LTZ,
  447. OCI_TYPECODE_TIMESTAMP_TZ : begin
  448. FieldType := ftDateTime;
  449. OFieldType := SQLT_ODT;
  450. end;
  451. else
  452. FieldType := ftUnknown;
  453. end;
  454. FieldBuffers[tel-1].buffer := getmem(OFieldSize);
  455. FOciDefine := nil;
  456. if OciDefineByPos(FOciStmt,FOciDefine,FOciError,tel,fieldbuffers[tel-1].buffer,OFieldSize,OFieldType,@(fieldbuffers[tel-1].ind),nil,nil,OCI_DEFAULT) = OCI_ERROR then
  457. HandleError;
  458. if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldName,@OFNameLength,OCI_ATTR_NAME,FOciError) <> OCI_SUCCESS then
  459. HandleError;
  460. setlength(Fieldname,OFNameLength);
  461. move(OFieldName^,Fieldname[1],OFNameLength);
  462. TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(FieldName), FieldType, FieldSize, False, tel);
  463. end;
  464. end;
  465. end;
  466. function TOracleConnection.Fetch(cursor: TSQLCursor): boolean;
  467. begin
  468. case OCIStmtFetch2((cursor as TOracleCursor).FOciStmt,FOciError,1,OCI_FETCH_NEXT,1,OCI_DEFAULT) of
  469. OCI_ERROR : begin
  470. Result := False;
  471. HandleError;
  472. end;
  473. OCI_NO_DATA : Result := False;
  474. OCI_SUCCESS : Result := True;
  475. OCI_SUCCESS_WITH_INFO : Begin
  476. Result := True;
  477. HandleError;
  478. end;
  479. end; {case}
  480. end;
  481. function TOracleConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer; out CreateBlob : boolean): boolean;
  482. var dt : TDateTime;
  483. b : pbyte;
  484. size,i : byte;
  485. exp : shortint;
  486. cur : Currency;
  487. odt : POCIdateTime;
  488. begin
  489. CreateBlob := False;
  490. with cursor as TOracleCursor do if fieldbuffers[FieldDef.FieldNo-1].ind = -1 then
  491. Result := False
  492. else
  493. begin
  494. result := True;
  495. case FieldDef.DataType of
  496. ftString : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,FieldDef.Size);
  497. ftBCD : begin
  498. b := fieldbuffers[FieldDef.FieldNo-1].buffer;
  499. size := b[0];
  500. cur := 0;
  501. if (b[1] and $80)=$80 then // then the number is positive
  502. begin
  503. exp := (b[1] and $7f)-65;
  504. for i := 2 to size do
  505. cur := cur + (b[i]-1) * intpower(100,-(i-2)+exp);
  506. end
  507. else
  508. begin
  509. exp := (not(b[1]) and $7f)-65;
  510. for i := 2 to size-1 do
  511. cur := cur + (101-b[i]) * intpower(100,-(i-2)+exp);
  512. cur := -cur;
  513. end;
  514. move(cur,buffer^,SizeOf(Currency));
  515. end;
  516. ftFloat : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(double));
  517. ftInteger : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(integer));
  518. ftDate : begin
  519. b := fieldbuffers[FieldDef.FieldNo-1].buffer;
  520. dt := EncodeDate((b[0]-100)*100+(b[1]-100),b[2],b[3]);
  521. move(dt,buffer^,sizeof(dt));
  522. end;
  523. ftDateTime : begin
  524. odt := fieldbuffers[FieldDef.FieldNo-1].buffer;
  525. dt := ComposeDateTime(EncodeDate(odt^.year,odt^.month,odt^.day), EncodeTime(odt^.hour,odt^.min,odt^.sec,0));
  526. move(dt,buffer^,sizeof(dt));
  527. end;
  528. else
  529. Result := False;
  530. end;
  531. end;
  532. end;
  533. {function TOracleConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  534. begin
  535. // Result:=inherited CreateBlobStream(Field, Mode);
  536. end;}
  537. procedure TOracleConnection.FreeFldBuffers(cursor: TSQLCursor);
  538. begin
  539. // inherited FreeFldBuffers(cursor);
  540. end;
  541. constructor TOracleConnection.Create(AOwner: TComponent);
  542. begin
  543. inherited Create(AOwner);
  544. FConnOptions := FConnOptions + [sqEscapeRepeat];
  545. FUserMem := nil;
  546. end;
  547. { TOracleConnectionDef }
  548. class function TOracleConnectionDef.TypeName: String;
  549. begin
  550. Result:='Oracle';
  551. end;
  552. class function TOracleConnectionDef.ConnectionClass: TSQLConnectionClass;
  553. begin
  554. Result:=TOracleConnection;
  555. end;
  556. class function TOracleConnectionDef.Description: String;
  557. begin
  558. Result:='Connect to an Oracle database directly via the client library';
  559. end;
  560. { TOracleTrans }
  561. destructor TOracleTrans.Destroy();
  562. begin
  563. OCIHandleFree(FOciTrans,OCI_HTYPE_TRANS);
  564. OCIHandleFree(FOciSvcCtx,OCI_HTYPE_SVCCTX);
  565. inherited Destroy();
  566. end;
  567. initialization
  568. RegisterConnection(TOracleConnectionDef);
  569. finalization
  570. RegisterConnection(TOracleConnectionDef);
  571. end.