- Fixed bug #4121

- Implemented filtering for sqldb

git-svn-id: trunk@615 -

fcl/db/sqldb/interbase/ibconnection.pp

@@ -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;

fcl/db/sqldb/sqldb.pp

@@ -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 Filter;
-//    property Filtered;
+    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;
+  PSQL,CurrentP,
-  P,PP    : PChar;
+  PhraseP, PStatementPart : pchar;
-  PS: PChar;
+  S                       : string;
-  S       : string;
+  ParsePart               : TParsePart;
-
+  StrLength               : Integer;
-  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;
 
 begin
-  FUpdateable := False;
+  PSQL:=Pchar(SQL);
+  ParsePart := ppStart;
 
-  L:=Length(SQL);
+  CurrentP := PSQL-1;
+  PhraseP := PSQL;
+  
+  FWhereStartPos := 0;
+  FWhereStopPos := 0;
 
-  PP:=Pchar(SQL);
+  repeat
-  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
     begin
-    repeat
+    inc(CurrentP);
-    PS := P;
-    P := GetStatement(PS);
-    until P^ <> ',';
 
-    Setlength(S,P-PS);
+    if CurrentP^ in [' ',#13,#10,#9,#0,'(',')',';'] then
-    Move(PS^,S[1],(P-PS));
+      begin
-    S:=Lowercase(S);
+      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