odbcconn.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749
  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, odbcsql;
  16. type
  17. // forward declarations
  18. TODBCConnection = class;
  19. { TODBCCursor }
  20. TODBCCursor = class(TSQLCursor)
  21. protected
  22. FSTMTHandle:SQLHSTMT; // ODBC Statement Handle
  23. FQuery:string; // last prepared query, with :ParamName converted to ?
  24. FParamIndex:TParamBinding; // maps the i-th parameter in the query to the TParams passed to PrepareStatement
  25. FParamBuf:array of pointer; // buffers that can be used to bind the i-th parameter in the query
  26. public
  27. constructor Create(Connection:TODBCConnection);
  28. destructor Destroy; override;
  29. end;
  30. { TODBCHandle } // this name is a bit confusing, but follows the standards for naming classes in sqldb
  31. TODBCHandle = class(TSQLHandle)
  32. protected
  33. end;
  34. { TODBCEnvironment }
  35. TODBCEnvironment = class
  36. protected
  37. FENVHandle:SQLHENV; // ODBC Environment Handle
  38. public
  39. constructor Create;
  40. destructor Destroy; override;
  41. end;
  42. { TODBCConnection }
  43. TODBCConnection = class(TSQLConnection)
  44. private
  45. FDriver: string;
  46. FEnvironment:TODBCEnvironment;
  47. FDBCHandle:SQLHDBC; // ODBC Connection Handle
  48. FFileDSN: string;
  49. procedure SetParameters(ODBCCursor:TODBCCursor; AParams:TParams);
  50. procedure FreeParamBuffers(ODBCCursor:TODBCCursor);
  51. protected
  52. // Overrides from TSQLConnection
  53. function GetHandle:pointer; override;
  54. // - Connect/disconnect
  55. procedure DoInternalConnect; override;
  56. procedure DoInternalDisconnect; override;
  57. // - Handle (de)allocation
  58. function AllocateCursorHandle:TSQLCursor; override;
  59. procedure DeAllocateCursorHandle(var cursor:TSQLCursor); override;
  60. function AllocateTransactionHandle:TSQLHandle; override;
  61. // - Statement handling
  62. procedure PrepareStatement(cursor:TSQLCursor; ATransaction:TSQLTransaction; buf:string; AParams:TParams); override;
  63. procedure UnPrepareStatement(cursor:TSQLCursor); override;
  64. // - Transaction handling
  65. function GetTransactionHandle(trans:TSQLHandle):pointer; override;
  66. function StartDBTransaction(trans:TSQLHandle; AParams:string):boolean; override;
  67. function Commit(trans:TSQLHandle):boolean; override;
  68. function Rollback(trans:TSQLHandle):boolean; override;
  69. procedure CommitRetaining(trans:TSQLHandle); override;
  70. procedure RollbackRetaining(trans:TSQLHandle); override;
  71. // - Statement execution
  72. procedure Execute(cursor:TSQLCursor; ATransaction:TSQLTransaction; AParams:TParams); override;
  73. // - Result retrieving
  74. procedure AddFieldDefs(cursor:TSQLCursor; FieldDefs:TFieldDefs); override;
  75. function Fetch(cursor:TSQLCursor):boolean; override;
  76. function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer):boolean; override;
  77. function CreateBlobStream(Field:TField; Mode:TBlobStreamMode):TStream; override;
  78. procedure FreeFldBuffers(cursor:TSQLCursor); override;
  79. // - UpdateIndexDefs
  80. procedure UpdateIndexDefs(var IndexDefs:TIndexDefs; TableName:string); override;
  81. // - Schema info
  82. function GetSchemaInfoSQL(SchemaType:TSchemaType; SchemaObjectName, SchemaObjectPattern:string):string; override;
  83. // Internal utility functions
  84. function CreateConnectionString:string;
  85. public
  86. property Environment:TODBCEnvironment read FEnvironment;
  87. published
  88. property Driver:string read FDriver write FDriver; // will be passed as DRIVER connection parameter
  89. property FileDSN:string read FFileDSN write FFileDSN; // will be passed as FILEDSN parameter
  90. // Redeclare properties from TSQLConnection
  91. property Password; // will be passed as PWD connection parameter
  92. property Transaction;
  93. property UserName; // will be passed as UID connection parameter
  94. property CharSet;
  95. property HostName; // ignored
  96. // Redeclare properties from TDatabase
  97. property Connected;
  98. property Role;
  99. property DatabaseName; // will be passed as DSN connection parameter
  100. property KeepConnection;
  101. property LoginPrompt; // if true, ODBC drivers might prompt for more details that are not in the connection string
  102. property Params; // will be added to connection string
  103. property OnLogin;
  104. end;
  105. EODBCException = class(Exception)
  106. // currently empty; perhaps we can add fields here later that describe the error instead of one simple message string
  107. end;
  108. implementation
  109. uses
  110. Math; // for the Min proc
  111. const
  112. DefaultEnvironment:TODBCEnvironment = nil;
  113. ODBCLoadCount:integer = 0; // ODBC is loaded when > 0; modified by TODBCEnvironment.Create/Destroy
  114. { Generic ODBC helper functions }
  115. function ODBCSucces(const Res:SQLRETURN):boolean;
  116. begin
  117. Result:=(Res=SQL_SUCCESS) or (Res=SQL_SUCCESS_WITH_INFO);
  118. end;
  119. function ODBCResultToStr(Res:SQLRETURN):string;
  120. begin
  121. case Res of
  122. SQL_SUCCESS: Result:='SQL_SUCCESS';
  123. SQL_SUCCESS_WITH_INFO:Result:='SQL_SUCCESS_WITH_INFO';
  124. SQL_ERROR: Result:='SQL_ERROR';
  125. SQL_INVALID_HANDLE: Result:='SQL_INVALID_HANDLE';
  126. SQL_NO_DATA: Result:='SQL_NO_DATA';
  127. SQL_NEED_DATA: Result:='SQL_NEED_DATA';
  128. SQL_STILL_EXECUTING: Result:='SQL_STILL_EXECUTING';
  129. else
  130. Result:='';
  131. end;
  132. end;
  133. procedure ODBCCheckResult(HandleType:SQLSMALLINT; AHandle: SQLHANDLE; ErrorMsg: string);
  134. // check return value from SQLGetDiagField/Rec function itself
  135. procedure CheckSQLGetDiagResult(const Res:SQLRETURN);
  136. begin
  137. case Res of
  138. SQL_INVALID_HANDLE:
  139. raise EODBCException.Create('Invalid handle passed to SQLGetDiagRec/Field');
  140. SQL_ERROR:
  141. raise EODBCException.Create('An invalid parameter was passed to SQLGetDiagRec/Field');
  142. SQL_NO_DATA:
  143. raise EODBCException.Create('A too large RecNumber was passed to SQLGetDiagRec/Field');
  144. end;
  145. end;
  146. var
  147. NativeError:SQLINTEGER;
  148. TextLength:SQLSMALLINT;
  149. Res,LastReturnCode:SQLRETURN;
  150. SqlState,MessageText,TotalMessage:string;
  151. RecNumber:SQLSMALLINT;
  152. begin
  153. // check result
  154. Res:=SQLGetDiagField(HandleType,AHandle,0,SQL_DIAG_RETURNCODE,@LastReturnCode,SQL_IS_SMALLINT,TextLength);
  155. CheckSQLGetDiagResult(Res);
  156. if ODBCSucces(LastReturnCode) then
  157. Exit; // no error; all is ok
  158. // build TotalMessage for exception to throw
  159. TotalMessage:=Format('%s ODBC error details:',[ErrorMsg]);
  160. // retrieve status records
  161. SetLength(SqlState,5); // SqlState buffer
  162. RecNumber:=1;
  163. repeat
  164. // dummy call to get correct TextLength
  165. Res:=SQLGetDiagRec(HandleType,AHandle,RecNumber,@(SqlState[1]),NativeError,@(SqlState[1]),0,TextLength);
  166. if Res=SQL_NO_DATA then
  167. Break; // no more status records
  168. CheckSQLGetDiagResult(Res);
  169. 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
  170. begin
  171. // allocate large enough buffer
  172. SetLength(MessageText,TextLength); // note: ansistrings of Length>0 are always terminated by a #0 character, so this is safe
  173. // actual call
  174. Res:=SQLGetDiagRec(HandleType,AHandle,RecNumber,@(SqlState[1]),NativeError,@(MessageText[1]),Length(MessageText)+1,TextLength);
  175. CheckSQLGetDiagResult(Res);
  176. end;
  177. // add to TotalMessage
  178. TotalMessage:=TotalMessage + Format(' Record %d: SqlState: %s; NativeError: %d; Message: %s;',[RecNumber,SqlState,NativeError,MessageText]);
  179. // incement counter
  180. Inc(RecNumber);
  181. until false;
  182. // raise error
  183. raise EODBCException.Create(TotalMessage);
  184. end;
  185. { TODBCConnection }
  186. // Creates a connection string using the current value of the fields
  187. function TODBCConnection.CreateConnectionString: string;
  188. // encloses a param value with braces if necessary, i.e. when any of the characters []{}(),;?*=!@ is in the value
  189. function EscapeParamValue(const s:string):string;
  190. var
  191. NeedEscape:boolean;
  192. i:integer;
  193. begin
  194. NeedEscape:=false;
  195. for i:=1 to Length(s) do
  196. if s[i] in ['[',']','{','}','(',')',',','*','=','!','@'] then
  197. begin
  198. NeedEscape:=true;
  199. Break;
  200. end;
  201. if NeedEscape then
  202. Result:='{'+s+'}'
  203. else
  204. Result:=s;
  205. end;
  206. var
  207. i: Integer;
  208. Param: string;
  209. EqualSignPos:integer;
  210. begin
  211. Result:='';
  212. if DatabaseName<>'' then Result:=Result + 'DSN='+EscapeParamValue(DatabaseName)+';';
  213. if Driver <>'' then Result:=Result + 'DRIVER='+EscapeParamValue(Driver)+';';
  214. if UserName <>'' then Result:=Result + 'UID='+EscapeParamValue(UserName)+';PWD='+EscapeParamValue(Password)+';';
  215. if FileDSN <>'' then Result:=Result + 'FILEDSN='+EscapeParamValue(FileDSN)+'';
  216. for i:=0 to Params.Count-1 do
  217. begin
  218. Param:=Params[i];
  219. EqualSignPos:=Pos('=',Param);
  220. if EqualSignPos=0 then
  221. raise EODBCException.CreateFmt('Invalid parameter in Params[%d]; can''t find a ''='' in ''%s''',[i, Param])
  222. else if EqualSignPos=1 then
  223. raise EODBCException.CreateFmt('Invalid parameter in Params[%d]; no identifier before the ''='' in ''%s''',[i, Param])
  224. else
  225. Result:=Result + EscapeParamValue(Copy(Param,1,EqualSignPos-1))+'='+EscapeParamValue(Copy(Param,EqualSignPos+1,MaxInt));
  226. end;
  227. end;
  228. procedure TODBCConnection.SetParameters(ODBCCursor: TODBCCursor; AParams: TParams);
  229. var
  230. ParamIndex:integer;
  231. Buf:pointer;
  232. I:integer;
  233. IntVal:longint;
  234. StrVal:string;
  235. StrLen:SQLINTEGER;
  236. begin
  237. // Note: it is assumed that AParams is the same as the one passed to PrepareStatement, in the sense that
  238. // the parameters have the same order and names
  239. if Length(ODBCCursor.FParamIndex)>0 then
  240. if not Assigned(AParams) then
  241. raise EODBCException.CreateFmt('The query has parameter markers in it, but no actual parameters were passed',[]);
  242. SetLength(ODBCCursor.FParamBuf, Length(ODBCCursor.FParamIndex));
  243. for i:=0 to High(ODBCCursor.FParamIndex) do
  244. begin
  245. ParamIndex:=ODBCCursor.FParamIndex[i];
  246. if (ParamIndex<0) or (ParamIndex>=AParams.Count) then
  247. raise EODBCException.CreateFmt('Parameter %d in query does not have a matching parameter set',[i]);
  248. case AParams[ParamIndex].DataType of
  249. ftInteger:
  250. begin
  251. Buf:=GetMem(4);
  252. IntVal:=AParams[ParamIndex].AsInteger;
  253. Move(IntVal,Buf^,4);
  254. ODBCCursor.FParamBuf[i]:=Buf;
  255. SQLBindParameter(ODBCCursor.FSTMTHandle, // StatementHandle
  256. i+1, // ParameterNumber
  257. SQL_PARAM_INPUT, // InputOutputType
  258. SQL_C_LONG, // ValueType
  259. SQL_INTEGER, // ParameterType
  260. 10, // ColumnSize
  261. 0, // DecimalDigits
  262. Buf, // ParameterValuePtr
  263. 0, // BufferLength
  264. nil); // StrLen_or_IndPtr
  265. ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not bind parameter %d',[i]));
  266. end;
  267. ftString:
  268. begin
  269. StrVal:=AParams[ParamIndex].AsString;
  270. StrLen:=Length(StrVal);
  271. Buf:=GetMem(SizeOf(SQLINTEGER)+StrLen);
  272. Move(StrLen, buf^, SizeOf(SQLINTEGER));
  273. Move(StrVal[1],(buf+SizeOf(SQLINTEGER))^,StrLen);
  274. ODBCCursor.FParamBuf[i]:=Buf;
  275. SQLBindParameter(ODBCCursor.FSTMTHandle, // StatementHandle
  276. i+1, // ParameterNumber
  277. SQL_PARAM_INPUT, // InputOutputType
  278. SQL_C_CHAR, // ValueType
  279. SQL_CHAR, // ParameterType
  280. StrLen, // ColumnSize
  281. 0, // DecimalDigits
  282. buf+SizeOf(SQLINTEGER), // ParameterValuePtr
  283. StrLen, // BufferLength
  284. Buf); // StrLen_or_IndPtr
  285. ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not bind parameter %d',[i]));
  286. end;
  287. else
  288. raise EDataBaseError.CreateFmt('Parameter %d is of type %s, which not supported yet',[ParamIndex, Fieldtypenames[AParams[ParamIndex].DataType]]);
  289. end;
  290. end;
  291. end;
  292. procedure TODBCConnection.FreeParamBuffers(ODBCCursor: TODBCCursor);
  293. var
  294. i:integer;
  295. begin
  296. for i:=0 to High(ODBCCursor.FParamBuf) do
  297. FreeMem(ODBCCursor.FParamBuf[i]);
  298. end;
  299. function TODBCConnection.GetHandle: pointer;
  300. begin
  301. // I'm not sure whether this is correct; perhaps we should return nil
  302. // note that FDBHandle is a LongInt, because ODBC handles are integers, not pointers
  303. // I wonder how this will work on 64 bit platforms then (FK)
  304. Result:=pointer(PtrInt(FDBCHandle));
  305. end;
  306. procedure TODBCConnection.DoInternalConnect;
  307. const
  308. BufferLength = 1024; // should be at least 1024 according to the ODBC specification
  309. var
  310. ConnectionString:string;
  311. OutConnectionString:string;
  312. ActualLength:SQLSMALLINT;
  313. begin
  314. inherited DoInternalConnect;
  315. // make sure we have an environment
  316. if not Assigned(FEnvironment) then
  317. begin
  318. if not Assigned(DefaultEnvironment) then
  319. DefaultEnvironment:=TODBCEnvironment.Create;
  320. FEnvironment:=DefaultEnvironment;
  321. end;
  322. // allocate connection handle
  323. SQLAllocHandle(SQL_HANDLE_DBC,Environment.FENVHandle,FDBCHandle);
  324. ODBCCheckResult(SQL_HANDLE_ENV,Environment.FENVHandle,'Could not allocate ODBC Connection handle.');
  325. // connect
  326. ConnectionString:=CreateConnectionString;
  327. SetLength(OutConnectionString,BufferLength-1); // allocate completed connection string buffer (using the ansistring #0 trick)
  328. SQLDriverConnect(FDBCHandle, // the ODBC connection handle
  329. nil, // no parent window (would be required for prompts)
  330. PChar(ConnectionString), // the connection string
  331. Length(ConnectionString), // connection string length
  332. @(OutConnectionString[1]),// buffer for storing the completed connection string
  333. BufferLength, // length of the buffer
  334. ActualLength, // the actual length of the completed connection string
  335. SQL_DRIVER_NOPROMPT); // don't prompt for password etc.
  336. ODBCCheckResult(SQL_HANDLE_DBC,FDBCHandle,Format('Could not connect with connection string "%s".',[ConnectionString]));
  337. if ActualLength<BufferLength-1 then
  338. SetLength(OutConnectionString,ActualLength); // fix completed connection string length
  339. // set connection attributes (none yet)
  340. end;
  341. procedure TODBCConnection.DoInternalDisconnect;
  342. begin
  343. inherited DoInternalDisconnect;
  344. // disconnect
  345. SQLDisconnect(FDBCHandle);
  346. ODBCCheckResult(SQL_HANDLE_DBC,FDBCHandle,'Could not disconnect.');
  347. // deallocate connection handle
  348. if SQLFreeHandle(SQL_HANDLE_DBC, FDBCHandle)=SQL_ERROR then
  349. ODBCCheckResult(SQL_HANDLE_DBC,FDBCHandle,'Could not free connection handle.');
  350. end;
  351. function TODBCConnection.AllocateCursorHandle: TSQLCursor;
  352. begin
  353. Result:=TODBCCursor.Create(self);
  354. end;
  355. procedure TODBCConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
  356. begin
  357. // make sure we don't deallocate the cursor if the connection was lost already
  358. if not Connected then
  359. (cursor as TODBCCursor).FSTMTHandle:=SQL_INVALID_HANDLE;
  360. FreeAndNil(cursor); // the destructor of TODBCCursor frees the ODBC Statement handle
  361. end;
  362. function TODBCConnection.AllocateTransactionHandle: TSQLHandle;
  363. begin
  364. Result:=nil; // not yet supported; will move connection handles to transaction handles later
  365. end;
  366. procedure TODBCConnection.PrepareStatement(cursor: TSQLCursor; ATransaction: TSQLTransaction; buf: string; AParams: TParams);
  367. var
  368. ODBCCursor:TODBCCursor;
  369. begin
  370. ODBCCursor:=cursor as TODBCCursor;
  371. // Parameter handling
  372. // Note: We can only pass ? parameters to ODBC, so we should convert named parameters like :MyID
  373. // ODBCCursor.FParamIndex will map th i-th ? token in the (modified) query to an index for AParams
  374. // Parse the SQL and build FParamIndex
  375. if assigned(AParams) and (AParams.count > 0) then
  376. buf := AParams.ParseSQL(buf,false,psInterbase,ODBCCursor.FParamIndex);
  377. // prepare statement
  378. SQLPrepare(ODBCCursor.FSTMTHandle, PChar(Buf), Length(Buf));
  379. ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not prepare statement.');
  380. ODBCCursor.FQuery:=Buf;
  381. end;
  382. procedure TODBCConnection.UnPrepareStatement(cursor: TSQLCursor);
  383. begin
  384. // not necessary in ODBC
  385. end;
  386. function TODBCConnection.GetTransactionHandle(trans: TSQLHandle): pointer;
  387. begin
  388. // Tranactions not implemented yet
  389. end;
  390. function TODBCConnection.StartDBTransaction(trans: TSQLHandle; AParams:string): boolean;
  391. begin
  392. // Tranactions not implemented yet
  393. end;
  394. function TODBCConnection.Commit(trans: TSQLHandle): boolean;
  395. begin
  396. // Tranactions not implemented yet
  397. end;
  398. function TODBCConnection.Rollback(trans: TSQLHandle): boolean;
  399. begin
  400. // Tranactions not implemented yet
  401. end;
  402. procedure TODBCConnection.CommitRetaining(trans: TSQLHandle);
  403. begin
  404. // Tranactions not implemented yet
  405. end;
  406. procedure TODBCConnection.RollbackRetaining(trans: TSQLHandle);
  407. begin
  408. // Tranactions not implemented yet
  409. end;
  410. procedure TODBCConnection.Execute(cursor: TSQLCursor; ATransaction: TSQLTransaction; AParams: TParams);
  411. var
  412. ODBCCursor:TODBCCursor;
  413. begin
  414. ODBCCursor:=cursor as TODBCCursor;
  415. // set parameters
  416. SetParameters(ODBCCursor, AParams);
  417. // execute the statement
  418. SQLExecute(ODBCCursor.FSTMTHandle);
  419. ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not execute statement.');
  420. // free parameter buffers
  421. FreeParamBuffers(ODBCCursor);
  422. end;
  423. function TODBCConnection.Fetch(cursor: TSQLCursor): boolean;
  424. var
  425. ODBCCursor:TODBCCursor;
  426. Res:SQLRETURN;
  427. begin
  428. ODBCCursor:=cursor as TODBCCursor;
  429. // fetch new row
  430. Res:=SQLFetch(ODBCCursor.FSTMTHandle);
  431. if Res<>SQL_NO_DATA then
  432. ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not fetch new row from result set');
  433. // result is true iff a new row was available
  434. Result:=Res<>SQL_NO_DATA;
  435. end;
  436. function TODBCConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer): boolean;
  437. var
  438. ODBCCursor:TODBCCursor;
  439. StrLenOrInd:SQLINTEGER;
  440. ODBCDateStruct:SQL_DATE_STRUCT;
  441. ODBCTimeStruct:SQL_TIME_STRUCT;
  442. ODBCTimeStampStruct:SQL_TIMESTAMP_STRUCT;
  443. DateTime:TDateTime;
  444. begin
  445. ODBCCursor:=cursor as TODBCCursor;
  446. // load the field using SQLGetData
  447. // Note: optionally we can implement the use of SQLBindCol later for even more speed
  448. // TODO: finish this
  449. case FieldDef.DataType of
  450. ftFixedChar,ftString: // are both mapped to TStringField
  451. SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size, @StrLenOrInd);
  452. ftSmallint: // mapped to TSmallintField
  453. SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SSHORT, buffer, SizeOf(Smallint), @StrLenOrInd);
  454. ftInteger,ftWord: // mapped to TLongintField
  455. SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SLONG, buffer, SizeOf(Longint), @StrLenOrInd);
  456. ftLargeint: // mapped to TLargeintField
  457. SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SBIGINT, buffer, SizeOf(Largeint), @StrLenOrInd);
  458. ftFloat: // mapped to TFloatField
  459. SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_DOUBLE, buffer, SizeOf(Double), @StrLenOrInd);
  460. ftTime: // mapped to TTimeField
  461. begin
  462. SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_TYPE_TIME, @ODBCTimeStruct, SizeOf(SQL_TIME_STRUCT), @StrLenOrInd);
  463. DateTime:=TimeStructToDateTime(@ODBCTimeStruct);
  464. Move(DateTime, buffer^, SizeOf(TDateTime));
  465. end;
  466. ftDate: // mapped to TDateField
  467. begin
  468. SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_TYPE_DATE, @ODBCDateStruct, SizeOf(SQL_DATE_STRUCT), @StrLenOrInd);
  469. DateTime:=DateStructToDateTime(@ODBCDateStruct);
  470. Move(DateTime, buffer^, SizeOf(TDateTime));
  471. end;
  472. ftDateTime: // mapped to TDateTimeField
  473. begin
  474. SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_TYPE_TIMESTAMP, @ODBCTimeStampStruct, SizeOf(SQL_TIMESTAMP_STRUCT), @StrLenOrInd);
  475. DateTime:=TimeStampStructToDateTime(@ODBCTimeStampStruct);
  476. Move(DateTime, buffer^, SizeOf(TDateTime));
  477. end;
  478. ftBoolean: // mapped to TBooleanField
  479. SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BIT, buffer, SizeOf(Wordbool), @StrLenOrInd);
  480. ftBytes: // mapped to TBytesField
  481. SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, FieldDef.Size, @StrLenOrInd);
  482. ftVarBytes: // mapped to TVarBytesField
  483. SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, FieldDef.Size, @StrLenOrInd);
  484. // TODO: Loading of other field types
  485. else
  486. raise EODBCException.CreateFmt('Tried to load field of unsupported field type %s',[Fieldtypenames[FieldDef.DataType]]);
  487. end;
  488. ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not get field data for field ''%s'' (index %d).',[FieldDef.Name, FieldDef.Index+1]));
  489. Result:=StrLenOrInd<>SQL_NULL_DATA; // Result indicates whether the value is non-null
  490. // writeln(Format('Field.Size: %d; StrLenOrInd: %d',[FieldDef.Size, StrLenOrInd]));
  491. end;
  492. function TODBCConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  493. begin
  494. // TODO: implement TODBCConnection.CreateBlobStream
  495. Result:=nil;
  496. end;
  497. procedure TODBCConnection.FreeFldBuffers(cursor: TSQLCursor);
  498. var
  499. ODBCCursor:TODBCCursor;
  500. begin
  501. ODBCCursor:=cursor as TODBCCursor;
  502. SQLFreeStmt(ODBCCursor.FSTMTHandle, SQL_CLOSE);
  503. ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not close ODBC statement cursor.');
  504. end;
  505. procedure TODBCConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);
  506. const
  507. ColNameDefaultLength = 40; // should be > 0, because an ansistring of length 0 is a nil pointer instead of a pointer to a #0
  508. var
  509. ODBCCursor:TODBCCursor;
  510. ColumnCount:SQLSMALLINT;
  511. i:integer;
  512. ColNameLength,DataType,DecimalDigits,Nullable:SQLSMALLINT;
  513. ColumnSize:SQLUINTEGER;
  514. ColName:string;
  515. FieldType:TFieldType;
  516. FieldSize:word;
  517. begin
  518. ODBCCursor:=cursor as TODBCCursor;
  519. // get number of columns in result set
  520. SQLNumResultCols(ODBCCursor.FSTMTHandle, ColumnCount);
  521. ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not determine number of columns in result set.');
  522. for i:=1 to ColumnCount do
  523. begin
  524. SetLength(ColName,ColNameDefaultLength); // also garantuees uniqueness
  525. // call with default column name buffer
  526. SQLDescribeCol(ODBCCursor.FSTMTHandle, // statement handle
  527. i, // column number, is 1-based (Note: column 0 is the bookmark column in ODBC)
  528. @(ColName[1]), // default buffer
  529. ColNameDefaultLength+1, // and its length; we include the #0 terminating any ansistring of Length > 0 in the buffer
  530. ColNameLength, // actual column name length
  531. DataType, // the SQL datatype for the column
  532. ColumnSize, // column size
  533. DecimalDigits, // number of decimal digits
  534. Nullable); // SQL_NO_NULLS, SQL_NULLABLE or SQL_NULLABLE_UNKNOWN
  535. ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not get column properties for column %d.',[i]));
  536. // truncate buffer or make buffer long enough for entire column name (note: the call is the same for both cases!)
  537. SetLength(ColName,ColNameLength);
  538. // check whether entire column name was returned
  539. if ColNameLength>ColNameDefaultLength then
  540. begin
  541. // request column name with buffer that is long enough
  542. SQLColAttribute(ODBCCursor.FSTMTHandle, // statement handle
  543. i, // column number
  544. SQL_DESC_NAME, // the column name or alias
  545. @(ColName[1]), // buffer
  546. ColNameLength+1, // buffer size
  547. @ColNameLength, // actual length
  548. nil); // no numerical output
  549. ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not get column name for column %d.',[i]));
  550. end;
  551. // convert type
  552. // NOTE: I made some guesses here after I found only limited information about TFieldType; please report any problems
  553. case DataType of
  554. SQL_CHAR: begin FieldType:=ftFixedChar; FieldSize:=ColumnSize+1; end;
  555. SQL_VARCHAR: begin FieldType:=ftString; FieldSize:=ColumnSize+1; end;
  556. SQL_LONGVARCHAR: begin FieldType:=ftString; FieldSize:=ColumnSize+1; end; // no fixed maximum length; make ftMemo when blobs are supported
  557. SQL_WCHAR: begin FieldType:=ftWideString; FieldSize:=ColumnSize+1; end;
  558. SQL_WVARCHAR: begin FieldType:=ftWideString; FieldSize:=ColumnSize+1; end;
  559. SQL_WLONGVARCHAR: begin FieldType:=ftWideString; FieldSize:=ColumnSize+1; end; // no fixed maximum length; make ftMemo when blobs are supported
  560. SQL_DECIMAL: begin FieldType:=ftFloat; FieldSize:=0; end;
  561. SQL_NUMERIC: begin FieldType:=ftFloat; FieldSize:=0; end;
  562. SQL_SMALLINT: begin FieldType:=ftSmallint; FieldSize:=0; end;
  563. SQL_INTEGER: begin FieldType:=ftInteger; FieldSize:=0; end;
  564. SQL_REAL: begin FieldType:=ftFloat; FieldSize:=0; end;
  565. SQL_FLOAT: begin FieldType:=ftFloat; FieldSize:=0; end;
  566. SQL_DOUBLE: begin FieldType:=ftFloat; FieldSize:=0; end;
  567. SQL_BIT: begin FieldType:=ftBoolean; FieldSize:=0; end;
  568. SQL_TINYINT: begin FieldType:=ftSmallint; FieldSize:=0; end;
  569. SQL_BIGINT: begin FieldType:=ftLargeint; FieldSize:=0; end;
  570. SQL_BINARY: begin FieldType:=ftBytes; FieldSize:=ColumnSize; end;
  571. SQL_VARBINARY: begin FieldType:=ftVarBytes; FieldSize:=ColumnSize; end;
  572. SQL_LONGVARBINARY: begin FieldType:=ftBlob; FieldSize:=ColumnSize; end;
  573. SQL_TYPE_DATE: begin FieldType:=ftDate; FieldSize:=0; end;
  574. SQL_TYPE_TIME: begin FieldType:=ftTime; FieldSize:=0; end;
  575. SQL_TYPE_TIMESTAMP:begin FieldType:=ftTimeStamp; FieldSize:=0; end;
  576. { SQL_TYPE_UTCDATETIME:FieldType:=ftUnknown;}
  577. { SQL_TYPE_UTCTIME: FieldType:=ftUnknown; }
  578. { SQL_INTERVAL_MONTH: FieldType:=ftUnknown;}
  579. { SQL_INTERVAL_YEAR: FieldType:=ftUnknown;}
  580. { SQL_INTERVAL_YEAR_TO_MONTH: FieldType:=ftUnknown;}
  581. { SQL_INTERVAL_DAY: FieldType:=ftUnknown;}
  582. { SQL_INTERVAL_HOUR: FieldType:=ftUnknown;}
  583. { SQL_INTERVAL_MINUTE: FieldType:=ftUnknown;}
  584. { SQL_INTERVAL_SECOND: FieldType:=ftUnknown;}
  585. { SQL_INTERVAL_DAY_TO_HOUR: FieldType:=ftUnknown;}
  586. { SQL_INTERVAL_DAY_TO_MINUTE: FieldType:=ftUnknown;}
  587. { SQL_INTERVAL_DAY_TO_SECOND: FieldType:=ftUnknown;}
  588. { SQL_INTERVAL_HOUR_TO_MINUTE: FieldType:=ftUnknown;}
  589. { SQL_INTERVAL_HOUR_TO_SECOND: FieldType:=ftUnknown;}
  590. { SQL_INTERVAL_MINUTE_TO_SECOND:FieldType:=ftUnknown;}
  591. { SQL_GUID: begin FieldType:=ftGuid; FieldSize:=ColumnSize; end; } // no TGuidField exists yet in the db unit
  592. else
  593. begin FieldType:=ftUnknown; FieldSize:=ColumnSize; end
  594. end;
  595. // add FieldDef
  596. TFieldDef.Create(FieldDefs, ColName, FieldType, FieldSize, False, i);
  597. end;
  598. end;
  599. procedure TODBCConnection.UpdateIndexDefs(var IndexDefs: TIndexDefs; TableName: string);
  600. begin
  601. inherited UpdateIndexDefs(IndexDefs, TableName);
  602. // TODO: implement this
  603. end;
  604. function TODBCConnection.GetSchemaInfoSQL(SchemaType: TSchemaType; SchemaObjectName, SchemaObjectPattern: string): string;
  605. begin
  606. Result:=inherited GetSchemaInfoSQL(SchemaType, SchemaObjectName, SchemaObjectPattern);
  607. // TODO: implement this
  608. end;
  609. { TODBCEnvironment }
  610. constructor TODBCEnvironment.Create;
  611. begin
  612. // make sure odbc is loaded
  613. if ODBCLoadCount=0 then LoadOdbc;
  614. Inc(ODBCLoadCount);
  615. // allocate environment handle
  616. if SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, FENVHandle)=SQL_Error then
  617. 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
  618. // set odbc version
  619. SQLSetEnvAttr(FENVHandle, SQL_ATTR_ODBC_VERSION, SQLPOINTER(SQL_OV_ODBC3), 0);
  620. ODBCCheckResult(SQL_HANDLE_ENV, FENVHandle,'Could not set ODBC version to 3.');
  621. end;
  622. destructor TODBCEnvironment.Destroy;
  623. begin
  624. // free environment handle
  625. if SQLFreeHandle(SQL_HANDLE_ENV, FENVHandle)=SQL_ERROR then
  626. ODBCCheckResult(SQL_HANDLE_ENV, FENVHandle, 'Could not free ODBC Environment handle.');
  627. // free odbc if not used by any TODBCEnvironment object anymore
  628. Dec(ODBCLoadCount);
  629. if ODBCLoadCount=0 then UnLoadOdbc;
  630. end;
  631. { TODBCCursor }
  632. constructor TODBCCursor.Create(Connection:TODBCConnection);
  633. begin
  634. // allocate statement handle
  635. SQLAllocHandle(SQL_HANDLE_STMT, Connection.FDBCHandle, FSTMTHandle);
  636. ODBCCheckResult(SQL_HANDLE_DBC, Connection.FDBCHandle, 'Could not allocate ODBC Statement handle.');
  637. end;
  638. destructor TODBCCursor.Destroy;
  639. begin
  640. inherited Destroy;
  641. if FSTMTHandle<>SQL_INVALID_HANDLE then
  642. begin
  643. // deallocate statement handle
  644. if SQLFreeHandle(SQL_HANDLE_STMT, FSTMTHandle)=SQL_ERROR then
  645. ODBCCheckResult(SQL_HANDLE_STMT, FSTMTHandle, 'Could not free ODBC Statement handle.');
  646. end;
  647. end;
  648. { finalization }
  649. finalization
  650. if Assigned(DefaultEnvironment) then
  651. DefaultEnvironment.Free;
  652. end.