odbcconn.pas 51 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252
  1. (******************************************************************************
  2. * *
  3. * (c) 2005 Hexis BV *
  4. * *
  5. * File: odbcconn.pas *
  6. * Author: Bram Kuijvenhoven ([email protected]) *
  7. * Description: ODBC SQLDB unit *
  8. * License: (modified) LGPL *
  9. * *
  10. ******************************************************************************)
  11. unit odbcconn;
  12. {$mode objfpc}{$H+}
  13. interface
  14. uses
  15. Classes, SysUtils, sqldb, db, odbcsqldyn
  16. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}, BufDataset{$ENDIF}
  17. ;
  18. type
  19. // forward declarations
  20. TODBCConnection = class;
  21. { TODBCCursor }
  22. TODBCCursor = class(TSQLCursor)
  23. protected
  24. FSTMTHandle:SQLHSTMT; // ODBC Statement Handle
  25. FQuery:string; // last prepared query, with :ParamName converted to ?
  26. FParamIndex:TParamBinding; // maps the i-th parameter in the query to the TParams passed to PrepareStatement
  27. FParamBuf:array of pointer; // buffers that can be used to bind the i-th parameter in the query
  28. {$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
  29. FBlobStreams:TList; // list of Blob TMemoryStreams stored in field buffers (we need this currently as we can't hook into the freeing of TBufDataset buffers)
  30. {$ENDIF}
  31. public
  32. constructor Create(Connection:TODBCConnection);
  33. destructor Destroy; override;
  34. end;
  35. { TODBCHandle } // this name is a bit confusing, but follows the standards for naming classes in sqldb
  36. TODBCHandle = class(TSQLHandle)
  37. protected
  38. end;
  39. { TODBCEnvironment }
  40. TODBCEnvironment = class
  41. protected
  42. FENVHandle:SQLHENV; // ODBC Environment Handle
  43. public
  44. constructor Create;
  45. destructor Destroy; override;
  46. end;
  47. { TODBCConnection }
  48. TODBCConnection = class(TSQLConnection)
  49. private
  50. FDriver: string;
  51. FEnvironment:TODBCEnvironment;
  52. FDBCHandle:SQLHDBC; // ODBC Connection Handle
  53. FFileDSN: string;
  54. procedure SetParameters(ODBCCursor:TODBCCursor; AParams:TParams);
  55. procedure FreeParamBuffers(ODBCCursor:TODBCCursor);
  56. protected
  57. // Overrides from TSQLConnection
  58. function GetHandle:pointer; override;
  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. function GetTransactionHandle(trans:TSQLHandle):pointer; override;
  71. function StartDBTransaction(trans:TSQLHandle; AParams:string):boolean; override;
  72. function Commit(trans:TSQLHandle):boolean; override;
  73. function Rollback(trans:TSQLHandle):boolean; override;
  74. procedure CommitRetaining(trans:TSQLHandle); override;
  75. procedure RollbackRetaining(trans:TSQLHandle); override;
  76. // - Statement execution
  77. procedure Execute(cursor:TSQLCursor; ATransaction:TSQLTransaction; AParams:TParams); override;
  78. // - Result retrieving
  79. procedure AddFieldDefs(cursor:TSQLCursor; FieldDefs:TFieldDefs); override;
  80. function Fetch(cursor:TSQLCursor):boolean; override;
  81. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  82. function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer; out CreateBlob : boolean):boolean; override;
  83. procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
  84. {$ELSE}
  85. function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer):boolean; override;
  86. function CreateBlobStream(Field:TField; Mode:TBlobStreamMode):TStream; override;
  87. {$ENDIF}
  88. procedure FreeFldBuffers(cursor:TSQLCursor); override;
  89. // - UpdateIndexDefs
  90. procedure UpdateIndexDefs(IndexDefs:TIndexDefs; TableName:string); override;
  91. // - Schema info
  92. function GetSchemaInfoSQL(SchemaType:TSchemaType; SchemaObjectName, SchemaObjectPattern:string):string; override;
  93. // Internal utility functions
  94. function CreateConnectionString:string;
  95. public
  96. constructor Create(AOwner : TComponent); override;
  97. property Environment:TODBCEnvironment read FEnvironment;
  98. published
  99. property Driver:string read FDriver write FDriver; // will be passed as DRIVER connection parameter
  100. property FileDSN:string read FFileDSN write FFileDSN; // will be passed as FILEDSN parameter
  101. // Redeclare properties from TSQLConnection
  102. property Password; // will be passed as PWD connection parameter
  103. property Transaction;
  104. property UserName; // will be passed as UID connection parameter
  105. property CharSet;
  106. property HostName; // ignored
  107. // Redeclare properties from TDatabase
  108. property Connected;
  109. property Role;
  110. property DatabaseName; // will be passed as DSN connection parameter
  111. property KeepConnection;
  112. property LoginPrompt; // if true, ODBC drivers might prompt for more details that are not in the connection string
  113. property Params; // will be added to connection string
  114. property OnLogin;
  115. end;
  116. EODBCException = class(Exception)
  117. // currently empty; perhaps we can add fields here later that describe the error instead of one simple message string
  118. end;
  119. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  120. { TODBCConnectionDef }
  121. TODBCConnectionDef = Class(TConnectionDef)
  122. Class Function TypeName : String; override;
  123. Class Function ConnectionClass : TSQLConnectionClass; override;
  124. Class Function Description : String; override;
  125. end;
  126. {$ENDIF}
  127. implementation
  128. uses
  129. Math, DBConst;
  130. const
  131. DefaultEnvironment:TODBCEnvironment = nil;
  132. ODBCLoadCount:integer = 0; // ODBC is loaded when > 0; modified by TODBCEnvironment.Create/Destroy
  133. { Generic ODBC helper functions }
  134. function ODBCSucces(const Res:SQLRETURN):boolean;
  135. begin
  136. Result:=(Res=SQL_SUCCESS) or (Res=SQL_SUCCESS_WITH_INFO);
  137. end;
  138. function ODBCResultToStr(Res:SQLRETURN):string;
  139. begin
  140. case Res of
  141. SQL_SUCCESS: Result:='SQL_SUCCESS';
  142. SQL_SUCCESS_WITH_INFO:Result:='SQL_SUCCESS_WITH_INFO';
  143. SQL_ERROR: Result:='SQL_ERROR';
  144. SQL_INVALID_HANDLE: Result:='SQL_INVALID_HANDLE';
  145. SQL_NO_DATA: Result:='SQL_NO_DATA';
  146. SQL_NEED_DATA: Result:='SQL_NEED_DATA';
  147. SQL_STILL_EXECUTING: Result:='SQL_STILL_EXECUTING';
  148. else
  149. Result:='';
  150. end;
  151. end;
  152. procedure ODBCCheckResult(LastReturnCode:SQLRETURN; HandleType:SQLSMALLINT; AHandle: SQLHANDLE; ErrorMsg: string; const FmtArgs:array of const);
  153. // check return value from SQLGetDiagField/Rec function itself
  154. procedure CheckSQLGetDiagResult(const Res:SQLRETURN);
  155. begin
  156. case Res of
  157. SQL_INVALID_HANDLE:
  158. raise EODBCException.Create('Invalid handle passed to SQLGetDiagRec/Field');
  159. SQL_ERROR:
  160. raise EODBCException.Create('An invalid parameter was passed to SQLGetDiagRec/Field');
  161. SQL_NO_DATA:
  162. raise EODBCException.Create('A too large RecNumber was passed to SQLGetDiagRec/Field');
  163. end;
  164. end;
  165. var
  166. NativeError:SQLINTEGER;
  167. TextLength:SQLSMALLINT;
  168. Res:SQLRETURN;
  169. SqlState,MessageText,TotalMessage:string;
  170. RecNumber:SQLSMALLINT;
  171. begin
  172. // check result
  173. if ODBCSucces(LastReturnCode) then
  174. Exit; // no error; all is ok
  175. //WriteLn('LastResultCode: ',ODBCResultToStr(LastReturnCode));
  176. try
  177. // build TotalMessage for exception to throw
  178. TotalMessage:=Format(ErrorMsg,FmtArgs)+Format(' ODBC error details: LastReturnCode: %s;',[ODBCResultToStr(LastReturnCode)]);
  179. // retrieve status records
  180. SetLength(SqlState,5); // SqlState buffer
  181. SetLength(MessageText,1);
  182. RecNumber:=1;
  183. repeat
  184. // dummy call to get correct TextLength
  185. //WriteLn('Getting error record ',RecNumber);
  186. Res:=SQLGetDiagRec(HandleType,AHandle,RecNumber,@(SqlState[1]),NativeError,@(MessageText[1]),0,TextLength);
  187. if Res=SQL_NO_DATA then
  188. Break; // no more status records
  189. CheckSQLGetDiagResult(Res);
  190. if TextLength>0 then // if TextLength=0 we don't need another call; also our string buffer would not point to a #0, but be a nil pointer
  191. begin
  192. // allocate large enough buffer
  193. SetLength(MessageText,TextLength); // note: ansistrings of Length>0 are always terminated by a #0 character, so this is safe
  194. // actual call
  195. Res:=SQLGetDiagRec(HandleType,AHandle,RecNumber,@(SqlState[1]),NativeError,@(MessageText[1]),Length(MessageText)+1,TextLength);
  196. CheckSQLGetDiagResult(Res);
  197. end;
  198. // add to TotalMessage
  199. TotalMessage:=TotalMessage+Format(' Record %d: SqlState: %s; NativeError: %d; Message: %s;',[RecNumber,SqlState,NativeError,MessageText]);
  200. // incement counter
  201. Inc(RecNumber);
  202. until false;
  203. except
  204. on E:EODBCException do begin
  205. TotalMessage:=TotalMessage+Format('Could not get error message: %s',[E.Message]);
  206. end
  207. end;
  208. // raise error
  209. raise EODBCException.Create(TotalMessage);
  210. end;
  211. procedure ODBCCheckResult(LastReturnCode:SQLRETURN; HandleType:SQLSMALLINT; AHandle: SQLHANDLE; ErrorMsg: string);
  212. begin
  213. ODBCCheckResult(LastReturnCode, HandleType, AHandle, ErrorMsg, []);
  214. end;
  215. { TODBCConnection }
  216. // Creates a connection string using the current value of the fields
  217. function TODBCConnection.CreateConnectionString: string;
  218. // encloses a param value with braces if necessary, i.e. when any of the characters []{}(),;?*=!@ is in the value
  219. function EscapeParamValue(const s:string):string;
  220. var
  221. NeedEscape:boolean;
  222. i:integer;
  223. begin
  224. NeedEscape:=false;
  225. for i:=1 to Length(s) do
  226. if s[i] in ['[',']','{','}','(',')',',','*','=','!','@'] then
  227. begin
  228. NeedEscape:=true;
  229. Break;
  230. end;
  231. if NeedEscape then
  232. Result:='{'+s+'}'
  233. else
  234. Result:=s;
  235. end;
  236. var
  237. i: Integer;
  238. Param: string;
  239. EqualSignPos:integer;
  240. begin
  241. Result:='';
  242. if DatabaseName<>'' then Result:=Result + 'DSN='+EscapeParamValue(DatabaseName)+';';
  243. if Driver <>'' then Result:=Result + 'DRIVER='+EscapeParamValue(Driver)+';';
  244. if UserName <>'' then Result:=Result + 'UID='+EscapeParamValue(UserName)+';PWD='+EscapeParamValue(Password)+';';
  245. if FileDSN <>'' then Result:=Result + 'FILEDSN='+EscapeParamValue(FileDSN)+'';
  246. for i:=0 to Params.Count-1 do
  247. begin
  248. Param:=Params[i];
  249. EqualSignPos:=Pos('=',Param);
  250. if EqualSignPos=0 then
  251. raise EODBCException.CreateFmt('Invalid parameter in Params[%d]; can''t find a ''='' in ''%s''',[i, Param])
  252. else if EqualSignPos=1 then
  253. raise EODBCException.CreateFmt('Invalid parameter in Params[%d]; no identifier before the ''='' in ''%s''',[i, Param])
  254. else
  255. Result:=Result + EscapeParamValue(Copy(Param,1,EqualSignPos-1))+'='+EscapeParamValue(Copy(Param,EqualSignPos+1,MaxInt))+';';
  256. end;
  257. end;
  258. constructor TODBCConnection.Create(AOwner: TComponent);
  259. begin
  260. inherited Create(AOwner);
  261. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  262. FConnOptions := FConnOptions + [sqEscapeRepeat] + [sqEscapeSlash];
  263. {$ENDIF}
  264. end;
  265. procedure TODBCConnection.SetParameters(ODBCCursor: TODBCCursor; AParams: TParams);
  266. var
  267. ParamIndex:integer;
  268. Buf:pointer;
  269. I:integer;
  270. IntVal:longint;
  271. StrVal:string;
  272. StrLen:SQLINTEGER;
  273. begin
  274. // Note: it is assumed that AParams is the same as the one passed to PrepareStatement, in the sense that
  275. // the parameters have the same order and names
  276. if Length(ODBCCursor.FParamIndex)>0 then
  277. if not Assigned(AParams) then
  278. raise EODBCException.CreateFmt('The query has parameter markers in it, but no actual parameters were passed',[]);
  279. SetLength(ODBCCursor.FParamBuf, Length(ODBCCursor.FParamIndex));
  280. for i:=0 to High(ODBCCursor.FParamIndex) do
  281. begin
  282. ParamIndex:=ODBCCursor.FParamIndex[i];
  283. if (ParamIndex<0) or (ParamIndex>=AParams.Count) then
  284. raise EODBCException.CreateFmt('Parameter %d in query does not have a matching parameter set',[i]);
  285. case AParams[ParamIndex].DataType of
  286. ftInteger:
  287. begin
  288. Buf:=GetMem(4);
  289. IntVal:=AParams[ParamIndex].AsInteger;
  290. Move(IntVal,Buf^,4);
  291. ODBCCursor.FParamBuf[i]:=Buf;
  292. ODBCCheckResult(
  293. SQLBindParameter(ODBCCursor.FSTMTHandle, // StatementHandle
  294. i+1, // ParameterNumber
  295. SQL_PARAM_INPUT, // InputOutputType
  296. SQL_C_LONG, // ValueType
  297. SQL_INTEGER, // ParameterType
  298. 10, // ColumnSize
  299. 0, // DecimalDigits
  300. Buf, // ParameterValuePtr
  301. 0, // BufferLength
  302. nil), // StrLen_or_IndPtr
  303. SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not bind (integer) parameter %d.', [i]
  304. );
  305. end;
  306. ftString:
  307. begin
  308. StrVal:=AParams[ParamIndex].AsString;
  309. StrLen:=Length(StrVal);
  310. Buf:=GetMem(SizeOf(SQLINTEGER)+StrLen);
  311. Move(StrLen, buf^, SizeOf(SQLINTEGER));
  312. Move(StrVal[1],(buf+SizeOf(SQLINTEGER))^,StrLen);
  313. ODBCCursor.FParamBuf[i]:=Buf;
  314. ODBCCheckResult(
  315. SQLBindParameter(ODBCCursor.FSTMTHandle, // StatementHandle
  316. i+1, // ParameterNumber
  317. SQL_PARAM_INPUT, // InputOutputType
  318. SQL_C_CHAR, // ValueType
  319. SQL_CHAR, // ParameterType
  320. StrLen, // ColumnSize
  321. 0, // DecimalDigits
  322. buf+SizeOf(SQLINTEGER), // ParameterValuePtr
  323. StrLen, // BufferLength
  324. Buf), // StrLen_or_IndPtr
  325. SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not bind (string) parameter %d.', [i]
  326. );
  327. end;
  328. else
  329. raise EDataBaseError.CreateFmt('Parameter %d is of type %s, which not supported yet',[ParamIndex, Fieldtypenames[AParams[ParamIndex].DataType]]);
  330. end;
  331. end;
  332. end;
  333. procedure TODBCConnection.FreeParamBuffers(ODBCCursor: TODBCCursor);
  334. var
  335. i:integer;
  336. begin
  337. for i:=0 to High(ODBCCursor.FParamBuf) do
  338. FreeMem(ODBCCursor.FParamBuf[i]);
  339. SetLength(ODBCCursor.FParamBuf,0);
  340. end;
  341. function TODBCConnection.GetHandle: pointer;
  342. begin
  343. // I'm not sure whether this is correct; perhaps we should return nil
  344. // note that FDBHandle is a LongInt, because ODBC handles are integers, not pointers
  345. // I wonder how this will work on 64 bit platforms then (FK)
  346. Result:=pointer(PtrInt(FDBCHandle));
  347. end;
  348. procedure TODBCConnection.DoInternalConnect;
  349. const
  350. BufferLength = 1024; // should be at least 1024 according to the ODBC specification
  351. var
  352. ConnectionString:string;
  353. OutConnectionString:string;
  354. ActualLength:SQLSMALLINT;
  355. begin
  356. // Do not call the inherited method as it checks for a non-empty DatabaseName, and we don't even use DatabaseName!
  357. // inherited DoInternalConnect;
  358. // make sure we have an environment
  359. if not Assigned(FEnvironment) then
  360. begin
  361. if not Assigned(DefaultEnvironment) then
  362. DefaultEnvironment:=TODBCEnvironment.Create;
  363. FEnvironment:=DefaultEnvironment;
  364. end;
  365. // allocate connection handle
  366. ODBCCheckResult(
  367. SQLAllocHandle(SQL_HANDLE_DBC,Environment.FENVHandle,FDBCHandle),
  368. SQL_HANDLE_ENV,Environment.FENVHandle,'Could not allocate ODBC Connection handle.'
  369. );
  370. try
  371. // connect
  372. ConnectionString:=CreateConnectionString;
  373. SetLength(OutConnectionString,BufferLength-1); // allocate completed connection string buffer (using the ansistring #0 trick)
  374. ODBCCheckResult(
  375. SQLDriverConnect(FDBCHandle, // the ODBC connection handle
  376. nil, // no parent window (would be required for prompts)
  377. PChar(ConnectionString), // the connection string
  378. Length(ConnectionString), // connection string length
  379. @(OutConnectionString[1]),// buffer for storing the completed connection string
  380. BufferLength, // length of the buffer
  381. ActualLength, // the actual length of the completed connection string
  382. SQL_DRIVER_NOPROMPT), // don't prompt for password etc.
  383. SQL_HANDLE_DBC,FDBCHandle,'Could not connect with connection string "%s".',[ConnectionString]
  384. );
  385. except
  386. on E:Exception do begin
  387. // free connection handle
  388. ODBCCheckResult(
  389. SQLFreeHandle(SQL_HANDLE_DBC,FDBCHandle),
  390. SQL_HANDLE_DBC,FDBCHandle,'Could not free ODBC Connection handle.'
  391. );
  392. raise; // re-raise exceptoin
  393. end;
  394. end;
  395. // commented out as the OutConnectionString is not used further at the moment
  396. // if ActualLength<BufferLength-1 then
  397. // SetLength(OutConnectionString,ActualLength); // fix completed connection string length
  398. // set connection attributes (none yet)
  399. end;
  400. procedure TODBCConnection.DoInternalDisconnect;
  401. var
  402. Res:SQLRETURN;
  403. begin
  404. inherited DoInternalDisconnect;
  405. // disconnect
  406. ODBCCheckResult(
  407. SQLDisconnect(FDBCHandle),
  408. SQL_HANDLE_DBC,FDBCHandle,'Could not disconnect.'
  409. );
  410. // deallocate connection handle
  411. Res:=SQLFreeHandle(SQL_HANDLE_DBC, FDBCHandle);
  412. if Res=SQL_ERROR then
  413. ODBCCheckResult(Res,SQL_HANDLE_DBC,FDBCHandle,'Could not free ODBC Connection handle.');
  414. end;
  415. function TODBCConnection.AllocateCursorHandle: TSQLCursor;
  416. begin
  417. Result:=TODBCCursor.Create(self);
  418. end;
  419. procedure TODBCConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
  420. begin
  421. // make sure we don't deallocate the cursor if the connection was lost already
  422. if not Connected then
  423. (cursor as TODBCCursor).FSTMTHandle:=SQL_NULL_HSTMT;
  424. FreeAndNil(cursor); // the destructor of TODBCCursor frees the ODBC Statement handle
  425. end;
  426. function TODBCConnection.AllocateTransactionHandle: TSQLHandle;
  427. begin
  428. Result:=nil; // not yet supported; will move connection handles to transaction handles later
  429. end;
  430. procedure TODBCConnection.PrepareStatement(cursor: TSQLCursor; ATransaction: TSQLTransaction; buf: string; AParams: TParams);
  431. var
  432. ODBCCursor:TODBCCursor;
  433. begin
  434. ODBCCursor:=cursor as TODBCCursor;
  435. // Parameter handling
  436. // Note: We can only pass ? parameters to ODBC, so we should convert named parameters like :MyID
  437. // ODBCCursor.FParamIndex will map th i-th ? token in the (modified) query to an index for AParams
  438. // Parse the SQL and build FParamIndex
  439. if assigned(AParams) and (AParams.count > 0) then
  440. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  441. buf := AParams.ParseSQL(buf,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psInterbase,ODBCCursor.FParamIndex);
  442. {$ELSE}
  443. buf := AParams.ParseSQL(buf,false,psInterbase,ODBCCursor.FParamIndex);
  444. {$ENDIF}
  445. // prepare statement
  446. ODBCCheckResult(
  447. SQLPrepare(ODBCCursor.FSTMTHandle, PChar(buf), Length(buf)),
  448. SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not prepare statement.'
  449. );
  450. ODBCCursor.FQuery:=Buf;
  451. end;
  452. procedure TODBCConnection.UnPrepareStatement(cursor: TSQLCursor);
  453. begin
  454. // not necessary in ODBC
  455. end;
  456. function TODBCConnection.GetTransactionHandle(trans: TSQLHandle): pointer;
  457. begin
  458. // Tranactions not implemented yet
  459. end;
  460. function TODBCConnection.StartDBTransaction(trans: TSQLHandle; AParams:string): boolean;
  461. begin
  462. // Tranactions not implemented yet
  463. end;
  464. function TODBCConnection.Commit(trans: TSQLHandle): boolean;
  465. begin
  466. // Tranactions not implemented yet
  467. end;
  468. function TODBCConnection.Rollback(trans: TSQLHandle): boolean;
  469. begin
  470. // Tranactions not implemented yet
  471. end;
  472. procedure TODBCConnection.CommitRetaining(trans: TSQLHandle);
  473. begin
  474. // Tranactions not implemented yet
  475. end;
  476. procedure TODBCConnection.RollbackRetaining(trans: TSQLHandle);
  477. begin
  478. // Tranactions not implemented yet
  479. end;
  480. procedure TODBCConnection.Execute(cursor: TSQLCursor; ATransaction: TSQLTransaction; AParams: TParams);
  481. var
  482. ODBCCursor:TODBCCursor;
  483. begin
  484. ODBCCursor:=cursor as TODBCCursor;
  485. // set parameters
  486. if Assigned(APArams) and (AParams.count > 0) then SetParameters(ODBCCursor, AParams);
  487. // execute the statement
  488. ODBCCheckResult(
  489. SQLExecute(ODBCCursor.FSTMTHandle),
  490. SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not execute statement.'
  491. );
  492. // free parameter buffers
  493. FreeParamBuffers(ODBCCursor);
  494. end;
  495. function TODBCConnection.Fetch(cursor: TSQLCursor): boolean;
  496. var
  497. ODBCCursor:TODBCCursor;
  498. Res:SQLRETURN;
  499. begin
  500. ODBCCursor:=cursor as TODBCCursor;
  501. // fetch new row
  502. Res:=SQLFetch(ODBCCursor.FSTMTHandle);
  503. if Res<>SQL_NO_DATA then
  504. ODBCCheckResult(Res,SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not fetch new row from result set.');
  505. // result is true iff a new row was available
  506. Result:=Res<>SQL_NO_DATA;
  507. end;
  508. const
  509. DEFAULT_BLOB_BUFFER_SIZE = 1024;
  510. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  511. function TODBCConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer; out CreateBlob : boolean): boolean;
  512. {$ELSE}
  513. function TODBCConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer):boolean;
  514. {$ENDIF}
  515. var
  516. ODBCCursor:TODBCCursor;
  517. StrLenOrInd:SQLINTEGER;
  518. ODBCDateStruct:SQL_DATE_STRUCT;
  519. ODBCTimeStruct:SQL_TIME_STRUCT;
  520. ODBCTimeStampStruct:SQL_TIMESTAMP_STRUCT;
  521. DateTime:TDateTime;
  522. {$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
  523. BlobBuffer:pointer;
  524. BlobBufferSize,BytesRead:SQLINTEGER;
  525. BlobMemoryStream:TMemoryStream;
  526. {$ENDIF}
  527. Res:SQLRETURN;
  528. begin
  529. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  530. CreateBlob := False;
  531. {$ENDIF}
  532. ODBCCursor:=cursor as TODBCCursor;
  533. // load the field using SQLGetData
  534. // Note: optionally we can implement the use of SQLBindCol later for even more speed
  535. // TODO: finish this
  536. case FieldDef.DataType of
  537. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  538. ftGuid,ftWideString,ftFixedWideChar,
  539. {$ENDIF}
  540. ftFixedChar,ftString: // are mapped to a TStringField (including TGuidField, TWideStringField)
  541. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size, @StrLenOrInd);
  542. ftSmallint: // mapped to TSmallintField
  543. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SSHORT, buffer, SizeOf(Smallint), @StrLenOrInd);
  544. ftInteger,ftWord: // mapped to TLongintField
  545. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SLONG, buffer, SizeOf(Longint), @StrLenOrInd);
  546. ftLargeint: // mapped to TLargeintField
  547. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SBIGINT, buffer, SizeOf(Largeint), @StrLenOrInd);
  548. ftFloat: // mapped to TFloatField
  549. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_DOUBLE, buffer, SizeOf(Double), @StrLenOrInd);
  550. ftTime: // mapped to TTimeField
  551. begin
  552. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_TYPE_TIME, @ODBCTimeStruct, SizeOf(SQL_TIME_STRUCT), @StrLenOrInd);
  553. if StrLenOrInd<>SQL_NULL_DATA then
  554. begin
  555. DateTime:=TimeStructToDateTime(@ODBCTimeStruct);
  556. Move(DateTime, buffer^, SizeOf(TDateTime));
  557. end;
  558. end;
  559. ftDate: // mapped to TDateField
  560. begin
  561. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_TYPE_DATE, @ODBCDateStruct, SizeOf(SQL_DATE_STRUCT), @StrLenOrInd);
  562. if StrLenOrInd<>SQL_NULL_DATA then
  563. begin
  564. DateTime:=DateStructToDateTime(@ODBCDateStruct);
  565. Move(DateTime, buffer^, SizeOf(TDateTime));
  566. end;
  567. end;
  568. ftDateTime: // mapped to TDateTimeField
  569. begin
  570. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_TYPE_TIMESTAMP, @ODBCTimeStampStruct, SizeOf(SQL_TIMESTAMP_STRUCT), @StrLenOrInd);
  571. if StrLenOrInd<>SQL_NULL_DATA then
  572. begin
  573. DateTime:=TimeStampStructToDateTime(@ODBCTimeStampStruct);
  574. Move(DateTime, buffer^, SizeOf(TDateTime));
  575. end;
  576. end;
  577. ftBoolean: // mapped to TBooleanField
  578. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BIT, buffer, SizeOf(Wordbool), @StrLenOrInd);
  579. ftBytes: // mapped to TBytesField
  580. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, FieldDef.Size, @StrLenOrInd);
  581. ftVarBytes: // mapped to TVarBytesField
  582. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, FieldDef.Size, @StrLenOrInd);
  583. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  584. ftWideMemo,
  585. {$ENDIF}
  586. ftBlob, ftMemo: // BLOBs
  587. begin
  588. //Writeln('BLOB');
  589. // Try to discover BLOB data length
  590. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, 0, @StrLenOrInd);
  591. ODBCCheckResult(Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get field data for field "%s" (index %d).',[FieldDef.Name, FieldDef.Index+1]);
  592. // Read the data if not NULL
  593. if StrLenOrInd<>SQL_NULL_DATA then
  594. begin
  595. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  596. CreateBlob:=true; // defer actual loading of blob data to LoadBlobIntoBuffer method
  597. //WriteLn('Deferring loading of blob of length ',StrLenOrInd);
  598. {$ELSE}
  599. // Determine size of buffer to use
  600. if StrLenOrInd<>SQL_NO_TOTAL then
  601. BlobBufferSize:=StrLenOrInd
  602. else
  603. BlobBufferSize:=DEFAULT_BLOB_BUFFER_SIZE;
  604. try
  605. // init BlobBuffer and BlobMemoryStream to nil pointers
  606. BlobBuffer:=nil;
  607. BlobMemoryStream:=nil;
  608. if BlobBufferSize>0 then // Note: zero-length BLOB is represented as nil pointer in the field buffer to save memory usage
  609. begin
  610. // Allocate the buffer and memorystream
  611. BlobBuffer:=GetMem(BlobBufferSize);
  612. BlobMemoryStream:=TMemoryStream.Create;
  613. // Retrieve data in parts (or effectively in one part if StrLenOrInd<>SQL_NO_TOTAL above)
  614. repeat
  615. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, BlobBuffer, BlobBufferSize, @StrLenOrInd);
  616. ODBCCheckResult(Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get field data for field "%s" (index %d).',[FieldDef.Name, FieldDef.Index+1]);
  617. // Append data in buffer to memorystream
  618. if (StrLenOrInd=SQL_NO_TOTAL) or (StrLenOrInd>BlobBufferSize) then
  619. BytesRead:=BlobBufferSize
  620. else
  621. BytesRead:=StrLenOrInd;
  622. BlobMemoryStream.Write(BlobBuffer^, BytesRead);
  623. until Res=SQL_SUCCESS;
  624. end;
  625. // Store memorystream pointer in Field buffer and in the cursor's FBlobStreams list
  626. TObject(buffer^):=BlobMemoryStream;
  627. if BlobMemoryStream<>nil then
  628. ODBCCursor.FBlobStreams.Add(BlobMemoryStream);
  629. // Set BlobMemoryStream to nil, so it won't get freed in the finally block below
  630. BlobMemoryStream:=nil;
  631. finally
  632. BlobMemoryStream.Free;
  633. if BlobBuffer<>nil then
  634. Freemem(BlobBuffer,BlobBufferSize);
  635. end;
  636. {$ENDIF}
  637. end;
  638. end;
  639. // TODO: Loading of other field types
  640. else
  641. raise EODBCException.CreateFmt('Tried to load field of unsupported field type %s',[Fieldtypenames[FieldDef.DataType]]);
  642. end;
  643. ODBCCheckResult(Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get field data for field "%s" (index %d).',[FieldDef.Name, FieldDef.Index+1]);
  644. Result:=StrLenOrInd<>SQL_NULL_DATA; // Result indicates whether the value is non-null
  645. //writeln(Format('Field.Size: %d; StrLenOrInd: %d',[FieldDef.Size, StrLenOrInd]));
  646. end;
  647. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  648. procedure TODBCConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
  649. var
  650. ODBCCursor: TODBCCursor;
  651. Res: SQLRETURN;
  652. StrLenOrInd:SQLINTEGER;
  653. BlobBuffer:pointer;
  654. BlobBufferSize,BytesRead:SQLINTEGER;
  655. BlobMemoryStream:TMemoryStream;
  656. begin
  657. ODBCCursor:=cursor as TODBCCursor;
  658. // Try to discover BLOB data length
  659. // NB MS ODBC requires that TargetValuePtr is not nil, so we supply it with a valid pointer, even though BufferLength is 0
  660. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, @BlobBuffer, 0, @StrLenOrInd);
  661. ODBCCheckResult(Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get field data for field "%s" (index %d).',[FieldDef.Name, FieldDef.Index+1]);
  662. // Read the data if not NULL
  663. if StrLenOrInd<>SQL_NULL_DATA then
  664. begin
  665. // Determine size of buffer to use
  666. if StrLenOrInd<>SQL_NO_TOTAL then begin
  667. // Size is known on beforehand
  668. // set size & alloc buffer
  669. //WriteLn('Loading blob of length ',StrLenOrInd);
  670. BlobBufferSize:=StrLenOrInd;
  671. ABlobBuf^.BlobBuffer^.Size:=BlobBufferSize;
  672. ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer, BlobBufferSize);
  673. // get blob data
  674. if BlobBufferSize>0 then begin
  675. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, ABlobBuf^.BlobBuffer^.Buffer, BlobBufferSize, @StrLenOrInd);
  676. ODBCCheckResult(Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not load blob data for field "%s" (index %d).',[FieldDef.Name, FieldDef.Index+1]);
  677. end;
  678. end else begin
  679. // Size is not known on beforehand; read data in chuncks; write to a TMemoryStream (which implements O(n) writing)
  680. BlobBufferSize:=DEFAULT_BLOB_BUFFER_SIZE;
  681. // init BlobBuffer and BlobMemoryStream to nil pointers
  682. BlobBuffer:=nil; // the buffer that will hold the chuncks of data; not to be confused with ABlobBuf^.BlobBuffer
  683. BlobMemoryStream:=nil;
  684. try
  685. // Allocate the buffer and memorystream
  686. BlobBuffer:=GetMem(BlobBufferSize);
  687. BlobMemoryStream:=TMemoryStream.Create;
  688. // Retrieve data in parts
  689. repeat
  690. Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, BlobBuffer, BlobBufferSize, @StrLenOrInd);
  691. ODBCCheckResult(Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not load (partial) blob data for field "%s" (index %d).',[FieldDef.Name, FieldDef.Index+1]);
  692. // Append data in buffer to memorystream
  693. if (StrLenOrInd=SQL_NO_TOTAL) or (StrLenOrInd>BlobBufferSize) then
  694. BytesRead:=BlobBufferSize
  695. else
  696. BytesRead:=StrLenOrInd;
  697. BlobMemoryStream.Write(BlobBuffer^, BytesRead);
  698. until Res=SQL_SUCCESS;
  699. // Copy memory stream data to ABlobBuf^.BlobBuffer
  700. BlobBufferSize:=BlobMemoryStream.Size; // actual blob size
  701. // alloc ABlobBuf^.BlobBuffer
  702. ABlobBuf^.BlobBuffer^.Size:=BlobBufferSize;
  703. ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer, BlobBufferSize);
  704. // read memory stream data into ABlobBuf^.BlobBuffer
  705. BlobMemoryStream.Position:=0;
  706. BlobMemoryStream.Read(ABlobBuf^.BlobBuffer^.Buffer^, BlobBufferSize);
  707. finally
  708. // free buffer and memory stream
  709. BlobMemoryStream.Free;
  710. if BlobBuffer<>nil then
  711. Freemem(BlobBuffer,BlobBufferSize);
  712. end;
  713. end;
  714. end;
  715. end;
  716. {$ELSE}
  717. function TODBCConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  718. var
  719. ODBCCursor: TODBCCursor;
  720. BlobMemoryStream, BlobMemoryStreamCopy: TMemoryStream;
  721. begin
  722. if (Mode=bmRead) and not Field.IsNull then
  723. begin
  724. Field.GetData(@BlobMemoryStream);
  725. BlobMemoryStreamCopy:=TMemoryStream.Create;
  726. if BlobMemoryStream<>nil then
  727. BlobMemoryStreamCopy.LoadFromStream(BlobMemoryStream);
  728. Result:=BlobMemoryStreamCopy;
  729. end
  730. else
  731. Result:=nil;
  732. end;
  733. {$ENDIF}
  734. procedure TODBCConnection.FreeFldBuffers(cursor: TSQLCursor);
  735. var
  736. ODBCCursor:TODBCCursor;
  737. {$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
  738. i: integer;
  739. {$ENDIF}
  740. begin
  741. ODBCCursor:=cursor as TODBCCursor;
  742. {$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
  743. // Free TMemoryStreams in cursor.FBlobStreams and clear it
  744. for i:=0 to ODBCCursor.FBlobStreams.Count-1 do
  745. TObject(ODBCCursor.FBlobStreams[i]).Free;
  746. ODBCCursor.FBlobStreams.Clear;
  747. {$ENDIF}
  748. ODBCCheckResult(
  749. SQLFreeStmt(ODBCCursor.FSTMTHandle, SQL_CLOSE),
  750. SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not close ODBC statement cursor.'
  751. );
  752. end;
  753. procedure TODBCConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);
  754. const
  755. ColNameDefaultLength = 40; // should be > 0, because an ansistring of length 0 is a nil pointer instead of a pointer to a #0
  756. TypeNameDefaultLength = 80; // idem
  757. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  758. BLOB_BUF_SIZE = 0;
  759. {$ELSE}
  760. BLOB_BUF_SIZE = sizeof(pointer);
  761. {$ENDIF}
  762. var
  763. ODBCCursor:TODBCCursor;
  764. ColumnCount:SQLSMALLINT;
  765. i:integer;
  766. ColNameLength,TypeNameLength,DataType,DecimalDigits,Nullable:SQLSMALLINT;
  767. ColumnSize:SQLUINTEGER;
  768. ColName,TypeName:string;
  769. FieldType:TFieldType;
  770. FieldSize:word;
  771. begin
  772. ODBCCursor:=cursor as TODBCCursor;
  773. // get number of columns in result set
  774. ODBCCheckResult(
  775. SQLNumResultCols(ODBCCursor.FSTMTHandle, ColumnCount),
  776. SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not determine number of columns in result set.'
  777. );
  778. for i:=1 to ColumnCount do
  779. begin
  780. SetLength(ColName,ColNameDefaultLength); // also garantuees uniqueness
  781. // call with default column name buffer
  782. ODBCCheckResult(
  783. SQLDescribeCol(ODBCCursor.FSTMTHandle, // statement handle
  784. i, // column number, is 1-based (Note: column 0 is the bookmark column in ODBC)
  785. @(ColName[1]), // default buffer
  786. ColNameDefaultLength+1, // and its length; we include the #0 terminating any ansistring of Length > 0 in the buffer
  787. ColNameLength, // actual column name length
  788. DataType, // the SQL datatype for the column
  789. ColumnSize, // column size
  790. DecimalDigits, // number of decimal digits
  791. Nullable), // SQL_NO_NULLS, SQL_NULLABLE or SQL_NULLABLE_UNKNOWN
  792. SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get column properties for column %d.',[i]
  793. );
  794. // truncate buffer or make buffer long enough for entire column name (note: the call is the same for both cases!)
  795. SetLength(ColName,ColNameLength);
  796. // check whether entire column name was returned
  797. if ColNameLength>ColNameDefaultLength then
  798. begin
  799. // request column name with buffer that is long enough
  800. ODBCCheckResult(
  801. SQLColAttribute(ODBCCursor.FSTMTHandle, // statement handle
  802. i, // column number
  803. SQL_DESC_NAME, // the column name or alias
  804. @(ColName[1]), // buffer
  805. ColNameLength+1, // buffer size
  806. @ColNameLength, // actual length
  807. nil), // no numerical output
  808. SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get column name for column %d.',[i]
  809. );
  810. end;
  811. // convert type
  812. // NOTE: I made some guesses here after I found only limited information about TFieldType; please report any problems
  813. case DataType of
  814. SQL_CHAR: begin FieldType:=ftFixedChar; FieldSize:=ColumnSize+1; end;
  815. SQL_VARCHAR: begin FieldType:=ftString; FieldSize:=ColumnSize+1; end;
  816. SQL_LONGVARCHAR: begin FieldType:=ftMemo; FieldSize:=BLOB_BUF_SIZE; end; // is a blob
  817. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  818. SQL_WCHAR: begin FieldType:=ftWideString; FieldSize:=ColumnSize+1; end; // NB if TFieldDef.Size should be nr. of characters, then we should change this
  819. SQL_WVARCHAR: begin FieldType:=ftWideString; FieldSize:=ColumnSize+1; end;
  820. SQL_WLONGVARCHAR: begin FieldType:=ftWideMemo; FieldSize:=BLOB_BUF_SIZE; end; // is a blob
  821. {$ENDIF}
  822. SQL_DECIMAL: begin FieldType:=ftFloat; FieldSize:=0; end;
  823. SQL_NUMERIC: begin FieldType:=ftFloat; FieldSize:=0; end;
  824. SQL_SMALLINT: begin FieldType:=ftSmallint; FieldSize:=0; end;
  825. SQL_INTEGER: begin FieldType:=ftInteger; FieldSize:=0; end;
  826. SQL_REAL: begin FieldType:=ftFloat; FieldSize:=0; end;
  827. SQL_FLOAT: begin FieldType:=ftFloat; FieldSize:=0; end;
  828. SQL_DOUBLE: begin FieldType:=ftFloat; FieldSize:=0; end;
  829. SQL_BIT: begin FieldType:=ftBoolean; FieldSize:=0; end;
  830. SQL_TINYINT: begin FieldType:=ftSmallint; FieldSize:=0; end;
  831. SQL_BIGINT: begin FieldType:=ftLargeint; FieldSize:=0; end;
  832. SQL_BINARY: begin FieldType:=ftBytes; FieldSize:=ColumnSize; end;
  833. SQL_VARBINARY: begin FieldType:=ftVarBytes; FieldSize:=ColumnSize; end;
  834. SQL_LONGVARBINARY: begin FieldType:=ftBlob; FieldSize:=BLOB_BUF_SIZE; end; // is a blob
  835. SQL_TYPE_DATE: begin FieldType:=ftDate; FieldSize:=0; end;
  836. SQL_TYPE_TIME: begin FieldType:=ftTime; FieldSize:=0; end;
  837. SQL_TYPE_TIMESTAMP:begin FieldType:=ftDateTime; FieldSize:=0; end;
  838. { SQL_TYPE_UTCDATETIME:FieldType:=ftUnknown;}
  839. { SQL_TYPE_UTCTIME: FieldType:=ftUnknown;}
  840. { SQL_INTERVAL_MONTH: FieldType:=ftUnknown;}
  841. { SQL_INTERVAL_YEAR: FieldType:=ftUnknown;}
  842. { SQL_INTERVAL_YEAR_TO_MONTH: FieldType:=ftUnknown;}
  843. { SQL_INTERVAL_DAY: FieldType:=ftUnknown;}
  844. { SQL_INTERVAL_HOUR: FieldType:=ftUnknown;}
  845. { SQL_INTERVAL_MINUTE: FieldType:=ftUnknown;}
  846. { SQL_INTERVAL_SECOND: FieldType:=ftUnknown;}
  847. { SQL_INTERVAL_DAY_TO_HOUR: FieldType:=ftUnknown;}
  848. { SQL_INTERVAL_DAY_TO_MINUTE: FieldType:=ftUnknown;}
  849. { SQL_INTERVAL_DAY_TO_SECOND: FieldType:=ftUnknown;}
  850. { SQL_INTERVAL_HOUR_TO_MINUTE: FieldType:=ftUnknown;}
  851. { SQL_INTERVAL_HOUR_TO_SECOND: FieldType:=ftUnknown;}
  852. { SQL_INTERVAL_MINUTE_TO_SECOND:FieldType:=ftUnknown;}
  853. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  854. SQL_GUID: begin FieldType:=ftGuid; FieldSize:=ColumnSize+1; end;
  855. {$ENDIF}
  856. else
  857. begin FieldType:=ftUnknown; FieldSize:=ColumnSize; end
  858. end;
  859. if (FieldType in [ftString,ftFixedChar]) and // field types mapped to TStringField
  860. (FieldSize >= dsMaxStringSize) then
  861. begin
  862. FieldSize:=dsMaxStringSize-1;
  863. end;
  864. if FieldType=ftUnknown then // if unknown field type encountered, try finding more specific information about the ODBC SQL DataType
  865. begin
  866. SetLength(TypeName,TypeNameDefaultLength); // also garantuees uniqueness
  867. ODBCCheckResult(
  868. SQLColAttribute(ODBCCursor.FSTMTHandle, // statement handle
  869. i, // column number
  870. SQL_DESC_TYPE_NAME, // FieldIdentifier indicating the datasource dependent data type name (useful for diagnostics)
  871. @(TypeName[1]), // default buffer
  872. TypeNameDefaultLength+1, // and its length; we include the #0 terminating any ansistring of Length > 0 in the buffer
  873. @TypeNameLength, // actual type name length
  874. nil // no need for a pointer to return a numeric attribute at
  875. ),
  876. SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get datasource dependent type name for column %s.',[ColName]
  877. );
  878. // truncate buffer or make buffer long enough for entire column name (note: the call is the same for both cases!)
  879. SetLength(TypeName,TypeNameLength);
  880. // check whether entire column name was returned
  881. if TypeNameLength>TypeNameDefaultLength then
  882. begin
  883. // request column name with buffer that is long enough
  884. ODBCCheckResult(
  885. SQLColAttribute(ODBCCursor.FSTMTHandle, // statement handle
  886. i, // column number
  887. SQL_DESC_TYPE_NAME, // FieldIdentifier indicating the datasource dependent data type name (useful for diagnostics)
  888. @(TypeName[1]), // buffer
  889. TypeNameLength+1, // buffer size
  890. @TypeNameLength, // actual length
  891. nil), // no need for a pointer to return a numeric attribute at
  892. SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get datasource dependent type name for column %s.',[ColName]
  893. );
  894. end;
  895. DatabaseErrorFmt('Column %s has an unknown or unsupported column type. Datasource dependent type name: %s. ODBC SQL data type code: %d.', [ColName, TypeName, DataType]);
  896. end;
  897. // add FieldDef
  898. TFieldDef.Create(FieldDefs, ColName, FieldType, FieldSize, False, i);
  899. end;
  900. end;
  901. procedure TODBCConnection.UpdateIndexDefs(IndexDefs: TIndexDefs; TableName: string);
  902. var
  903. StmtHandle:SQLHSTMT;
  904. Res:SQLRETURN;
  905. IndexDef: TIndexDef;
  906. KeyFields, KeyName: String;
  907. // variables for binding
  908. NonUnique :SQLSMALLINT; NonUniqueIndOrLen :SQLINTEGER;
  909. IndexName :string; IndexNameIndOrLen :SQLINTEGER;
  910. _Type :SQLSMALLINT; _TypeIndOrLen :SQLINTEGER;
  911. OrdinalPos:SQLSMALLINT; OrdinalPosIndOrLen:SQLINTEGER;
  912. ColName :string; ColNameIndOrLen :SQLINTEGER;
  913. AscOrDesc :SQLCHAR; AscOrDescIndOrLen :SQLINTEGER;
  914. PKName :string; PKNameIndOrLen :SQLINTEGER;
  915. const
  916. DEFAULT_NAME_LEN = 255;
  917. begin
  918. // allocate statement handle
  919. StmtHandle := SQL_NULL_HANDLE;
  920. ODBCCheckResult(
  921. SQLAllocHandle(SQL_HANDLE_STMT, FDBCHandle, StmtHandle),
  922. SQL_HANDLE_DBC, FDBCHandle, 'Could not allocate ODBC Statement handle.'
  923. );
  924. try
  925. // Disabled: only works if we can specify a SchemaName and, if supported by the data source, a CatalogName
  926. // otherwise SQLPrimaryKeys returns error HY0009 (Invalid use of null pointer)
  927. // set the SQL_ATTR_METADATA_ID so parameters to Catalog functions are considered as identifiers (e.g. case-insensitive)
  928. //ODBCCheckResult(
  929. // SQLSetStmtAttr(StmtHandle, SQL_ATTR_METADATA_ID, SQLPOINTER(SQL_TRUE), SQL_IS_UINTEGER),
  930. // SQL_HANDLE_STMT, StmtHandle, 'Could not set SQL_ATTR_METADATA_ID statement attribute to SQL_TRUE.'
  931. //);
  932. // alloc result column buffers
  933. SetLength(ColName, DEFAULT_NAME_LEN);
  934. SetLength(PKName, DEFAULT_NAME_LEN);
  935. SetLength(IndexName,DEFAULT_NAME_LEN);
  936. // Fetch primary key info using SQLPrimaryKeys
  937. ODBCCheckResult(
  938. SQLPrimaryKeys(
  939. StmtHandle,
  940. nil, 0, // any catalog
  941. nil, 0, // any schema
  942. PChar(TableName), Length(TableName)
  943. ),
  944. SQL_HANDLE_STMT, StmtHandle, 'Could not retrieve primary key metadata for table %s using SQLPrimaryKeys.', [TableName]
  945. );
  946. // init key name & fields; we will set the IndexDefs.Option ixPrimary below when there is a match by IndexName=KeyName
  947. KeyName:='';
  948. KeyFields:='';
  949. try
  950. // bind result columns; the column numbers are documented in the reference for SQLStatistics
  951. ODBCCheckResult(SQLBindCol(StmtHandle, 4, SQL_C_CHAR , @ColName[1], Length(ColName)+1, @ColNameIndOrLen), SQL_HANDLE_STMT, StmtHandle, 'Could not bind primary key metadata column COLUMN_NAME.');
  952. ODBCCheckResult(SQLBindCol(StmtHandle, 5, SQL_C_SSHORT, @OrdinalPos, 0, @OrdinalPosIndOrLen), SQL_HANDLE_STMT, StmtHandle, 'Could not bind primary key metadata column KEY_SEQ.');
  953. ODBCCheckResult(SQLBindCol(StmtHandle, 6, SQL_C_CHAR , @PKName [1], Length(PKName )+1, @PKNameIndOrLen ), SQL_HANDLE_STMT, StmtHandle, 'Could not bind primary key metadata column PK_NAME.');
  954. // fetch result
  955. repeat
  956. // go to next row; loads data in bound columns
  957. Res:=SQLFetch(StmtHandle);
  958. // if no more row, break
  959. if Res=SQL_NO_DATA then
  960. Break;
  961. // handle data
  962. if ODBCSucces(Res) then begin
  963. if OrdinalPos=1 then begin
  964. KeyName:=PChar(@PKName[1]);
  965. KeyFields:= PChar(@ColName[1]);
  966. end else begin
  967. KeyFields:=KeyFields+';'+PChar(@ColName[1]);
  968. end;
  969. end else begin
  970. ODBCCheckResult(Res, SQL_HANDLE_STMT, StmtHandle, 'Could not fetch primary key metadata row.');
  971. end;
  972. until false;
  973. finally
  974. // unbind columns & close cursor
  975. ODBCCheckResult(SQLFreeStmt(StmtHandle, SQL_UNBIND), SQL_HANDLE_STMT, StmtHandle, 'Could not unbind columns.');
  976. ODBCCheckResult(SQLFreeStmt(StmtHandle, SQL_CLOSE), SQL_HANDLE_STMT, StmtHandle, 'Could not close cursor.');
  977. end;
  978. //WriteLn('KeyName: ',KeyName,'; KeyFields: ',KeyFields);
  979. // use SQLStatistics to get index information
  980. ODBCCheckResult(
  981. SQLStatistics(
  982. StmtHandle,
  983. nil, 0, // catalog unkown; request for all catalogs
  984. nil, 0, // schema unkown; request for all schemas
  985. PChar(TableName), Length(TableName), // request information for TableName
  986. SQL_INDEX_ALL,
  987. SQL_QUICK
  988. ),
  989. SQL_HANDLE_STMT, StmtHandle, 'Could not retrieve index metadata for table %s using SQLStatistics.', [TableName]
  990. );
  991. try
  992. // bind result columns; the column numbers are documented in the reference for SQLStatistics
  993. ODBCCheckResult(SQLBindCol(StmtHandle, 4, SQL_C_SSHORT, @NonUnique , 0, @NonUniqueIndOrLen ), SQL_HANDLE_STMT, StmtHandle, 'Could not bind index metadata column NON_UNIQUE.');
  994. ODBCCheckResult(SQLBindCol(StmtHandle, 6, SQL_C_CHAR , @IndexName[1], Length(IndexName)+1, @IndexNameIndOrLen), SQL_HANDLE_STMT, StmtHandle, 'Could not bind index metadata column INDEX_NAME.');
  995. ODBCCheckResult(SQLBindCol(StmtHandle, 7, SQL_C_SSHORT, @_Type , 0, @_TypeIndOrLen ), SQL_HANDLE_STMT, StmtHandle, 'Could not bind index metadata column TYPE.');
  996. ODBCCheckResult(SQLBindCol(StmtHandle, 8, SQL_C_SSHORT, @OrdinalPos, 0, @OrdinalPosIndOrLen), SQL_HANDLE_STMT, StmtHandle, 'Could not bind index metadata column ORDINAL_POSITION.');
  997. ODBCCheckResult(SQLBindCol(StmtHandle, 9, SQL_C_CHAR , @ColName [1], Length(ColName )+1, @ColNameIndOrLen ), SQL_HANDLE_STMT, StmtHandle, 'Could not bind index metadata column COLUMN_NAME.');
  998. ODBCCheckResult(SQLBindCol(StmtHandle, 10, SQL_C_CHAR , @AscOrDesc , 1, @AscOrDescIndOrLen ), SQL_HANDLE_STMT, StmtHandle, 'Could not bind index metadata column ASC_OR_DESC.');
  999. // clear index defs
  1000. IndexDefs.Clear;
  1001. IndexDef:=nil;
  1002. // fetch result
  1003. repeat
  1004. // go to next row; loads data in bound columns
  1005. Res:=SQLFetch(StmtHandle);
  1006. // if no more row, break
  1007. if Res=SQL_NO_DATA then
  1008. Break;
  1009. // handle data
  1010. if ODBCSucces(Res) then begin
  1011. // note: SQLStatistics not only returns index info, but also statistics; we skip the latter
  1012. if _Type<>SQL_TABLE_STAT then begin
  1013. if (OrdinalPos=1) or not Assigned(IndexDef) then begin
  1014. // create new IndexDef iff OrdinalPos=1 or not Assigned(IndexDef) (the latter should not occur though)
  1015. IndexDef:=IndexDefs.AddIndexDef;
  1016. IndexDef.Name:=PChar(@IndexName[1]); // treat ansistring as zero terminated string
  1017. IndexDef.Fields:=PChar(@ColName[1]);
  1018. if NonUnique=SQL_FALSE then
  1019. IndexDef.Options:=IndexDef.Options+[ixUnique];
  1020. if (AscOrDescIndOrLen<>SQL_NULL_DATA) and (AscOrDesc='D') then
  1021. IndexDef.Options:=IndexDef.Options+[ixDescending];
  1022. if IndexDef.Name=KeyName then
  1023. IndexDef.Options:=IndexDef.Options+[ixPrimary];
  1024. // TODO: figure out how we can tell whether COLUMN_NAME is an expression or not
  1025. // if it is an expression, we should include ixExpression in Options and set Expression to ColName
  1026. end else // NB we re-use the last IndexDef
  1027. IndexDef.Fields:=IndexDef.Fields+';'+PChar(@ColName[1]); // NB ; is the separator to be used for IndexDef.Fields
  1028. end;
  1029. end else begin
  1030. ODBCCheckResult(Res, SQL_HANDLE_STMT, StmtHandle, 'Could not fetch index metadata row.');
  1031. end;
  1032. until false;
  1033. finally
  1034. // unbind columns & close cursor
  1035. ODBCCheckResult(SQLFreeStmt(StmtHandle, SQL_UNBIND), SQL_HANDLE_STMT, StmtHandle, 'Could not unbind columns.');
  1036. ODBCCheckResult(SQLFreeStmt(StmtHandle, SQL_CLOSE), SQL_HANDLE_STMT, StmtHandle, 'Could not close cursor.');
  1037. end;
  1038. finally
  1039. if StmtHandle<>SQL_NULL_HANDLE then begin
  1040. // Free the statement handle
  1041. Res:=SQLFreeHandle(SQL_HANDLE_STMT, StmtHandle);
  1042. if Res=SQL_ERROR then
  1043. ODBCCheckResult(Res, SQL_HANDLE_STMT, STMTHandle, 'Could not free ODBC Statement handle.');
  1044. end;
  1045. end;
  1046. end;
  1047. function TODBCConnection.GetSchemaInfoSQL(SchemaType: TSchemaType; SchemaObjectName, SchemaObjectPattern: string): string;
  1048. begin
  1049. Result:=inherited GetSchemaInfoSQL(SchemaType, SchemaObjectName, SchemaObjectPattern);
  1050. // TODO: implement this
  1051. end;
  1052. { TODBCEnvironment }
  1053. constructor TODBCEnvironment.Create;
  1054. begin
  1055. // make sure odbc is loaded
  1056. if ODBCLoadCount=0 then InitialiseOdbc;
  1057. Inc(ODBCLoadCount);
  1058. // allocate environment handle
  1059. if SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, FENVHandle)=SQL_Error then
  1060. raise EODBCException.Create('Could not allocate ODBC Environment handle'); // we can't retrieve any more information, because we don't have a handle for the SQLGetDiag* functions
  1061. // set odbc version
  1062. ODBCCheckResult(
  1063. SQLSetEnvAttr(FENVHandle, SQL_ATTR_ODBC_VERSION, SQLPOINTER(SQL_OV_ODBC3), 0),
  1064. SQL_HANDLE_ENV, FENVHandle,'Could not set ODBC version to 3.'
  1065. );
  1066. end;
  1067. destructor TODBCEnvironment.Destroy;
  1068. var
  1069. Res:SQLRETURN;
  1070. begin
  1071. // free environment handle
  1072. Res:=SQLFreeHandle(SQL_HANDLE_ENV, FENVHandle);
  1073. if Res=SQL_ERROR then
  1074. ODBCCheckResult(Res,SQL_HANDLE_ENV, FENVHandle, 'Could not free ODBC Environment handle.');
  1075. // free odbc if not used by any TODBCEnvironment object anymore
  1076. Dec(ODBCLoadCount);
  1077. if ODBCLoadCount=0 then ReleaseOdbc;
  1078. end;
  1079. { TODBCCursor }
  1080. constructor TODBCCursor.Create(Connection:TODBCConnection);
  1081. begin
  1082. // allocate statement handle
  1083. ODBCCheckResult(
  1084. SQLAllocHandle(SQL_HANDLE_STMT, Connection.FDBCHandle, FSTMTHandle),
  1085. SQL_HANDLE_DBC, Connection.FDBCHandle, 'Could not allocate ODBC Statement handle.'
  1086. );
  1087. {$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
  1088. // allocate FBlobStreams
  1089. FBlobStreams:=TList.Create;
  1090. {$ENDIF}
  1091. end;
  1092. destructor TODBCCursor.Destroy;
  1093. var
  1094. Res:SQLRETURN;
  1095. begin
  1096. inherited Destroy;
  1097. {$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
  1098. FBlobStreams.Free;
  1099. {$ENDIF}
  1100. if FSTMTHandle<>SQL_NULL_HSTMT then
  1101. begin
  1102. // deallocate statement handle
  1103. Res:=SQLFreeHandle(SQL_HANDLE_STMT, FSTMTHandle);
  1104. if Res=SQL_ERROR then
  1105. ODBCCheckResult(Res,SQL_HANDLE_STMT, FSTMTHandle, 'Could not free ODBC Statement handle.');
  1106. end;
  1107. end;
  1108. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  1109. class function TODBCConnectionDef.TypeName: String;
  1110. begin
  1111. Result:='ODBC';
  1112. end;
  1113. class function TODBCConnectionDef.ConnectionClass: TSQLConnectionClass;
  1114. begin
  1115. Result:=TODBCConnection;
  1116. end;
  1117. class function TODBCConnectionDef.Description: String;
  1118. begin
  1119. Result:='Connect to any database via an ODBC driver';
  1120. end;
  1121. initialization
  1122. RegisterConnection(TODBCConnectionDef);
  1123. {$ENDIF}
  1124. finalization
  1125. {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
  1126. UnRegisterConnection(TODBCConnectionDef);
  1127. {$ENDIF}
  1128. if Assigned(DefaultEnvironment) then
  1129. DefaultEnvironment.Free;
  1130. end.