Subversion Repositories indexer_suite

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.