| 1 |
unit AdoConnHelper; |
| 2 |
|
| 3 |
(* |
| 4 |
* Class helper for TAdoConnection |
| 5 |
* by Daniel Marschall, ViaThinkSoft <www.viathinksoft.com> |
| 6 |
* Revision: 14 June 2021 |
| 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 |
| 95 |
result.CommandTimeout := ATimeout |
| 96 |
else |
| 97 |
result.CommandTimeout := self.CommandTimeout; |
| 98 |
result.Active := true; |
| 99 |
end; |
| 100 |
|
| 101 |
function TAdoConnectionHelper.ColumnExists(aTableName, aColumnName: string): boolean; |
| 102 |
begin |
| 103 |
result := GetScalar('select count (*) from sys.columns where Name = '+SQLStringEscape(aColumnName)+' and Object_ID = Object_ID('+SQLStringEscape(aTableName)+')') > 0; |
| 104 |
end; |
| 105 |
|
| 106 |
procedure TAdoConnectionHelper.GetTableNames(List: TStrings; |
| 107 |
SystemTables: Boolean); |
| 108 |
begin |
| 109 |
|
| 110 |
end; |
| 111 |
|
| 112 |
function TAdoConnectionHelper.IndexCount(aTableName: string): integer; |
| 113 |
begin |
| 114 |
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 ' + |
| 115 |
'where name = ''' + aTableName + ''') and ind.status < 10000000'); |
| 116 |
end; |
| 117 |
|
| 118 |
function TAdoConnectionHelper.InsertAndReturnID(query: string): integer; |
| 119 |
resourcestring |
| 120 |
LNG_NO_AUTOINC = 'Cannot find AutoIncrement value'; |
| 121 |
var |
| 122 |
q1: TADODataSet; |
| 123 |
begin |
| 124 |
BeginTrans; |
| 125 |
try |
| 126 |
ExecSql(query); // Execute(query); |
| 127 |
|
| 128 |
// Hinweis: Das geht nur lokal, nicht über linked servers |
| 129 |
// TODO: Man sollte lieber SCOPE_IDENTITY() verwenden |
| 130 |
q1 := GetTable('select @@IDENTITY as INSERT_ID;'); |
| 131 |
try |
| 132 |
if (q1.RecordCount = 0) or (q1.{FieldByName('INSERT_ID')}Fields[0].AsInteger = 0) then |
| 133 |
begin |
| 134 |
//result := -1; |
| 135 |
raise EADOError.Create(LNG_NO_AUTOINC); |
| 136 |
end; |
| 137 |
|
| 138 |
result := q1.{FieldByName('INSERT_ID')}Fields[0].AsInteger; |
| 139 |
finally |
| 140 |
FreeAndNil(q1); |
| 141 |
end; |
| 142 |
finally |
| 143 |
CommitTrans; |
| 144 |
end; |
| 145 |
end; |
| 146 |
|
| 147 |
procedure TAdoConnectionHelper.Connect(AConnectionString: string; ATimeout: integer=-1); |
| 148 |
begin |
| 149 |
Disconnect; |
| 150 |
ConnectionString := AConnectionString; |
| 151 |
if ATimeout <> -1 then ConnectionTimeout := ATimeout; |
| 152 |
Connected := true; |
| 153 |
end; |
| 154 |
|
| 155 |
procedure TAdoConnectionHelper.Disconnect; |
| 156 |
begin |
| 157 |
Connected := false; |
| 158 |
end; |
| 159 |
|
| 160 |
procedure TAdoConnectionHelper.DropTable(aTableName: string); |
| 161 |
begin |
| 162 |
if ViewExist(aTableName) then |
| 163 |
begin |
| 164 |
ExecSql('drop view ' + SQLObjectNameEscape(aTableName)); |
| 165 |
end; |
| 166 |
if TableExist(aTableName) then |
| 167 |
begin |
| 168 |
ExecSql('drop table ' + SQLObjectNameEscape(aTableName)); |
| 169 |
end; |
| 170 |
end; |
| 171 |
|
| 172 |
procedure TAdoConnectionHelper.ExecSQL(SQL: string; ATimeout: integer); |
| 173 |
var |
| 174 |
cmd: TADOCommand; |
| 175 |
begin |
| 176 |
cmd := TADOCommand.Create(nil); |
| 177 |
try |
| 178 |
cmd.Connection := Self; |
| 179 |
cmd.ParamCheck := false; |
| 180 |
cmd.CommandType := cmdText; |
| 181 |
cmd.CommandText := SQL; |
| 182 |
if ATimeOut <> -1 then |
| 183 |
cmd.CommandTimeout := ATimeout |
| 184 |
else |
| 185 |
cmd.CommandTimeout := self.CommandTimeout; |
| 186 |
cmd.Execute; |
| 187 |
finally |
| 188 |
cmd.Free; |
| 189 |
end; |
| 190 |
end; |
| 191 |
|
| 192 |
procedure TAdoConnectionHelper.ExecSQLList(List: TStrings; ATimeout: integer); |
| 193 |
var |
| 194 |
s: string; |
| 195 |
begin |
| 196 |
for s in List do |
| 197 |
begin |
| 198 |
ExecSQL(s, ATimeout); |
| 199 |
end; |
| 200 |
end; |
| 201 |
|
| 202 |
function TAdoConnectionHelper.FieldCount(aTableName: string): integer; |
| 203 |
begin |
| 204 |
result := GetScalar('select count (*) from syscolumns where id = (select id from sysobjects where name = ''' + aTableName + ''') '); |
| 205 |
end; |
| 206 |
|
| 207 |
class function TAdoConnectionHelper.SQLStringEscape(str: string): string; |
| 208 |
begin |
| 209 |
result := str; |
| 210 |
|
| 211 |
// Escape SQL-Argument |
| 212 |
(* |
| 213 |
result := StringReplace(result, '\', '\\', [rfReplaceAll]); |
| 214 |
result := StringReplace(result, '_', '\_', [rfReplaceAll]); |
| 215 |
result := StringReplace(result, '%', '\%', [rfReplaceAll]); |
| 216 |
result := StringReplace(result, '[', '\[', [rfReplaceAll]); |
| 217 |
result := StringReplace(result, '''', '\''', [rfReplaceAll]); |
| 218 |
*) |
| 219 |
|
| 220 |
// DM 29.02.2016 Irgendwie versteh ich das nicht... |
| 221 |
// 'xxx\'xxx' ist erlaubt, aber 'xxx\'xxx\'xxx' nicht |
| 222 |
// aber 'xxx''xxx''xxx' geht. |
| 223 |
result := StringReplace(result, '''', '''''', [rfReplaceAll]); |
| 224 |
|
| 225 |
// Verhindern, dass SQL Server denkt, es sei ein Parameterobjekt |
| 226 |
// Brauchen wir nur, wenn die abfrage ParamCheck=true hat. |
| 227 |
// Wir haben aber in hl_Datenbank.pas das immer auf false. |
| 228 |
// result := StringReplace(result, ':', '::', [rfReplaceAll]); |
| 229 |
|
| 230 |
{$IFDEF UNICODE} |
| 231 |
result := 'N''' + result + ''''; |
| 232 |
{$ELSE} |
| 233 |
result := '''' + result + ''''; |
| 234 |
{$ENDIF} |
| 235 |
end; |
| 236 |
|
| 237 |
function TAdoConnectionHelper.TableExist(aTableName: string): boolean; |
| 238 |
begin |
| 239 |
if Copy(aTableName, 1, 1) = '#' then |
| 240 |
begin |
| 241 |
// TempTable |
| 242 |
result := GetScalar('select case when OBJECT_ID(''tempdb..'+aTableName+''') is not null then ''1'' else ''0'' end') > 0; |
| 243 |
end |
| 244 |
else |
| 245 |
begin |
| 246 |
// Physikalische Tabelle (in Schema dbo) |
| 247 |
// result := GetScalar('select count (*) from sysobjects where name = ' + aTableName.toSQLString) > 0; |
| 248 |
result := GetScalar('SELECT count(*) FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_CATALOG = N'''+DefaultDatabase+''' AND TABLE_SCHEMA = N''dbo'' AND TABLE_NAME = N'''+aTableName+'''') > 0; |
| 249 |
end; |
| 250 |
end; |
| 251 |
|
| 252 |
function TAdoConnectionHelper.ViewExist(aViewName: string): boolean; |
| 253 |
begin |
| 254 |
result := GetScalar('select count(*) FROM sys.views where name = '+SQLStringEscape(aViewName)) > 0; |
| 255 |
end; |
| 256 |
|
| 257 |
class function TAdoConnectionHelper.SQLObjectNameEscape(str: string): string; |
| 258 |
begin |
| 259 |
result := '[dbo].[' + str + ']'; |
| 260 |
end; |
| 261 |
|
| 262 |
end. |
