odbcconn.pas 66 KB

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