Subversion Repositories delphiutils

Rev

Blame | Last modification | View Log | RSS feed

  1. unit AdoConnHelper;
  2.  
  3. (*
  4.  * Class helper for TAdoConnection
  5.  * by Daniel Marschall, ViaThinkSoft <www.viathinksoft.com>
  6.  * Revision: 28 Aug 2018
  7.  *)
  8.  
  9. interface
  10.  
  11. uses
  12.   DB, ADODB, Variants, Classes, SysUtils;
  13.  
  14. type
  15.   TAdoConnectionHelper = class helper for TADOConnection
  16.   private
  17.     function GetConnectionID: TGUID;
  18.   public
  19.     // Attention: Some of the functions here (e.g. ConnectionID) require SQL Server
  20.     function GetTable(SQL: string; ATimeout: integer=-1): TADODataSet;
  21.     function GetScalar(SQL: string; ATimeout: integer=-1): Variant;
  22.     procedure ExecSQL(SQL: string; ATimeout: integer=-1);
  23.     procedure ExecSQLList(List: TStrings; ATimeout: integer=-1);
  24.     procedure Connect(AConnectionString: string; ATimeout: integer=-1);
  25.     procedure Disconnect;
  26.     class function SQLStringEscape(str: string): string; static;
  27.     class function SQLObjectNameEscape(str: string): string; static;
  28.     procedure GetPrimaryKeyNames(TableName: string; outsl: TStrings);
  29.     property ConnectionID: TGUID read GetConnectionID;
  30.     function InsertAndReturnID(query: string): integer;
  31.     procedure DropTable(aTableName: string);
  32.     function FieldCount(aTableName: string): integer;
  33.     function IndexCount(aTableName: string): integer;
  34.     function TableExist(aTableName: string): boolean;
  35.     function ViewExist(aViewName: string): boolean;
  36.     function ColumnExists(aTableName, aColumnName: string): boolean;
  37.     procedure GetTableNames(List: TStrings; SystemTables: Boolean=false);
  38.     //property TransactionLevel: integer read FTransactionLevel;
  39.   end;
  40.  
  41. implementation
  42.  
  43. { TAdoConnectionHelper }
  44.  
  45. function TAdoConnectionHelper.GetConnectionID: TGUID;
  46. var
  47.   s : string;
  48. begin
  49.   s := GetScalar('select connection_id from sys.dm_exec_connections ec ' +
  50.                  'left join sys.dm_exec_sessions se on ec.session_id = se.session_id ' +
  51.                  'where se.session_id = @@SPID');
  52.   result := StringToGUID(s);
  53. end;
  54.  
  55. procedure TAdoConnectionHelper.GetPrimaryKeyNames(TableName: string; outsl: TStrings);
  56. var
  57.   ds: TADODataSet;
  58. begin
  59.   ds := TADODataSet.Create(nil);
  60.   try
  61.     OpenSchema(siPrimaryKeys, Unassigned, EmptyParam, ds);
  62.     while not ds.Eof do
  63.     begin
  64.       if ds.FieldByName('TABLE_NAME').AsString = TableName then
  65.       begin
  66.         outsl.Add(ds.FieldByName('COLUMN_NAME').AsString);
  67.       end;
  68.       ds.Next;
  69.     end;
  70.     ds.Close;
  71.   finally
  72.     ds.Free;
  73.   end;
  74. end;
  75.  
  76. function TAdoConnectionHelper.GetScalar(SQL: string; ATimeout: integer=-1): Variant;
  77. var
  78.   ds: TADODataSet;
  79. begin
  80.   ds := GetTable(SQL, ATimeout);
  81.   result := ds.Fields[0].AsVariant;
  82.   ds.Free;
  83. end;
  84.  
  85. function TAdoConnectionHelper.GetTable(SQL: string; ATimeout: integer=-1): TADODataSet;
  86. begin
  87.   result := TADODataSet.Create(nil);
  88.   result.Connection := Self;
  89.   result.EnableBCD := false;
  90.   result.ParamCheck := false;
  91.   result.CommandType := cmdText;
  92.   result.CommandText := SQL;
  93.   result.DisableControls;
  94.   if ATimeout <> -1 then result.CommandTimeout := ATimeout;
  95.   result.Active := true;
  96. end;
  97.  
  98. function TAdoConnectionHelper.ColumnExists(aTableName, aColumnName: string): boolean;
  99. begin
  100.   result := GetScalar('select count (*) from sys.columns where Name = '+SQLStringEscape(aColumnName)+' and Object_ID = Object_ID('+SQLStringEscape(aTableName)+')') > 0;
  101. end;
  102.  
  103. procedure TAdoConnectionHelper.GetTableNames(List: TStrings;
  104.   SystemTables: Boolean);
  105. begin
  106.  
  107. end;
  108.  
  109. function TAdoConnectionHelper.IndexCount(aTableName: string): integer;
  110. begin
  111.   result := GetScalar('select max (ik.indid) from sysindexkeys ik left join sysindexes ind on ind.id = ik.id and ind.indid = ik.indid where ik.id = (select id from sysobjects ' +
  112.                       'where name = ''' + aTableName + ''') and ind.status < 10000000');
  113. end;
  114.  
  115. function TAdoConnectionHelper.InsertAndReturnID(query: string): integer;
  116. resourcestring
  117.   LNG_NO_AUTOINC = 'Cannot find AutoIncrement value';
  118. var
  119.   q1: TADODataSet;
  120. begin
  121.   BeginTrans;
  122.   try
  123.     ExecSql(query); // Execute(query);
  124.  
  125.     // Hinweis: Das geht nur lokal, nicht ├╝ber linked servers
  126.     // TODO: Man sollte lieber SCOPE_IDENTITY() verwenden
  127.     q1 := GetTable('select @@IDENTITY as INSERT_ID;');
  128.     try
  129.       if (q1.RecordCount = 0) or (q1.{FieldByName('INSERT_ID')}Fields[0].AsInteger = 0) then
  130.       begin
  131.         //result := -1;
  132.         raise EADOError.Create(LNG_NO_AUTOINC);
  133.       end;
  134.  
  135.       result := q1.{FieldByName('INSERT_ID')}Fields[0].AsInteger;
  136.     finally
  137.       FreeAndNil(q1);
  138.     end;
  139.   finally
  140.     CommitTrans;
  141.   end;
  142. end;
  143.  
  144. procedure TAdoConnectionHelper.Connect(AConnectionString: string; ATimeout: integer=-1);
  145. begin
  146.   Disconnect;
  147.   ConnectionString := AConnectionString;
  148.   if ATimeout <> -1 then ConnectionTimeout := ATimeout;
  149.   Connected := true;
  150. end;
  151.  
  152. procedure TAdoConnectionHelper.Disconnect;
  153. begin
  154.   Connected := false;
  155. end;
  156.  
  157. procedure TAdoConnectionHelper.DropTable(aTableName: string);
  158. begin
  159.   if ViewExist(aTableName) then
  160.   begin
  161.     ExecSql('drop view ' + SQLObjectNameEscape(aTableName));
  162.   end;
  163.   if TableExist(aTableName) then
  164.   begin
  165.     ExecSql('drop table ' + SQLObjectNameEscape(aTableName));
  166.   end;
  167. end;
  168.  
  169. procedure TAdoConnectionHelper.ExecSQL(SQL: string; ATimeout: integer);
  170. var
  171.   cmd: TADOCommand;
  172. begin
  173.   cmd := TADOCommand.Create(nil);
  174.   try
  175.     cmd.Connection := Self;
  176.     cmd.ParamCheck := false;
  177.     cmd.CommandType := cmdText;
  178.     cmd.CommandText := SQL;
  179.     if ATimeOut <> -1 then cmd.CommandTimeout := ATimeout;
  180.     cmd.Execute;
  181.   finally
  182.     cmd.Free;
  183.   end;
  184. end;
  185.  
  186. procedure TAdoConnectionHelper.ExecSQLList(List: TStrings; ATimeout: integer);
  187. var
  188.   s: string;
  189. begin
  190.   for s in List do
  191.   begin
  192.     ExecSQL(s);
  193.   end;
  194. end;
  195.  
  196. function TAdoConnectionHelper.FieldCount(aTableName: string): integer;
  197. begin
  198.   result := GetScalar('select count (*) from syscolumns where id = (select id from sysobjects where name = ''' + aTableName + ''') ');
  199. end;
  200.  
  201. class function TAdoConnectionHelper.SQLStringEscape(str: string): string;
  202. begin
  203.   result := str;
  204.  
  205.   // Escape SQL-Argument
  206.   (*
  207.   result := StringReplace(result, '\', '\\', [rfReplaceAll]);
  208.   result := StringReplace(result, '_', '\_', [rfReplaceAll]);
  209.   result := StringReplace(result, '%', '\%', [rfReplaceAll]);
  210.   result := StringReplace(result, '[', '\[', [rfReplaceAll]);
  211.   result := StringReplace(result, '''', '\''', [rfReplaceAll]);
  212.   *)
  213.  
  214.   // DM 29.02.2016 Irgendwie versteh ich das nicht...
  215.   // 'xxx\'xxx' ist erlaubt, aber 'xxx\'xxx\'xxx' nicht
  216.   // aber 'xxx''xxx''xxx' geht.
  217.   result := StringReplace(result, '''', '''''', [rfReplaceAll]);
  218.  
  219.   // Verhindern, dass SQL Server denkt, es sei ein Parameterobjekt
  220.   // Brauchen wir nur, wenn die abfrage ParamCheck=true hat.
  221.   // Wir haben aber in hl_Datenbank.pas das immer auf false.
  222.   // result := StringReplace(result, ':', '::', [rfReplaceAll]);
  223.  
  224.   {$IFDEF UNICODE}
  225.   result := 'N''' + result + '''';
  226.   {$ELSE}
  227.   result := '''' + result + '''';
  228.   {$ENDIF}
  229. end;
  230.  
  231. function TAdoConnectionHelper.TableExist(aTableName: string): boolean;
  232. begin
  233.   if Copy(aTableName, 1, 1) = '#' then
  234.   begin
  235.     // TempTable
  236.     result := GetScalar('select case when OBJECT_ID(''tempdb..'+aTableName+''') is not null then ''1'' else ''0'' end') > 0;
  237.   end
  238.   else
  239.   begin
  240.     // Physikalische Tabelle (in Schema dbo)
  241.     // result := GetScalar('select count (*) from sysobjects where name = ' + aTableName.toSQLString) > 0;
  242.     result := GetScalar('SELECT count(*) FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_CATALOG = N'''+DefaultDatabase+''' AND TABLE_SCHEMA = N''dbo'' AND TABLE_NAME = N'''+aTableName+'''') > 0;
  243.   end;
  244. end;
  245.  
  246. function TAdoConnectionHelper.ViewExist(aViewName: string): boolean;
  247. begin
  248.   result := GetScalar('select count(*) FROM sys.views where name = '+SQLStringEscape(aViewName)) > 0;
  249. end;
  250.  
  251. class function TAdoConnectionHelper.SQLObjectNameEscape(str: string): string;
  252. begin
  253.   result := '[dbo].[' + str + ']';
  254. end;
  255.  
  256. end.
  257.