mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-25 05:57:23 +01:00
- Fixed bug #4121
- Implemented filtering for sqldb git-svn-id: trunk@615 -
This commit is contained in:
joost
parent
338d4fbe99
commit
5355abf860
@ -424,7 +424,8 @@ begin
|
||||
CheckError('FreeStatement', Status);
|
||||
Statement := nil;
|
||||
end;
|
||||
reAllocMem((cursor as tibcursor).SQLDA,0);
|
||||
// reAllocMem((cursor as tibcursor).SQLDA,0);
|
||||
// ^=bug moet nog ergens anders komen...
|
||||
end;
|
||||
|
||||
procedure TIBConnection.PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams);
|
||||
@ -436,7 +437,7 @@ var dh : pointer;
|
||||
i : integer;
|
||||
|
||||
begin
|
||||
ObtainSQLStatementType(cursor,buf);
|
||||
// ObtainSQLStatementType(cursor,buf);
|
||||
with cursor as TIBcursor do
|
||||
begin
|
||||
dh := GetHandle;
|
||||
|
||||
@ -51,7 +51,7 @@ const
|
||||
'create', 'get', 'put', 'execute',
|
||||
'start','commit','rollback', '?'
|
||||
);
|
||||
SQLDelimiterCharacters = [',',' ','(',')',#13,#10,#9];
|
||||
SQLDelimiterCharacters = [';',',',' ','(',')',#13,#10,#9];
|
||||
|
||||
|
||||
{ TSQLConnection }
|
||||
@ -159,6 +159,10 @@ type
|
||||
FUpdateMode : TUpdateMode;
|
||||
FParams : TParams;
|
||||
FusePrimaryKeyAsKey : Boolean;
|
||||
FSQLBuf : String;
|
||||
FFromPart : String;
|
||||
FWhereStartPos : integer;
|
||||
FWhereStopPos : integer;
|
||||
// FSchemaInfo : TSchemaInfo;
|
||||
|
||||
procedure CloseStatement;
|
||||
@ -173,6 +177,7 @@ type
|
||||
procedure OnChangeSQL(Sender : TObject);
|
||||
|
||||
procedure Execute;
|
||||
Procedure ParseSQL(var SQL : string);
|
||||
protected
|
||||
// abstract & virtual methods of TBufDataset
|
||||
function Fetch : boolean; override;
|
||||
@ -191,6 +196,8 @@ type
|
||||
Function IsPrepared : Boolean; virtual;
|
||||
function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;
|
||||
procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; override;
|
||||
procedure SetFiltered(Value: Boolean); override;
|
||||
procedure SetFilterText(const Value: string); override;
|
||||
public
|
||||
procedure Prepare; virtual;
|
||||
procedure UnPrepare; virtual;
|
||||
@ -202,8 +209,8 @@ type
|
||||
published
|
||||
// redeclared data set properties
|
||||
property Active;
|
||||
// property Filter;
|
||||
// property Filtered;
|
||||
property Filter;
|
||||
property Filtered;
|
||||
// property FilterOptions;
|
||||
property BeforeOpen;
|
||||
property AfterOpen;
|
||||
@ -531,16 +538,57 @@ begin
|
||||
SetFieldData(Field, Buffer);
|
||||
end;
|
||||
|
||||
procedure TSQLQuery.SetFilterText(const Value: string);
|
||||
|
||||
begin
|
||||
if Filtered then
|
||||
begin
|
||||
end;
|
||||
Inherited SetFilterText(Value);
|
||||
end;
|
||||
|
||||
procedure TSQLQuery.SetFiltered(Value: Boolean);
|
||||
|
||||
var S : String;
|
||||
|
||||
begin
|
||||
if (Filtered <> Value) and Active then
|
||||
begin
|
||||
CloseStatement;
|
||||
FIsEOF := False;
|
||||
inherited internalclose;
|
||||
|
||||
s := FSQLBuf;
|
||||
|
||||
if Value then
|
||||
begin
|
||||
if FWhereStartPos = 0 then
|
||||
s := s + ' where (' + Filter + ')'
|
||||
else if FWhereStopPos > 0 then
|
||||
system.insert(' and ('+Filter+') ',S,FWhereStopPos+1)
|
||||
else
|
||||
system.insert(' where ('+Filter+') ',S,FWhereStartPos);
|
||||
end;
|
||||
|
||||
(Database as tsqlconnection).PrepareStatement(Fcursor,(transaction as tsqltransaction),S,FParams);
|
||||
|
||||
|
||||
Execute;
|
||||
inherited InternalOpen;
|
||||
First;
|
||||
|
||||
inherited SetFiltered(Value);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLQuery.Prepare;
|
||||
var
|
||||
Buf : string;
|
||||
db : tsqlconnection;
|
||||
sqltr : tsqltransaction;
|
||||
|
||||
begin
|
||||
if not IsPrepared then
|
||||
begin
|
||||
|
||||
db := (Database as tsqlconnection);
|
||||
sqltr := (transaction as tsqltransaction);
|
||||
if not assigned(Db) then
|
||||
@ -554,12 +602,14 @@ begin
|
||||
if assigned(fcursor) then FreeAndNil(fcursor);
|
||||
FCursor := Db.AllocateCursorHandle;
|
||||
|
||||
buf := TrimRight(FSQL.Text);
|
||||
FSQLBuf := TrimRight(FSQL.Text);
|
||||
|
||||
ParseSQL(FSQLBuf);
|
||||
|
||||
Db.PrepareStatement(Fcursor,sqltr,buf,FParams);
|
||||
Db.PrepareStatement(Fcursor,sqltr,FSQLBuf,FParams);
|
||||
|
||||
if (FCursor.FStatementType = stSelect) and not ReadOnly then
|
||||
InitUpdates(Buf);
|
||||
InitUpdates(FSQLBuf);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -632,98 +682,117 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLQuery.InitUpdates(SQL : string);
|
||||
procedure TSQLQuery.ParseSQL(var SQL : string);
|
||||
|
||||
type TParsePart = (ppStart,ppSelect,ppWhere,ppFrom,ppOrder,ppComment,ppBogus);
|
||||
|
||||
Var
|
||||
L : Integer;
|
||||
P,PP : PChar;
|
||||
PS: PChar;
|
||||
S : string;
|
||||
|
||||
function GetStatement(var StartP : PChar) : PChar;
|
||||
|
||||
var p : pchar;
|
||||
Cmt, Stm : boolean;
|
||||
|
||||
begin
|
||||
p := StartP;
|
||||
Cmt := false;
|
||||
Stm := False;
|
||||
While ((P-PP)<L) do
|
||||
begin
|
||||
if Cmt then
|
||||
begin
|
||||
end
|
||||
else if (p^ in SQLDelimiterCharacters) then
|
||||
begin
|
||||
if stm then break;
|
||||
end
|
||||
else if not stm then
|
||||
begin
|
||||
StartP := p;
|
||||
stm := true;
|
||||
end;
|
||||
inc(p);
|
||||
end;
|
||||
Result := P;
|
||||
end;
|
||||
PSQL,CurrentP,
|
||||
PhraseP, PStatementPart : pchar;
|
||||
S : string;
|
||||
ParsePart : TParsePart;
|
||||
StrLength : Integer;
|
||||
|
||||
begin
|
||||
FUpdateable := False;
|
||||
PSQL:=Pchar(SQL);
|
||||
ParsePart := ppStart;
|
||||
|
||||
L:=Length(SQL);
|
||||
CurrentP := PSQL-1;
|
||||
PhraseP := PSQL;
|
||||
|
||||
FWhereStartPos := 0;
|
||||
FWhereStopPos := 0;
|
||||
|
||||
PP:=Pchar(SQL);
|
||||
P := pp;
|
||||
PS := pp;
|
||||
|
||||
// select-keyword
|
||||
P := GetStatement(PS);
|
||||
|
||||
Setlength(S,P-PS);
|
||||
Move(PS^,S[1],(P-PS));
|
||||
S:=Lowercase(S);
|
||||
|
||||
if (S) <> 'select' then exit;
|
||||
|
||||
// select-part
|
||||
|
||||
While ((P-PP)<L) and (S <> 'from') do
|
||||
repeat
|
||||
begin
|
||||
repeat
|
||||
PS := P;
|
||||
P := GetStatement(PS);
|
||||
until P^ <> ',';
|
||||
inc(CurrentP);
|
||||
|
||||
Setlength(S,P-PS);
|
||||
Move(PS^,S[1],(P-PS));
|
||||
S:=Lowercase(S);
|
||||
if CurrentP^ in [' ',#13,#10,#9,#0,'(',')',';'] then
|
||||
begin
|
||||
if (CurrentP-PhraseP > 0) or (CurrentP^ in [';',#0]) then
|
||||
begin
|
||||
strLength := CurrentP-PhraseP;
|
||||
Setlength(S,strLength);
|
||||
if strLength > 0 then Move(PhraseP^,S[1],(strLength));
|
||||
s := uppercase(s);
|
||||
|
||||
case ParsePart of
|
||||
ppStart : begin
|
||||
FCursor.FStatementType := (Database as tsqlconnection).StrToStatementType(s);
|
||||
if FCursor.FStatementType = stSelect then ParsePart := ppSelect
|
||||
else break;
|
||||
PStatementPart := CurrentP;
|
||||
end;
|
||||
ppSelect : begin
|
||||
if s = 'FROM' then
|
||||
begin
|
||||
ParsePart := ppFrom;
|
||||
PhraseP := CurrentP;
|
||||
PStatementPart := CurrentP;
|
||||
end;
|
||||
end;
|
||||
ppFrom : begin
|
||||
if (s = 'WHERE') or (s = 'ORDER') or (CurrentP^=#0) or (CurrentP^=';') then
|
||||
begin
|
||||
if (s = 'WHERE') then
|
||||
begin
|
||||
ParsePart := ppWhere;
|
||||
StrLength := PhraseP-PStatementPart;
|
||||
end
|
||||
else if (s = 'ORDER') then
|
||||
begin
|
||||
ParsePart := ppOrder;
|
||||
StrLength := PhraseP-PStatementPart
|
||||
end
|
||||
else
|
||||
begin
|
||||
ParsePart := ppBogus;
|
||||
StrLength := CurrentP-PStatementPart;
|
||||
end;
|
||||
Setlength(FFromPart,StrLength);
|
||||
Move(PStatementPart^,FFromPart[1],(StrLength));
|
||||
FFrompart := trim(FFrompart);
|
||||
FWhereStartPos := PStatementPart-PSQL+StrLength+1;
|
||||
PStatementPart := CurrentP;
|
||||
end;
|
||||
end;
|
||||
ppWhere : begin
|
||||
if (s = 'ORDER') or (CurrentP^=#0) or (CurrentP^=';') then
|
||||
begin
|
||||
ParsePart := ppBogus;
|
||||
FWhereStartPos := PStatementPart-PSQL;
|
||||
if s = 'ORDER' then
|
||||
FWhereStopPos := PhraseP-PSQL+1
|
||||
else
|
||||
FWhereStopPos := CurrentP-PSQL+1;
|
||||
end;
|
||||
end;
|
||||
end; {case}
|
||||
end;
|
||||
PhraseP := CurrentP+1;
|
||||
end
|
||||
end;
|
||||
until CurrentP^=#0;
|
||||
if (FWhereStartPos > 0) and (FWhereStopPos > 0) then
|
||||
begin
|
||||
system.insert('(',SQL,FWhereStartPos+1);
|
||||
inc(FWhereStopPos);
|
||||
system.insert(')',SQL,FWhereStopPos);
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TSQLQuery.InitUpdates(SQL : string);
|
||||
|
||||
|
||||
begin
|
||||
if pos(',',FFromPart) > 0 then
|
||||
FUpdateable := False // select-statements from more then one table are not updateable
|
||||
else
|
||||
begin
|
||||
FUpdateable := True;
|
||||
FTableName := FFromPart;
|
||||
end;
|
||||
|
||||
// from-part
|
||||
|
||||
PS := P;
|
||||
P := GetStatement(PS);
|
||||
|
||||
Setlength(FTableName,P-PS);
|
||||
Move(PS^,FTableName[1],(P-PS));
|
||||
|
||||
While ((P-PP)<L) do
|
||||
begin
|
||||
PS := P;
|
||||
P := GetStatement(PS);
|
||||
|
||||
if P^ = ',' then exit; // select-statements from more then one table are not updateable
|
||||
|
||||
Setlength(S,P-PS);
|
||||
Move(PS^,S[1],(P-PS));
|
||||
S:=Lowercase(S);
|
||||
|
||||
if (s = 'where') or (s='order') then break;
|
||||
end;
|
||||
|
||||
FUpdateable := True;
|
||||
end;
|
||||
|
||||
procedure TSQLQuery.InternalOpen;
|
||||
@ -837,7 +906,6 @@ end;
|
||||
function TSQLQuery.ApplyRecUpdate(UpdateKind : TUpdateKind) : boolean;
|
||||
|
||||
var
|
||||
sql_tables : string;
|
||||
s : string;
|
||||
|
||||
procedure UpdateWherePart(var sql_where : string;x : integer);
|
||||
@ -860,7 +928,6 @@ var
|
||||
sql_where : string;
|
||||
|
||||
begin
|
||||
sql_tables := FTableName;
|
||||
sql_set := '';
|
||||
sql_where := '';
|
||||
for x := 0 to Fields.Count -1 do
|
||||
@ -876,7 +943,7 @@ var
|
||||
|
||||
setlength(sql_set,length(sql_set)-1);
|
||||
setlength(sql_where,length(sql_where)-5);
|
||||
result := 'update ' + sql_tables + ' set ' + sql_set + ' where ' + sql_where;
|
||||
result := 'update ' + FTableName + ' set ' + sql_set + ' where ' + sql_where;
|
||||
|
||||
end;
|
||||
|
||||
@ -887,7 +954,6 @@ var
|
||||
sql_values : string;
|
||||
|
||||
begin
|
||||
sql_tables := FTableName;
|
||||
sql_fields := '';
|
||||
sql_values := '';
|
||||
for x := 0 to Fields.Count -1 do
|
||||
@ -901,7 +967,7 @@ var
|
||||
setlength(sql_fields,length(sql_fields)-1);
|
||||
setlength(sql_values,length(sql_values)-1);
|
||||
|
||||
result := 'insert into ' + sql_tables + ' (' + sql_fields + ') values (' + sql_values + ')';
|
||||
result := 'insert into ' + FTableName + ' (' + sql_fields + ') values (' + sql_values + ')';
|
||||
end;
|
||||
|
||||
function DeleteRecQuery : string;
|
||||
@ -910,15 +976,13 @@ var
|
||||
sql_where : string;
|
||||
|
||||
begin
|
||||
sql_tables := FTableName;
|
||||
|
||||
sql_where := '';
|
||||
for x := 0 to Fields.Count -1 do
|
||||
UpdateWherePart(sql_where,x);
|
||||
|
||||
setlength(sql_where,length(sql_where)-5);
|
||||
|
||||
result := 'delete from ' + sql_tables + ' where ' + sql_where;
|
||||
result := 'delete from ' + FTableName + ' where ' + sql_where;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user