odbcconn.pas 63 KB

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