Autor Beitrag
Udontknow
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 2596

Win7
D2006 WIN32, .NET (C#)
BeitragVerfasst: Mi 12.11.03 09:53 
Hallo!

Diese Unit kann SQL-Statements um Bedingungen erweitern.

Beispiel:

MergeConditionToSQL('PLZ>=40000','select * from kunden')liefert
ausblenden Delphi-Quelltext
1:
'Select * from kunden where (PLZ>=40000)'					


MergeConditionToSQL('PLZ<50000','Select * from kunden where (PLZ>=40000)')liefert
ausblenden Delphi-Quelltext
1:
'Select * from kunden where ((PLZ>=40000) and (PLZ<50000))'					


Es ist auch möglich, mehrere Werte für ein Feld Oder-verknüpft einzufügen:

ausblenden Delphi-Quelltext
1:
2:
3:
StrL.Add('12345');
StrL.Add('54321');
MergeIDListToSQL(StrL,'select * from kunden','KundenNr',[]);

ergibt
ausblenden Delphi-Quelltext
1:
'select * from kunden where (KundenNr=12345) or (KundenNr=54321))'					


Wenn diese Werte sich auf Stringfelder beziehen, können die Parameter clString, clPartialString und clPartialStringAnyWhere für Stringvergleiche eingesetzt werden.

ausblenden Delphi-Quelltext
1:
2:
3:
StrL.Add('Schulz');
StrL.Add('Schmidt');
MergeIDListToSQL(StrL,'select * from kunden','Name',[clPartialStringAnyWhere]);

ergibt
ausblenden Delphi-Quelltext
1:
'select * from Kunden where ((Name like '%Schulz%') or (Name like '%Schmidt%'))'					


Sämtliche Aufrufe sind beliebig oft kaskadierbar. Die letzte verschmolzene Bedingung kann per RemoveCondition auch wieder entfernt werden.

Für Filterbestückung stehen die Funktionen MergeConditions bzw. MergeIdListToFilter zur Verfügung.

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
unit ConditionMerger;

{
*** Unit ConditionMerger ***
Diese Unit kapselt Funktionalitäten zum Verschmelzen von Bedingungen
in SQL-Statements bzw. Filter.
}


interface

uses classes;

type TConditionListOption=(clString,clPartialString,clPartialStringAnyWhere,clNoRecordsIfEmpty);
type TConditionListOptions=set of TConditionListOption;

//Verknüpft zwei Bedingungen miteinander (Boolscher Operator: AND)
//Nutzbar für Property Filter von Datasets
function MergeConditions(Condition1,Condition2:String):String;

//Entfernt die letzte verschmolzene Condition
function RemoveCondition(Str:String):String;

//Entfernt die letzte verschmolzene Condition aus einem SQL-Statement
function RemoveConditionFromSQL(SQLText:String):String;

//Ergänzt eine SQL-Select-Abfrage um eine Bedingung (AND-Verknüpfung)
function MergeConditionToSQL(Condition,SqlText:String):String;

//Ergänzt eine SQL-Select-Abfrage um die Einschränkungen der in IDList
//angegebenen Werte
function MergeIDListToSQL(IDList:TStrings; SqlText,FieldName: String; Options:TConditionListOptions=[]):String;

//Ergänzt eine SQL-Select-Abfrage um die Einschränkungen der in IDList
//angegebenen Werte
function MergeIDListToFilter(IDList:TStrings; FilterText,FieldName: String; Options:TConditionListOptions=[]):String;

//Erstellt eine Bedingung aus einer Liste von Strings (OR-Verknüpfung)
function IDListToCondition(IDList:TStrings; FieldName:String; Options:TConditionListOptions=[]):String;

//Erstellt anhand des vorgegebenen SQLStatements, das CountStatement
function GetCountStatementFromSql(SQLStatement : string) : string;


implementation

uses JVStrUtils, SysUtils;

procedure AnalyseSQLStatement(SQLText:Stringvar SelectStr,WhereStr,OrderStr:String);
var WhereStart,WhereEnd:integer;
begin
  //Initialisierung
  WhereStart:=Length(SQLText)+1;
  WhereEnd:=WhereStart;

  //Start des WhereStatements bestimmen
  if Pos('WHERE',UpperCase(SqlText))>0 then
    WhereStart:=Pos('WHERE',UpperCase(SqlText));

  //Ende des WhereStatements bestimmen
  if (Pos('GROUP BY',Uppercase(SQLText))>0)
  and (WhereEnd>Pos('GROUP BY',Uppercase(SQLText))) then
    WhereEnd:=Pos('GROUP BY',Uppercase(SQLText));
  if (Pos('HAVING BY',Uppercase(SQLText))>0)
  and (WhereEnd>Pos('HAVING BY',Uppercase(SQLText))) then
    WhereEnd:=Pos('HAVING BY',Uppercase(SQLText));
  if (Pos('ORDER BY',Uppercase(SQLText))>0)
  and (WhereEnd>Pos('ORDER BY',Uppercase(SQLText))) then
    WhereEnd:=Pos('ORDER BY',Uppercase(SQLText));

  if WhereStart>WhereEnd then
    WhereStart:=WhereEnd;

  //Str in drei Teile zerpflücken
  SelectStr:=Copy(SQLText,1,WhereStart-1);
  WhereStr:=Copy(SQLText,WhereStart,WhereEnd-WhereStart);
  OrderStr:=Copy(SQLText,WhereEnd,Length(SQLTExt)-WhereEnd+1);

  //Schlüsselwort "Where" ausschneiden
  if Length(WhereStr)>=1 then
    WhereStr:=Copy(WhereStr,6,Length(WhereStr)-5);
end;

function Geklammert(Condition:String):Boolean;
var i,Tiefe:integer;
begin
  Result:=True;
  Condition:=Trim(Condition);
  Tiefe:=0;
  for i:=1 to Length(Condition) do
  begin
    if (i=1and (Condition[i]<>'('then
    begin
      Result:=False;
      exit;
    end;
    if Condition[i]='(' then
      Inc(Tiefe);
    if Tiefe=0 then
    begin
      Result:=False;
      exit;
    end;
    if Condition[i]=')' then
      Dec(Tiefe);
  end;
  if Tiefe<>0 then
    raise Exception.Create('Syntaxfehler: Klammerung falsch.');
end;

function EntferneKlammern(Condition:String):String;
begin
  Condition:=Trim(Condition);
  Result:=Copy(Condition,2,Length(Condition)-2);
end;

function MergeIDListToSQL(IDList:TStrings; SqlText,FieldName: String; Options:TConditionListOptions):String;
var Condition:String;
begin
  //Bedingung formulieren
  Condition:=IDListToCondition(IDList,FieldName,Options);

  //Bedingung in SQL-Statement integrieren
  Result:=MergeConditionToSQL(Condition,SQLText);
end;


function MergeConditionToSQL(Condition, SqlText:String): String;
var SelectStr,WhereStr,OrderStr:String;
begin
  //SQL-Statement zerlegen
  AnalyseSQLStatement(SQLText,SelectStr,WhereStr,OrderStr);

  //Bedingungen zusammenfügen
  WhereStr:=MergeConditions(WhereStr,Condition);

  //Where-Statement wieder aufbauen
  if WhereStr<>'' then
    WhereStr:=' where '+WhereStr+' ';

  //Teile zusammenfügen
  Result:=Trim(SelectStr)+' '+Trim(WhereStr)+' '+Trim(OrderStr);
end;

function MergeConditions(Condition1,
  Condition2: String): String;
begin
  //Leerzeichen entfernen
  Condition1:=Trim(Condition1);
  Condition2:=Trim(Condition2);

  Result:='';
  //Keine Bedingungen?
  if (Condition1=''and (Condition2=''then
    exit;

  if (Condition1=''then
    Result:=Condition2
  else
  if (Condition2=''then
    Result:=Condition1
  else
    Result:='('+Condition1+') and ('+Condition2+')';
end;


function IDListToCondition(IDList:TStrings; FieldName:String;
Options:TConditionListOptions):String;
var Condition:String;
var i:integer;
begin
  //Bedingung formulieren
  Condition:='';
  for i:=0 to IDList.Count-1 do
  begin

    //Je nach Option Bedingung formulieren
    if (clString in Options) then
      Condition:=Condition+'('+FieldName+'='''+IDList[i]+''')'
    else
    if (clPartialString in Options) then
      Condition:=Condition+'('+FieldName+' starting with '''+IDList[i]+''')'
    else
    if (clPartialStringAnyWhere in Options) then
      Condition:=Condition+'('+FieldName+' like ''%'+IDList[i]+'%'')'
    else
      Condition:=Condition+'('+FieldName+'='+IDList[i]+')';

    if i<IDList.Count-1 then
      Condition:=Condition+' or ';
  end;

  if (IDList.Count=0then
    if (clNoRecordsIfEmpty in Options) then
      Condition:='0=1'
    else
      Condition:='1=1';

  //Ausgabe der zusammengesetzten Bedingung
  Result:=Condition;
end;

function MergeIDListToFilter(IDList: TStrings; FilterText,
  FieldName: String; Options:TConditionListOptions): String;
var Condition:String;
begin
  //Bedingung formulieren
  Condition:=IDListToCondition(IDList,FieldName,Options);

  //Bedingung in SQL-Statement integrieren
  Result:=MergeConditions(FilterText,Condition);

end;

function RemoveConditionFromSQL(SQLText:String):String;
var SelectStr,WhereStr,OrderStr:String;
begin
  //Statement zerlegen
  AnalyseSQLStatement(SQLText,SelectStr,WhereStr,OrderStr);

  //Letzte Bedingung entfernen
  WhereStr:=RemoveCondition(WhereStr);

  //Where-Statement wieder aufbauen
  if WhereStr<>'' then
    WhereStr:=' where '+WhereStr+' ';

  //Teile zusammenfügen
  Result:=Trim(SelectStr)+' '+Trim(WhereStr)+' '+Trim(OrderStr);
end;

function RemoveCondition(Str:String):String;
var i,j,Tiefe:integer;
begin
  if Str='' then
    raise Exception.Create('Keine Bedingungen vorhanden!');

  Result:='';
  Tiefe:=0;

  //AND ausserhalb von Klammern finden
  for i:=1 to Length(Str)-2 do
  begin
    if Str[i]='(' then
    begin
      Inc(Tiefe);
      if Tiefe<0 then
        raise Exception.Create('Syntaxfehler: Klammerung falsch.');
      Continue;
    end
    else
    if Str[i]=')' then
    begin
      Dec(Tiefe);
      if Tiefe<0 then
        raise Exception.Create('Syntaxfehler: Klammerung falsch.');
      Continue;
    end;

    if (UpperCase(Str[i])='A')
    and (UpperCase(Str[i+1])='N')
    and (UpperCase(Str[i+2])='D')
    and (Tiefe=0then
    begin

      //Result bauen (äussere Klammerung weglassen, bis AND gehen)
      Tiefe:=0;
      Result:='';
      for j:=1 to i-1 do
      begin
        if Str[j]='(' then
          Inc(Tiefe)
        else
        if Tiefe<0 then
          raise Exception.Create('Syntaxfehler: Klammerung falsch.');

        if Tiefe>0 then
          Result:=Result+Str[j];

        if Str[j]=')' then
          Dec(Tiefe);
      end;

      Result:=Trim(Result);
      if Geklammert(Result) then
        Result:=EntferneKlammern(Result);

      //Funktion verlassen
      exit;
    end;
  end;
end;


function GetCountStatementFromSql(SQLStatement : string) : string;
VAR SelectPos,FromPos : integer;
   WhereStart,WhereEnd:integer;
Begin
 SQLStatement := Trim(SQLStatement);

 SelectPos := POS('SELECT ',UPPERCASE(SQLStatement));
 FromPos   := POS('FROM ',UPPERCASE(SQLStatement));
 If (SelectPos = 0OR (FromPos = 0)  Then
  raise Exception.Create('Syntaxfehler: Es handelt sich um kein Select-Statement.');

 //Initialisierung
 WhereStart:=Length(SQLStatement)+1;
 WhereEnd:=WhereStart;

 //Start des WhereStatements bestimmen
 if Pos('WHERE',UpperCase(SQLStatement))>0 then
   WhereStart:=Pos('WHERE',UpperCase(SQLStatement));

 //Ende des WhereStatements bestimmen
 if (Pos('GROUP BY',Uppercase(SQLStatement))>0)
 and (WhereEnd>Pos('GROUP BY',Uppercase(SQLStatement))) then
   WhereEnd:=Pos('GROUP BY',Uppercase(SQLStatement));
 if (Pos('HAVING BY',Uppercase(SQLStatement))>0)
 and (WhereEnd>Pos('HAVING BY',Uppercase(SQLStatement))) then
   WhereEnd:=Pos('HAVING BY',Uppercase(SQLStatement));
 if (Pos('ORDER BY',Uppercase(SQLStatement))>0)
 and (WhereEnd>Pos('ORDER BY',Uppercase(SQLStatement))) then
   WhereEnd:=Pos('ORDER BY',Uppercase(SQLStatement));

 if WhereStart>WhereEnd then
   WhereStart:=WhereEnd;

 result := 'Select Count(*) From '+ Copy(SQLStatement,FromPos+4,WhereEnd-FromPos-4);
End;


end.


Cu, :)
Udontknow