odbcconn.pas 61 KB

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