sqldbtoolsunit.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640
  1. unit SQLDBToolsUnit;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, toolsunit
  6. ,db, sqldb
  7. ,mysql40conn, mysql41conn, mysql50conn, mysql51conn, mysql55conn, mysql56conn
  8. ,ibconnection
  9. ,pqconnection
  10. ,odbcconn
  11. {$IFNDEF WIN64}
  12. {See packages\fcl-db\fpmake.pp: Oracle connector not built yet on Win64}
  13. ,oracleconnection
  14. {$ENDIF WIN64}
  15. ,sqlite3conn
  16. ,mssqlconn
  17. ;
  18. type
  19. TSQLConnType = (mysql40,mysql41,mysql50,mysql51,mysql55,mysql56,postgresql,interbase,odbc,oracle,sqlite3,mssql,sybase);
  20. TSQLServerType = (ssFirebird, ssInterbase, ssMSSQL, ssMySQL, ssOracle, ssPostgreSQL, ssSQLite, ssSybase, ssUnknown);
  21. const
  22. MySQLConnTypes = [mysql40,mysql41,mysql50,mysql51,mysql55,mysql56];
  23. SQLConnTypesNames : Array [TSQLConnType] of String[19] =
  24. ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','MYSQL55','MYSQL56','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3','MSSQL','SYBASE');
  25. STestNotApplicable = 'This test does not apply to this sqldb connection type';
  26. type
  27. { TSQLDBConnector }
  28. TSQLDBConnector = class(TDBConnector)
  29. private
  30. FConnection : TSQLConnection;
  31. FTransaction : TSQLTransaction;
  32. FQuery : TSQLQuery;
  33. FUniDirectional: boolean;
  34. procedure CreateFConnection;
  35. procedure CreateFTransaction;
  36. Function CreateQuery : TSQLQuery;
  37. protected
  38. procedure SetTestUniDirectional(const AValue: boolean); override;
  39. function GetTestUniDirectional: boolean; override;
  40. procedure CreateNDatasets; override;
  41. procedure CreateFieldDataset; override;
  42. procedure DropNDatasets; override;
  43. procedure DropFieldDataset; override;
  44. Function InternalGetNDataset(n : integer) : TDataset; override;
  45. Function InternalGetFieldDataset : TDataSet; override;
  46. procedure TryDropIfExist(ATableName : String);
  47. public
  48. destructor Destroy; override;
  49. constructor Create; override;
  50. procedure ExecuteDirect(const SQL: string);
  51. procedure CommitDDL;
  52. property Connection : TSQLConnection read FConnection;
  53. property Transaction : TSQLTransaction read FTransaction;
  54. property Query : TSQLQuery read FQuery;
  55. end;
  56. var SQLConnType : TSQLConnType;
  57. SQLServerType : TSQLServerType;
  58. FieldtypeDefinitions : Array [TFieldType] of String[20];
  59. implementation
  60. uses StrUtils;
  61. type
  62. TSQLServerTypesMapItem = record
  63. s: string;
  64. t: TSQLServerType;
  65. end;
  66. const
  67. FieldtypeDefinitionsConst : Array [TFieldType] of String[20] =
  68. (
  69. '',
  70. 'VARCHAR(10)',
  71. 'SMALLINT',
  72. 'INTEGER',
  73. '', // ftWord
  74. 'BOOLEAN',
  75. 'DOUBLE PRECISION', // ftFloat
  76. '', // ftCurrency
  77. 'DECIMAL(18,4)',// ftBCD
  78. 'DATE',
  79. 'TIME',
  80. 'TIMESTAMP', // ftDateTime
  81. '', // ftBytes
  82. '', // ftVarBytes
  83. '', // ftAutoInc
  84. 'BLOB', // ftBlob
  85. 'BLOB', // ftMemo
  86. 'BLOB', // ftGraphic
  87. '',
  88. '',
  89. '',
  90. '',
  91. '',
  92. 'CHAR(10)', // ftFixedChar
  93. '', // ftWideString
  94. 'BIGINT', // ftLargeInt
  95. '',
  96. '',
  97. '',
  98. '',
  99. '',
  100. '',
  101. '',
  102. '',
  103. '',
  104. '', // ftGuid
  105. 'TIMESTAMP', // ftTimestamp
  106. 'NUMERIC(18,6)',// ftFmtBCD
  107. '', // ftFixedWideChar
  108. '' // ftWideMemo
  109. );
  110. // names as returned by ODBC SQLGetInfo(..., SQL_DBMS_NAME, ...) and GetConnectionInfo(citServerType)
  111. SQLServerTypesMap : array [0..7] of TSQLServerTypesMapItem = (
  112. (s: 'Firebird'; t: ssFirebird),
  113. (s: 'Interbase'; t: ssInterbase),
  114. (s: 'Microsoft SQL Server'; t: ssMSSQL),
  115. (s: 'MySQL'; t: ssMySQL),
  116. (s: 'Oracle'; t: ssOracle),
  117. (s: 'PostgreSQL'; t: ssPostgreSQL),
  118. (s: 'SQLite3'; t: ssSQLite),
  119. (s: 'ASE'; t: ssSybase)
  120. );
  121. // fall back mapping (e.g. in case GetConnectionInfo(citServerType) is not implemented)
  122. SQLConnTypeToServerTypeMap : array[TSQLConnType] of TSQLServerType =
  123. (ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssPostgreSQL,ssFirebird,ssUnknown,ssOracle,ssSQLite,ssMSSQL,ssSybase);
  124. { TSQLDBConnector }
  125. procedure TSQLDBConnector.CreateFConnection;
  126. var t : TSQLConnType;
  127. i : integer;
  128. s : string;
  129. begin
  130. for t := low(SQLConnTypesNames) to high(SQLConnTypesNames) do
  131. if UpperCase(dbconnectorparams) = SQLConnTypesNames[t] then SQLConnType := t;
  132. if SQLConnType = MYSQL40 then Fconnection := TMySQL40Connection.Create(nil);
  133. if SQLConnType = MYSQL41 then Fconnection := TMySQL41Connection.Create(nil);
  134. if SQLConnType = MYSQL50 then Fconnection := TMySQL50Connection.Create(nil);
  135. if SQLConnType = MYSQL51 then Fconnection := TMySQL51Connection.Create(nil);
  136. if SQLConnType = MYSQL55 then Fconnection := TMySQL55Connection.Create(nil);
  137. if SQLConnType = MYSQL56 then Fconnection := TMySQL56Connection.Create(nil);
  138. if SQLConnType = SQLITE3 then Fconnection := TSQLite3Connection.Create(nil);
  139. if SQLConnType = POSTGRESQL then Fconnection := TPQConnection.Create(nil);
  140. if SQLConnType = INTERBASE then Fconnection := TIBConnection.Create(nil);
  141. if SQLConnType = ODBC then Fconnection := TODBCConnection.Create(nil);
  142. {$IFNDEF Win64}
  143. if SQLConnType = ORACLE then Fconnection := TOracleConnection.Create(nil);
  144. {$ENDIF Win64}
  145. if SQLConnType = MSSQL then Fconnection := TMSSQLConnection.Create(nil);
  146. if SQLConnType = SYBASE then Fconnection := TSybaseConnection.Create(nil);
  147. if not assigned(Fconnection) then writeln('Invalid database type, check if a valid database type for your achitecture was provided in the file ''database.ini''');
  148. with Fconnection do
  149. begin
  150. DatabaseName := dbname;
  151. UserName := dbuser;
  152. Password := dbpassword;
  153. HostName := dbhostname;
  154. if (dbhostname='') and (SQLConnType=interbase) then
  155. begin
  156. // Firebird embedded: create database file if it doesn't yet exist
  157. // Note: pagesize parameter has influence on behavior. We're using
  158. // Firebird default here.
  159. if not(fileexists(dbname)) then
  160. CreateDB; //Create testdb
  161. end;
  162. if length(dbQuoteChars)>1 then
  163. FieldNameQuoteChars:=dbQuoteChars;
  164. Open;
  165. end;
  166. // determine remote SQL Server to which we are connected
  167. s := Fconnection.GetConnectionInfo(citServerType);
  168. if s = '' then
  169. SQLServerType := SQLConnTypeToServerTypeMap[SQLConnType] // if citServerType isn't implemented
  170. else
  171. for i := low(SQLServerTypesMap) to high(SQLServerTypesMap) do
  172. if SQLServerTypesMap[i].s = s then
  173. SQLServerType := SQLServerTypesMap[i].t;
  174. FieldtypeDefinitions := FieldtypeDefinitionsConst;
  175. case SQLServerType of
  176. ssFirebird:
  177. begin
  178. // Firebird < 3.0 has no support for Boolean data type:
  179. FieldtypeDefinitions[ftBoolean] := '';
  180. FieldtypeDefinitions[ftMemo] := 'BLOB SUB_TYPE TEXT';
  181. end;
  182. ssInterbase:
  183. begin
  184. FieldtypeDefinitions[ftMemo] := 'BLOB SUB_TYPE TEXT';
  185. FieldtypeDefinitions[ftLargeInt] := 'NUMERIC(18,0)';
  186. end;
  187. ssMSSQL, ssSybase:
  188. // todo: Sybase: copied over MSSQL; verify correctness
  189. begin
  190. FieldtypeDefinitions[ftBoolean] := 'BIT';
  191. FieldtypeDefinitions[ftFloat] := 'FLOAT';
  192. FieldtypeDefinitions[ftCurrency]:= 'MONEY';
  193. FieldtypeDefinitions[ftDate] := 'DATETIME';
  194. FieldtypeDefinitions[ftTime] := '';
  195. FieldtypeDefinitions[ftDateTime]:= 'DATETIME';
  196. FieldtypeDefinitions[ftBytes] := 'BINARY(5)';
  197. FieldtypeDefinitions[ftVarBytes]:= 'VARBINARY(10)';
  198. FieldtypeDefinitions[ftBlob] := 'IMAGE';
  199. FieldtypeDefinitions[ftMemo] := 'TEXT';
  200. FieldtypeDefinitions[ftGraphic] := '';
  201. FieldtypeDefinitions[ftWideString] := 'NVARCHAR(10)';
  202. FieldtypeDefinitions[ftFixedWideChar] := 'NCHAR(10)';
  203. //FieldtypeDefinitions[ftWideMemo] := 'NTEXT'; // Sybase has UNITEXT?
  204. end;
  205. ssMySQL:
  206. begin
  207. // Add into my.ini: sql-mode="...,PAD_CHAR_TO_FULL_LENGTH,ANSI_QUOTES"
  208. FieldtypeDefinitions[ftWord] := 'SMALLINT UNSIGNED';
  209. // MySQL recognizes BOOLEAN, but as synonym for TINYINT, not true sql boolean datatype
  210. FieldtypeDefinitions[ftBoolean] := '';
  211. // Use 'DATETIME' for datetime-fields instead of timestamp, because
  212. // mysql's timestamps are only valid in the range 1970-2038.
  213. // Downside is that fields defined as 'TIMESTAMP' aren't tested
  214. FieldtypeDefinitions[ftDateTime] := 'DATETIME';
  215. FieldtypeDefinitions[ftBytes] := 'BINARY(5)';
  216. FieldtypeDefinitions[ftVarBytes] := 'VARBINARY(10)';
  217. FieldtypeDefinitions[ftMemo] := 'TEXT';
  218. end;
  219. ssOracle:
  220. begin
  221. FieldtypeDefinitions[ftBoolean] := '';
  222. // At least Oracle 10, 11 do not support a BIGINT field:
  223. FieldtypeDefinitions[ftLargeInt] := 'NUMBER(19,0)';
  224. FieldtypeDefinitions[ftTime] := 'TIMESTAMP';
  225. FieldtypeDefinitions[ftMemo] := 'CLOB';
  226. end;
  227. ssPostgreSQL:
  228. begin
  229. FieldtypeDefinitions[ftCurrency] := 'MONEY'; // ODBC?!
  230. FieldtypeDefinitions[ftBlob] := 'BYTEA';
  231. FieldtypeDefinitions[ftMemo] := 'TEXT';
  232. FieldtypeDefinitions[ftGraphic] := '';
  233. FieldtypeDefinitions[ftGuid] := 'UUID';
  234. end;
  235. ssSQLite:
  236. begin
  237. FieldtypeDefinitions[ftWord] := 'WORD';
  238. FieldtypeDefinitions[ftCurrency] := 'CURRENCY';
  239. FieldtypeDefinitions[ftBytes] := 'BINARY(5)';
  240. FieldtypeDefinitions[ftVarBytes] := 'VARBINARY(10)';
  241. FieldtypeDefinitions[ftMemo] := 'CLOB'; //or TEXT SQLite supports both, but CLOB is sql standard (TEXT not)
  242. FieldtypeDefinitions[ftWideString] := 'NVARCHAR(10)';
  243. FieldtypeDefinitions[ftFixedWideChar] := 'NCHAR(10)';
  244. FieldtypeDefinitions[ftWideMemo] := 'NCLOB';
  245. end;
  246. end;
  247. if SQLConnType in [mysql40,mysql41] then
  248. begin
  249. // Mysql versions prior to 5.0.3 removes the trailing spaces on varchar
  250. // fields on insertion. So to test properly, we have to do the same
  251. for i := 0 to testValuesCount-1 do
  252. testStringValues[i] := TrimRight(testStringValues[i]);
  253. end;
  254. if SQLServerType in [ssMySQL] then
  255. begin
  256. // Some DB's do not support milliseconds in datetime and time fields.
  257. for i := 0 to testValuesCount-1 do
  258. begin
  259. testTimeValues[i] := copy(testTimeValues[i],1,8)+'.000';
  260. testValues[ftTime,i] := copy(testTimeValues[i],1,8)+'.000';
  261. if length(testValues[ftDateTime,i]) > 19 then
  262. testValues[ftDateTime,i] := copy(testValues[ftDateTime,i],1,19)+'.000';
  263. end;
  264. end;
  265. if SQLServerType in [ssFirebird, ssInterbase, ssMSSQL, ssOracle, ssPostgreSQL, ssSybase] then
  266. begin
  267. // Some db's do not support times > 24:00:00
  268. testTimeValues[3]:='13:25:15.000';
  269. testValues[ftTime,3]:='13:25:15.000';
  270. if SQLServerType in [ssFirebird, ssInterbase, ssOracle] then
  271. begin
  272. // Firebird, Oracle do not support time = 24:00:00
  273. testTimeValues[2]:='23:00:00.000';
  274. testValues[ftTime,2]:='23:00:00.000';
  275. end;
  276. end;
  277. if SQLServerType in [ssMSSQL, ssSybase] then
  278. // Some DB's do not support datetime values before 1753-01-01
  279. for i := 18 to testValuesCount-1 do
  280. begin
  281. testValues[ftDate,i] := testValues[ftDate,0];
  282. testValues[ftDateTime,i] := testValues[ftDateTime,0];
  283. end;
  284. // DecimalSeparator must correspond to monetary locale (lc_monetary) set on PostgreSQL server
  285. // Here we assume, that locale on client side is same as locale on server
  286. if SQLServerType in [ssPostgreSQL] then
  287. for i := 0 to testValuesCount-1 do
  288. testValues[ftCurrency,i] := QuotedStr(CurrToStr(testCurrencyValues[i]));
  289. // SQLite does not support fixed length CHAR datatype
  290. // MySQL by default trimms trailing spaces on retrieval; so set sql-mode="PAD_CHAR_TO_FULL_LENGTH" - supported from MySQL 5.1.20
  291. // MSSQL set SET ANSI_PADDING ON
  292. // todo: verify Sybase behaviour
  293. if SQLServerType in [ssSQLite] then
  294. for i := 0 to testValuesCount-1 do
  295. testValues[ftFixedChar,i] := PadRight(testValues[ftFixedChar,i], 10);
  296. end;
  297. procedure TSQLDBConnector.CreateFTransaction;
  298. begin
  299. Ftransaction := tsqltransaction.create(nil);
  300. with Ftransaction do
  301. database := Fconnection;
  302. end;
  303. function TSQLDBConnector.CreateQuery: TSQLQuery;
  304. begin
  305. Result := TSQLQuery.create(nil);
  306. with Result do
  307. begin
  308. database := Fconnection;
  309. transaction := Ftransaction;
  310. PacketRecords := -1; // To avoid: "Connection is busy with results for another hstmt" (ODBC,MSSQL)
  311. end;
  312. end;
  313. procedure TSQLDBConnector.SetTestUniDirectional(const AValue: boolean);
  314. begin
  315. FUniDirectional:=avalue;
  316. FQuery.UniDirectional:=AValue;
  317. end;
  318. function TSQLDBConnector.GetTestUniDirectional: boolean;
  319. begin
  320. result := FUniDirectional;
  321. end;
  322. procedure TSQLDBConnector.CreateNDatasets;
  323. var CountID : Integer;
  324. begin
  325. try
  326. Ftransaction.StartTransaction;
  327. TryDropIfExist('FPDEV');
  328. Fconnection.ExecuteDirect('create table FPDEV (' +
  329. ' ID INT NOT NULL, ' +
  330. ' NAME VARCHAR(50), ' +
  331. ' PRIMARY KEY (ID) ' +
  332. ')');
  333. FTransaction.CommitRetaining;
  334. for countID := 1 to MaxDataSet do
  335. Fconnection.ExecuteDirect('insert into FPDEV (ID,NAME)' +
  336. 'values ('+inttostr(countID)+',''TestName'+inttostr(countID)+''')');
  337. Ftransaction.Commit;
  338. except
  339. if Ftransaction.Active then Ftransaction.Rollback
  340. end;
  341. end;
  342. procedure TSQLDBConnector.CreateFieldDataset;
  343. var
  344. CountID : Integer;
  345. FType : TFieldType;
  346. Sql,sql1: String;
  347. function String2Hex(Source: string): string;
  348. // Converts ASCII codes into hex
  349. // Inverse of hex2string
  350. var
  351. i: integer;
  352. begin
  353. result := '';
  354. for i := 1 to length(Source) do
  355. result := result + inttohex(ord(Source[i]),2);
  356. end;
  357. begin
  358. try
  359. Ftransaction.StartTransaction;
  360. TryDropIfExist('FPDEV_FIELD');
  361. Sql := 'create table FPDEV_FIELD (ID INT NOT NULL,';
  362. for FType := low(TFieldType)to high(TFieldType) do
  363. if FieldtypeDefinitions[FType]<>'' then
  364. sql := sql + 'F' + Fieldtypenames[FType] + ' ' +
  365. FieldtypeDefinitions[FType] + ',';
  366. Sql := Sql + 'PRIMARY KEY (ID))';
  367. FConnection.ExecuteDirect(Sql);
  368. FTransaction.CommitRetaining;
  369. for countID := 0 to testValuesCount-1 do
  370. begin
  371. Sql := 'insert into FPDEV_FIELD (ID';
  372. Sql1 := 'values ('+IntToStr(countID);
  373. for FType := low(TFieldType)to high(TFieldType) do
  374. if FieldtypeDefinitions[FType]<>'' then
  375. begin
  376. sql := sql + ',F' + Fieldtypenames[FType];
  377. if testValues[FType,CountID] <> '' then
  378. case FType of
  379. ftBlob, ftBytes, ftGraphic, ftVarBytes:
  380. if SQLServerType in [ssOracle] then
  381. // Oracle does not accept string literals in blob insert statements
  382. // convert 'DEADBEEF' hex literal to binary:
  383. sql1 := sql1 + ', HEXTORAW(' + QuotedStr(String2Hex(testValues[FType,CountID])) + ') '
  384. else // other dbs have no problems with the original string values
  385. sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID]);
  386. ftCurrency:
  387. sql1 := sql1 + ',' + testValues[FType,CountID];
  388. ftDate:
  389. // Oracle requires date conversion; otherwise
  390. // ORA-01861: literal does not match format string
  391. if SQLServerType in [ssOracle] then
  392. // ANSI/ISO date literal:
  393. sql1 := sql1 + ', DATE ' + QuotedStr(testValues[FType,CountID])
  394. else
  395. sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID]);
  396. ftDateTime:
  397. // similar to ftDate handling
  398. if SQLServerType in [ssOracle] then
  399. begin
  400. // Could be a real date+time or only date. Does not consider only time.
  401. if pos(' ',testValues[FType,CountID])>0 then
  402. sql1 := sql1 + ', TIMESTAMP ' + QuotedStr(testValues[FType,CountID])
  403. else
  404. sql1 := sql1 + ', DATE ' + QuotedStr(testValues[FType,CountID]);
  405. end
  406. else
  407. sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID]);
  408. ftTime:
  409. // similar to ftDate handling
  410. if SQLServerType in [ssOracle] then
  411. // More or less arbitrary default time; there is no time-only data type in Oracle.
  412. sql1 := sql1 + ', TIMESTAMP ' + QuotedStr('0001-01-01 '+testValues[FType,CountID])
  413. else
  414. sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID]);
  415. else
  416. sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID])
  417. end
  418. else
  419. sql1 := sql1 + ',NULL';
  420. end;
  421. Sql := sql + ')';
  422. Sql1 := sql1+ ')';
  423. Fconnection.ExecuteDirect(sql + ' ' + sql1);
  424. end;
  425. Ftransaction.Commit;
  426. except
  427. on E: Exception do begin
  428. //writeln(E.Message);
  429. if Ftransaction.Active then Ftransaction.Rollback;
  430. end;
  431. end;
  432. end;
  433. procedure TSQLDBConnector.DropNDatasets;
  434. begin
  435. if assigned(FTransaction) then
  436. begin
  437. try
  438. if Ftransaction.Active then Ftransaction.Rollback;
  439. Ftransaction.StartTransaction;
  440. Fconnection.ExecuteDirect('DROP TABLE FPDEV');
  441. Ftransaction.Commit;
  442. Except
  443. if Ftransaction.Active then Ftransaction.Rollback
  444. end;
  445. end;
  446. end;
  447. procedure TSQLDBConnector.DropFieldDataset;
  448. begin
  449. if assigned(FTransaction) then
  450. begin
  451. try
  452. if Ftransaction.Active then Ftransaction.Rollback;
  453. Ftransaction.StartTransaction;
  454. Fconnection.ExecuteDirect('DROP TABLE FPDEV_FIELD');
  455. Ftransaction.Commit;
  456. Except
  457. if Ftransaction.Active then Ftransaction.Rollback
  458. end;
  459. end;
  460. end;
  461. function TSQLDBConnector.InternalGetNDataset(n: integer): TDataset;
  462. begin
  463. Result := CreateQuery;
  464. with (Result as TSQLQuery) do
  465. begin
  466. sql.clear;
  467. sql.add('SELECT * FROM FPDEV WHERE ID < '+inttostr(n+1));
  468. UniDirectional:=TestUniDirectional;
  469. end;
  470. end;
  471. function TSQLDBConnector.InternalGetFieldDataset: TDataSet;
  472. begin
  473. Result := CreateQuery;
  474. with (Result as TSQLQuery) do
  475. begin
  476. sql.clear;
  477. sql.add('SELECT * FROM FPDEV_FIELD');
  478. UniDirectional:=TestUniDirectional;
  479. end;
  480. end;
  481. procedure TSQLDBConnector.TryDropIfExist(ATableName: String);
  482. begin
  483. // This makes life so much easier, since it avoids the exception if the table already
  484. // exists. And while this exception is in a try..except statement, the debugger
  485. // always shows the exception, which is pretty annoying.
  486. try
  487. case SQLServerType of
  488. ssFirebird:
  489. begin
  490. // This only works with Firebird 2+
  491. FConnection.ExecuteDirect('execute block as begin if (exists (select 1 from rdb$relations where rdb$relation_name=''' + ATableName + ''')) '+
  492. 'then execute statement ''drop table ' + ATableName + ';'';end');
  493. FTransaction.CommitRetaining;
  494. end;
  495. ssMSSQL:
  496. begin
  497. // Checking is needed here to avoid getting "auto rollback" of a subsequent CREATE TABLE statement
  498. // which leads to the rollback not referring to the right transaction=>SQL error
  499. // Use SQL92 ISO standard INFORMATION_SCHEMA:
  500. FConnection.ExecuteDirect(
  501. 'if exists (select * from INFORMATION_SCHEMA.TABLES where TABLE_TYPE=''BASE TABLE'' AND TABLE_NAME=''' + ATableName + ''') '+
  502. 'begin '+
  503. 'drop table ' + ATableName + ' '+
  504. 'end');
  505. end;
  506. ssMySQL:
  507. begin
  508. FConnection.ExecuteDirect('drop table if exists ' + ATableName);
  509. end;
  510. ssOracle:
  511. begin
  512. FConnection.ExecuteDirect(
  513. 'declare ' +
  514. ' c int; ' +
  515. 'begin ' +
  516. ' select count(*) into c from all_tables where table_name = upper(''' + ATableName + '''); ' +
  517. ' if c = 1 then ' +
  518. ' execute immediate ''drop table ' + ATableName + '''; ' +
  519. ' end if; ' +
  520. 'end; ');
  521. end;
  522. ssSybase:
  523. begin
  524. // Checking is needed here to avoid getting "auto rollback" of a subsequent CREATE TABLE statement
  525. // which leads to the rollback not referring to the right transaction=>SQL error
  526. // Can't use SQL standard information_schema; instead query sysobjects for User tables
  527. FConnection.ExecuteDirect(
  528. 'if exists (select * from sysobjects where type = ''U'' and name=''' + ATableName + ''') '+
  529. 'begin '+
  530. 'drop table ' + ATableName + ' '+
  531. 'end');
  532. end;
  533. end;
  534. except
  535. FTransaction.RollbackRetaining;
  536. end;
  537. end;
  538. procedure TSQLDBConnector.ExecuteDirect(const SQL: string);
  539. begin
  540. Connection.ExecuteDirect(SQL);
  541. end;
  542. procedure TSQLDBConnector.CommitDDL;
  543. begin
  544. // Commits schema definition and manipulation statements;
  545. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  546. if SQLServerType in [ssFirebird, ssInterbase] then
  547. Transaction.CommitRetaining;
  548. end;
  549. destructor TSQLDBConnector.Destroy;
  550. begin
  551. if assigned(FTransaction) then
  552. begin
  553. try
  554. if Ftransaction.Active then Ftransaction.Rollback;
  555. Ftransaction.StartTransaction;
  556. Fconnection.ExecuteDirect('DROP TABLE FPDEV2');
  557. Ftransaction.Commit;
  558. Except
  559. if Ftransaction.Active then Ftransaction.Rollback;
  560. end; // try
  561. end;
  562. inherited Destroy;
  563. FreeAndNil(FQuery);
  564. FreeAndNil(FTransaction);
  565. FreeAndNil(FConnection);
  566. end;
  567. constructor TSQLDBConnector.Create;
  568. begin
  569. FConnection := nil;
  570. CreateFConnection;
  571. CreateFTransaction;
  572. FQuery := CreateQuery;
  573. FConnection.Transaction := FTransaction;
  574. Inherited;
  575. end;
  576. initialization
  577. RegisterClass(TSQLDBConnector);
  578. end.