odbcconn.pas 58 KB

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