odbcconn.pas 64 KB

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