Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/indexer_suite/trunk/AdoConnHelper.pas
Revision: 8
Committed: Sun Jun 13 22:42:19 2021 UTC (11 months, 1 week ago) by daniel-marschall
Content type: text/x-pascal
File size: 8191 byte(s)

File Contents

# Content
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.