-some filter fixes

- added ParseSQL property
- added DeAllocateCursorHandle
- fixed tibconnection string-parameters

git-svn-id: trunk@620 -

fcl/db/sqldb/interbase/ibconnection.pp

@@ -67,6 +67,7 @@ type
     function GetHandle : pointer; override;
 
     Function AllocateCursorHandle : TSQLCursor; override;
+    Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); override;
     Function AllocateTransactionHandle : TSQLHandle; override;
 
     procedure CloseStatement(cursor : TSQLCursor); override;
@@ -410,6 +411,17 @@ begin
   result := curs;
 end;
 
+procedure TIBConnection.DeAllocateCursorHandle(var cursor : TSQLCursor);
+
+begin
+  if assigned(cursor) then with cursor as TIBCursor do
+    begin
+    reAllocMem(SQLDA,0);
+    reAllocMem(in_SQLDA,0);
+    end;
+  FreeAndNil(cursor);
+end;
+
 Function TIBConnection.AllocateTransactionHandle : TSQLHandle;
 
 begin
@@ -424,8 +436,6 @@ begin
       CheckError('FreeStatement', Status);
     Statement := nil;
     end;
-//  reAllocMem((cursor as tibcursor).SQLDA,0);
-// ^=bug moet nog ergens anders komen...
 end;
 
 procedure TIBConnection.PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams);
@@ -585,6 +595,7 @@ var ParNr,SQLVarNr : integer;
     s               : string;
     i               : integer;
     currbuff        : pchar;
+    w               : word;
 
 begin
 {$R-}
@@ -607,7 +618,17 @@ begin
           begin
           {$R-}
           s := AParams[ParNr].AsString;
-          Move(s[1], in_sqlda^.SQLvar[SQLVarNr].SQLData^, length(s));
+          w := length(s);
+          if ((in_sqlda^.SQLvar[SQLVarNr].SQLType and not 1) = SQL_VARYING) then
+            begin
+            in_sqlda^.SQLvar[SQLVarNr].SQLLen := w;
+            in_sqlda^.SQLvar[SQLVarNr].SQLData := AllocMem(in_SQLDA^.SQLVar[SQLVarNr].SQLLen+2)
+            end;
+
+          CurrBuff := in_sqlda^.SQLvar[SQLVarNr].SQLData;
+          move(w,CurrBuff^,sizeof(w));
+          inc(CurrBuff,2);
+          Move(s[1], CurrBuff^, length(s));
           {$R+}
           end;
       else

fcl/db/sqldb/mysql/mysql4conn.pas

@@ -51,6 +51,7 @@ Type
     function GetHandle : pointer; override;
 
     Function AllocateCursorHandle : TSQLCursor; override;
+    Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); override;
     Function AllocateTransactionHandle : TSQLHandle; override;
 
     procedure CloseStatement(cursor : TSQLCursor); override;
@@ -206,6 +207,12 @@ begin
   Result:=TMySQLCursor.Create;
 end;
 
+Procedure TMySQLConnection.DeAllocateCursorHandle(var cursor : TSQLCursor);
+
+begin
+  FreeAndNil(cursor);
+end;
+
 function TMySQLConnection.AllocateTransactionHandle: TSQLHandle;
 begin
   Result:=TMySQLTransaction.Create;

fcl/db/sqldb/postgres/pqconnection.pp

@@ -42,6 +42,7 @@ type
     function GetHandle : pointer; override;
 
     Function AllocateCursorHandle : TSQLCursor; override;
+    Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); override;
     Function AllocateTransactionHandle : TSQLHandle; override;
 
     procedure CloseStatement(cursor : TSQLCursor); override;
@@ -319,6 +320,12 @@ begin
   result := TPQCursor.create;
 end;
 
+Procedure TPQConnection.DeAllocateCursorHandle(var cursor : TSQLCursor);
+
+begin
+  FreeAndNil(cursor);
+end;
+
 Function TPQConnection.AllocateTransactionHandle : TSQLHandle;
 
 begin

fcl/db/sqldb/sqldb.pp

@@ -76,6 +76,7 @@ type
     function GetHandle : pointer; virtual; abstract;
 
     Function AllocateCursorHandle : TSQLCursor; virtual; abstract;
+    Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); virtual; abstract;
     Function AllocateTransactionHandle : TSQLHandle; virtual; abstract;
 
     procedure PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams); virtual; abstract;
@@ -163,6 +164,7 @@ type
     FFromPart            : String;
     FWhereStartPos       : integer;
     FWhereStopPos        : integer;
+    FParseSQL            : boolean;
 //    FSchemaInfo          : TSchemaInfo;
 
     procedure CloseStatement;
@@ -172,12 +174,14 @@ type
     function GetStatementType : TStatementType;
     procedure SetIndexDefs(AValue : TIndexDefs);
     procedure SetReadOnly(AValue : Boolean);
+    procedure SetParseSQL(AValue : Boolean);
     procedure SetUsePrimaryKeyAsKey(AValue : Boolean);
     procedure SetUpdateMode(AValue : TUpdateMode);
     procedure OnChangeSQL(Sender : TObject);
 
     procedure Execute;
-    Procedure ParseSQL(var SQL : string);
+    Procedure SQLParser(var SQL : string);
+    Function AddFilter(SQLstr : string) : string;
   protected
     // abstract & virtual methods of TBufDataset
     function Fetch : boolean; override;
