odbcconn.pas 64 KB

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