Ne için kullanıldığına gelirsek. Tutun ki bir arama dialog'unuz var. Burada isim, soyadı, sicil no, adresi gibi kriterler ile tabloda arama yapmak istiyorsunuz. Bunun SQL'ini nasıl düzenlerdiniz? İsim kutusu ve Adres kutusu doldurulduğunda ona göre SQL üretilmeli. Sadece isim kutusu doldurulduğunda da ona göre bir üretim dinamik olarak gerçekleşmeli. Bu olay FibPlus bileşenlerinde mevcut. Ben de oradan esinlenerek bunu oluşturdum. Sadece = sorgusu değil, CONTAINING, IN vs.. gibi operatorleri de desteklediğini ve olabildiğince esnek tutulduğunu göreceksiniz.
Sınıfın testini tam olarak yapmadığımdan bazı durumlarda hatalı SQL üretebilir, belki de üretmez.
Kullanımını bir sonraki mesajda açıklıyorum.
Kod: Tümünü seç
{ Furkan Duman 2005, Kod LGPL lisansı ile kullanılabilir }
unit WhereFilter;
interface
uses Classes;
type
TValueKind = (vkText, vkNumeric);
TCompareKind = (ckEqual, ckBigger, ckSmaller, ckIN, ckNOT_IN,
ckCONTAINING, ckBigEqual, ckSmallEqual, ckIS, ckIS_NOT, ckLIKE,
ckSTARTING);
TWhereField = class
private
FName: string;
FValue: string;
FValueKind: TValueKind;
FCompareKind: TCompareKind;
function GetClause: string;
function GetCompareOperator: string;
function GetValueByKind: string;
public
property Name: string read FName write FName;
property Value: string read FValue write FValue;
property ValueKind: TValueKind read FValueKind write FValueKind;
property CompareKind: TCompareKind read FCompareKind write FCompareKind;
property Clause: string read GetClause;
end;
TWhereFields = class
private
FList: TList;
FSQL: TStringList;
FChangedSQL: TStringList;
function GetCount: Integer;
function GetWhereField(const Index: Integer): TWhereField;
function GetWhereText: string;
procedure SetSQL(const Value: TStringList);
function GetChangedSQL: TStringList;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure AddField(const AName, AValue: string;
AValueKind: TValueKind; ACompareKind: TCompareKind);
property Count: Integer read GetCount;
property Fields[const Index: Integer]: TWhereField read
GetWhereField; default;
property SQL: TStringList read FSQL write SetSQL;
property ChangedSQL: TStringList read GetChangedSQL;
end;
implementation
uses SysUtils;
{ TWhereField }
function TWhereField.GetClause: string;
begin
// Value'da değer yoksa clause boş döner
if Trim(FValue) <> '' then
Result:= Format('%s %s %s', [FName, GetCompareOperator, GetValueByKind])
else
Result:= '';
end;
function TWhereField.GetCompareOperator: string;
begin
case FCompareKind of
ckEqual: Result:= '=';
ckBigger: Result:= '>';
ckSmaller: Result:= '<';
ckBigEqual: Result:= '>=';
ckSmallEqual: Result:= '<=';
ckIn: Result:= 'IN';
ckNOT_IN: Result:= 'NOT IN';
ckIS: Result:= 'IS';
ckIS_NOT: Result:= 'IS NOT';
ckContaining: Result:= 'CONTAINING';
ckLike: Result:= 'LIKE';
ckStarting: Result:= 'STARTING';
else
Result:= '';
end;
end;
function TWhereField.GetValueByKind: string;
begin
case FValueKind of
vkText: Result:= QuotedStr(FValue);
else
Result:= FValue;
end;
end;
{ TWhereFields }
procedure TWhereFields.AddField(const AName, AValue: string;
AValueKind: TValueKind; ACompareKind: TCompareKind);
var
WhereField: TWhereField;
begin
WhereField:= TWhereField.Create;
with WhereField do
begin
Name:= AName;
Value:= AValue;
ValueKind:= AValueKind;
CompareKind:= ACompareKind;
end;
FList.Add(WhereField);
end;
procedure TWhereFields.Clear;
var
I: Integer;
WhereField: TWhereField;
begin
for I:= 0 to FList.Count - 1 do
begin
WhereField:= TWhereField(FList[I]);
FreeAndNil(WhereField);
end;
FList.Clear;
end;
constructor TWhereFields.Create;
begin
FList:= TList.Create;
FSQL:= TStringList.Create;
FChangedSQL:= TStringList.Create;
end;
destructor TWhereFields.Destroy;
begin
Clear;
FList.Free;
FSQL.Free;
FChangedSQL.Free;
inherited Destroy;
end;
function TWhereFields.GetChangedSQL: TStringList;
const
WhereClause = 'WHERE';
var
WhereIndex, OrderByIndex: Integer;
TempStr: string;
WhereText: string;
begin
TempStr:= FSQL.Text;
WhereText:= GetWhereText;
if WhereText <> '' then
begin
WhereIndex:= Pos(WhereClause, Uppercase(TempStr));
OrderByIndex:= Pos('ORDER BY', Uppercase(TempStr));
if WhereIndex > 0 then
Insert(' ' + WhereText + ' AND ', TempStr, WhereIndex + 5)
else
if OrderByIndex > 0 then
Insert(WhereClause + ' ' + WhereText + #$0D#$0A, TempStr, OrderByIndex)
else
TempStr:= TempStr + WhereClause + ' ' + WhereText;
end;
FChangedSQL.Text:= TempStr;
Result:= FChangedSQL;
end;
function TWhereFields.GetCount: Integer;
begin
Result:= FList.Count;
end;
function TWhereFields.GetWhereField(const Index: Integer): TWhereField;
begin
Result:= FList[Index];
end;
function TWhereFields.GetWhereText: string;
var
I: Integer;
begin
for I:= 0 to Count - 1 do
begin
if Fields[I].Clause <> '' then
if Result <> '' then
Result:= Format('%s %s %s', [Result, ' AND ', Fields[I].Clause])
else
Result:= Fields[I].Clause;
end;
if Result <> '' then
Result:= '(' + Result + ')';
end;
procedure TWhereFields.SetSQL(const Value: TStringList);
begin
FSQL.Assign(Value);
end;
end.