@@ -194,10 +198,8 @@ type
     function  GetCanModify: Boolean; override;
     function ApplyRecUpdate(UpdateKind : TUpdateKind) : boolean; override;
     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;
@@ -246,6 +248,7 @@ type
     property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode;
     property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey;
     property StatementType : TStatementType read GetStatementType;
+    property ParseSQL : Boolean read FParseSQL write SetParseSQL;
 //    property SchemaInfo : TSchemaInfo read FSchemaInfo default stNoSchema;
   end;
 
@@ -526,25 +529,22 @@ begin
   Result := Assigned(FCursor) and FCursor.FPrepared;
 end;
 
-function TSQLQuery.GetFieldData(Field: TField; Buffer: Pointer;
-  NativeFormat: Boolean): Boolean;
-begin
-  Result:=GetFieldData(Field, Buffer);
-end;
-
 procedure TSQLQuery.SetFieldData(Field: TField; Buffer: Pointer;
   NativeFormat: Boolean);
 begin
   SetFieldData(Field, Buffer);
 end;
 
-procedure TSQLQuery.SetFilterText(const Value: string);
+Function TSQLQuery.AddFilter(SQLstr : string) : string;
 
 begin
-  if Filtered then
+  if FWhereStartPos = 0 then
-    begin
+    SQLstr := SQLstr + ' where (' + Filter + ')'
-    end;
+  else if FWhereStopPos > 0 then
-  Inherited SetFilterText(Value);
+    system.insert(' and ('+Filter+') ',SQLstr,FWhereStopPos+1)
+  else
+    system.insert(' where ('+Filter+') ',SQLstr,FWhereStartPos);
+  Result := SQLstr;
 end;
 
 procedure TSQLQuery.SetFiltered(Value: Boolean);
@@ -552,6 +552,7 @@ procedure TSQLQuery.SetFiltered(Value: Boolean);
 var S : String;
 
 begin
+  if Value and not FParseSQL then DatabaseErrorFmt(SNoParseSQL,['Filtering ']);
   if (Filtered <> Value) and Active then
     begin
     CloseStatement;
@@ -560,25 +561,15 @@ begin
 
     s := FSQLBuf;
 
-    if Value then
+    if Value then s := AddFilter(s);
-      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;
+  inherited setfiltered(Value);
 end;
 
 procedure TSQLQuery.Prepare;
@@ -604,9 +595,12 @@ begin
 
     FSQLBuf := TrimRight(FSQL.Text);
     
-    ParseSQL(FSQLBuf);
+    SQLParser(FSQLBuf);
 
-    Db.PrepareStatement(Fcursor,sqltr,FSQLBuf,FParams);
+    if filtered then
+      Db.PrepareStatement(Fcursor,sqltr,AddFilter(FSQLBuf),FParams)
+    else
+      Db.PrepareStatement(Fcursor,sqltr,FSQLBuf,FParams);
 
     if (FCursor.FStatementType = stSelect) and not ReadOnly then
       InitUpdates(FSQLBuf);
@@ -617,8 +611,11 @@ procedure TSQLQuery.UnPrepare;
 
 begin
   CheckInactive;
-  if IsPrepared then (Database as tsqlconnection).UnPrepareStatement(FCursor);
+  if IsPrepared then with Database as TSQLConnection do
-  FreeAndNil(FCursor);
+    begin
+    UnPrepareStatement(FCursor);
+    DeAllocateCursorHandle(FCursor);
+    end;
 end;
 
 procedure TSQLQuery.FreeFldBuffers;
@@ -682,7 +679,7 @@ begin
   end;
 end;
 
-procedure TSQLQuery.ParseSQL(var SQL : string);
+procedure TSQLQuery.SQLParser(var SQL : string);
 
 type TParsePart = (ppStart,ppSelect,ppWhere,ppFrom,ppOrder,ppComment,ppBogus);
 
@@ -721,6 +718,7 @@ begin
                      FCursor.FStatementType := (Database as tsqlconnection).StrToStatementType(s);
                      if FCursor.FStatementType = stSelect then ParsePart := ppSelect
                        else break;
+                     if not FParseSQL then break;
                      PStatementPart := CurrentP;
                      end;
           ppSelect : begin
@@ -858,6 +856,7 @@ begin
   FSQL.OnChange := @OnChangeSQL;
   FIndexDefs := TIndexDefs.Create(Self);
   FReadOnly := false;
+  FParseSQL := True;
 // Delphi has upWhereAll as default, but since strings and oldvalue's don't work yet
 // (variants) set it to upWhereKeyOnly
   FUpdateMode := upWhereKeyOnly;
@@ -877,12 +876,27 @@ end;
 procedure TSQLQuery.SetReadOnly(AValue : Boolean);
 
 begin
-  if not Active then FReadOnly := AValue
+  CheckInactive;
-  else
+  if not AValue then
     begin
-    // Just temporary, this should be possible in the future
+    if FParseSQL then FReadOnly := False
-    DatabaseError(SActiveDataset);
+      else DatabaseErrorFmt(SNoParseSQL,['Updating ']);
-    end;
+    end
+  else FReadOnly := True;
+end;
+
+procedure TSQLQuery.SetParseSQL(AValue : Boolean);
+
+begin
+  CheckInactive;
+  if not AValue then
+    begin
+    FReadOnly := True;
+    Filtered := False;
+    FParseSQL := False;
+    end
+  else
+    FParseSQL := True;
 end;
 
 procedure TSQLQuery.SetUsePrimaryKeyAsKey(AValue : Boolean);