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 (12 months, 2 weeks ago) by daniel-marschall
Content type: text/x-pascal
File size: 8191 byte(s)

File Contents

# User Rev Content
1 daniel-marschall 7 unit AdoConnHelper;
2    
3     (*
4     * Class helper for TAdoConnection
5     * by Daniel Marschall, ViaThinkSoft <www.viathinksoft.com>
6 daniel-marschall 8 * Revision: 14 June 2021
7 daniel-marschall 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 daniel-marschall 8 if ATimeout <> -1 then
95     result.CommandTimeout := ATimeout
96     else
97     result.CommandTimeout := self.CommandTimeout;
98 daniel-marschall 7 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 daniel-marschall 8 if ATimeOut <> -1 then
183     cmd.CommandTimeout := ATimeout
184     else
185     cmd.CommandTimeout := self.CommandTimeout;
186 daniel-marschall 7 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 daniel-marschall 8 ExecSQL(s, ATimeout);
199 daniel-marschall 7 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.