unit AdoConnHelper;
(*
* Class helper for TAdoConnection
* by Daniel Marschall, ViaThinkSoft <www.viathinksoft.com>
* Revision: 28 Aug 2018
*)
interface
uses
DB, ADODB, Variants, Classes, SysUtils;
type
TAdoConnectionHelper = class helper for TADOConnection
private
function GetConnectionID: TGUID;
public
// Attention: Some of the functions here (e.g. ConnectionID) require SQL Server
function GetTable(SQL: string; ATimeout: integer=-1): TADODataSet;
function GetScalar(SQL: string; ATimeout: integer=-1): Variant;
procedure ExecSQL(SQL: string; ATimeout: integer=-1);
procedure ExecSQLList(List: TStrings; ATimeout: integer=-1);
procedure Connect(AConnectionString: string; ATimeout: integer=-1);
procedure Disconnect;
class function SQLStringEscape(str: string): string; static;
class function SQLObjectNameEscape(str: string): string; static;
procedure GetPrimaryKeyNames(TableName: string; outsl: TStrings);
property ConnectionID: TGUID read GetConnectionID;
function InsertAndReturnID(query: string): integer;
procedure DropTable(aTableName: string);
function FieldCount(aTableName: string): integer;
function IndexCount(aTableName: string): integer;
function TableExist(aTableName: string): boolean;
function ViewExist(aViewName: string): boolean;
function ColumnExists(aTableName, aColumnName: string): boolean;
procedure GetTableNames(List: TStrings; SystemTables: Boolean=false);
//property TransactionLevel: integer read FTransactionLevel;
end;
implementation
{ TAdoConnectionHelper }
function TAdoConnectionHelper.GetConnectionID: TGUID;
var
s : string;
begin
s := GetScalar('select connection_id from sys.dm_exec_connections ec ' +
'left join sys.dm_exec_sessions se on ec.session_id = se.session_id ' +
'where se.session_id = @@SPID');
result := StringToGUID(s);
end;
procedure TAdoConnectionHelper.GetPrimaryKeyNames(TableName: string; outsl: TStrings);
var
ds: TADODataSet;
begin
ds := TADODataSet.Create(nil);
try
OpenSchema(siPrimaryKeys, Unassigned, EmptyParam, ds);
while not ds.Eof do
begin
if ds.FieldByName('TABLE_NAME').AsString = TableName then
begin
outsl.Add(ds.FieldByName('COLUMN_NAME').AsString);
end;
ds.Next;
end;
ds.Close;
finally
ds.Free;
end;
end;
function TAdoConnectionHelper.GetScalar(SQL: string; ATimeout: integer=-1): Variant;
var
ds: TADODataSet;
begin
ds := GetTable(SQL, ATimeout);
result := ds.Fields[0].AsVariant;
ds.Free;
end;
function TAdoConnectionHelper.GetTable(SQL: string; ATimeout: integer=-1): TADODataSet;
begin
result := TADODataSet.Create(nil);
result.Connection := Self;
result.EnableBCD := false;
result.ParamCheck := false;
result.CommandType := cmdText;
result.CommandText := SQL;
result.DisableControls;
if ATimeout <> -1 then result.CommandTimeout := ATimeout;
result.Active := true;
end;
function TAdoConnectionHelper.ColumnExists(aTableName, aColumnName: string): boolean;
begin
result := GetScalar('select count (*) from sys.columns where Name = '+SQLStringEscape(aColumnName)+' and Object_ID = Object_ID('+SQLStringEscape(aTableName)+')') > 0;
end;
procedure TAdoConnectionHelper.GetTableNames(List: TStrings;
SystemTables: Boolean);
begin
end;
function TAdoConnectionHelper.IndexCount(aTableName: string): integer;
begin
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 ' +
'where name = ''' + aTableName + ''') and ind.status < 10000000');
end;
function TAdoConnectionHelper.InsertAndReturnID(query: string): integer;
resourcestring
LNG_NO_AUTOINC = 'Cannot find AutoIncrement value';
var
q1: TADODataSet;
begin
BeginTrans;
try
ExecSql(query); // Execute(query);
// Hinweis: Das geht nur lokal, nicht über linked servers
// TODO: Man sollte lieber SCOPE_IDENTITY() verwenden
q1 := GetTable('select @@IDENTITY as INSERT_ID;');
try
if (q1.RecordCount = 0) or (q1.{FieldByName('INSERT_ID')}Fields[0].AsInteger = 0) then
begin
//result := -1;
raise EADOError.Create(LNG_NO_AUTOINC);
end;
result := q1.{FieldByName('INSERT_ID')}Fields[0].AsInteger;
finally
FreeAndNil(q1);
end;
finally
CommitTrans;
end;
end;
procedure TAdoConnectionHelper.Connect(AConnectionString: string; ATimeout: integer=-1);
begin
Disconnect;
ConnectionString := AConnectionString;
if ATimeout <> -1 then ConnectionTimeout := ATimeout;
Connected := true;
end;
procedure TAdoConnectionHelper.Disconnect;
begin
Connected := false;
end;
procedure TAdoConnectionHelper.DropTable(aTableName: string);
begin
if ViewExist(aTableName) then
begin
ExecSql('drop view ' + SQLObjectNameEscape(aTableName));
end;
if TableExist(aTableName) then
begin
ExecSql('drop table ' + SQLObjectNameEscape(aTableName));
end;
end;
procedure TAdoConnectionHelper.ExecSQL(SQL: string; ATimeout: integer);
var
cmd: TADOCommand;
begin
cmd := TADOCommand.Create(nil);
try
cmd.Connection := Self;
cmd.ParamCheck := false;
cmd.CommandType := cmdText;
cmd.CommandText := SQL;
if ATimeOut <> -1 then cmd.CommandTimeout := ATimeout;
cmd.Execute;
finally
cmd.Free;
end;
end;
procedure TAdoConnectionHelper.ExecSQLList(List: TStrings; ATimeout: integer);
var
s: string;
begin
for s in List do
begin
ExecSQL(s);
end;
end;
function TAdoConnectionHelper.FieldCount(aTableName: string): integer;
begin
result := GetScalar('select count (*) from syscolumns where id = (select id from sysobjects where name = ''' + aTableName + ''') ');
end;
class function TAdoConnectionHelper.SQLStringEscape(str: string): string;
begin
result := str;
// Escape SQL-Argument
(*
result := StringReplace(result, '\', '\\', [rfReplaceAll]);
result := StringReplace(result, '_', '\_', [rfReplaceAll]);
result := StringReplace(result, '%', '\%', [rfReplaceAll]);
result := StringReplace(result, '[', '\[', [rfReplaceAll]);
result := StringReplace(result, '''', '\''', [rfReplaceAll]);
*)
// DM 29.02.2016 Irgendwie versteh ich das nicht...
// 'xxx\'xxx' ist erlaubt, aber 'xxx\'xxx\'xxx' nicht
// aber 'xxx''xxx''xxx' geht.
result := StringReplace(result, '''', '''''', [rfReplaceAll]);
// Verhindern, dass SQL Server denkt, es sei ein Parameterobjekt
// Brauchen wir nur, wenn die abfrage ParamCheck=true hat.
// Wir haben aber in hl_Datenbank.pas das immer auf false.
// result := StringReplace(result, ':', '::', [rfReplaceAll]);
{$IFDEF UNICODE}
result := 'N''' + result + '''';
{$ELSE}
result := '''' + result + '''';
{$ENDIF}
end;
function TAdoConnectionHelper.TableExist(aTableName: string): boolean;
begin
if Copy(aTableName, 1, 1) = '#' then
begin
// TempTable
result := GetScalar('select case when OBJECT_ID(''tempdb..'+aTableName+''') is not null then ''1'' else ''0'' end') > 0;
end
else
begin
// Physikalische Tabelle (in Schema dbo)
// result := GetScalar('select count (*) from sysobjects where name = ' + aTableName.toSQLString) > 0;
result := GetScalar('SELECT count(*) FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_CATALOG = N'''+DefaultDatabase+''' AND TABLE_SCHEMA = N''dbo'' AND TABLE_NAME = N'''+aTableName+'''') > 0;
end;
end;
function TAdoConnectionHelper.ViewExist(aViewName: string): boolean;
begin
result := GetScalar('select count(*) FROM sys.views where name = '+SQLStringEscape(aViewName)) > 0;
end;
class function TAdoConnectionHelper.SQLObjectNameEscape(str: string): string;
begin
result := '[dbo].[' + str + ']';
end;
end.