* some fixes for queries with more then 10 parameters + tests

git-svn-id: trunk@8745 -

packages/fcl-db/src/dbconst.pas

@@ -95,6 +95,7 @@ Resourcestring
   SNoFieldIndexes          = 'No index currently active';
   SNotIndexField           = 'Field ''%s'' is not indexed and cannot be modified';
   SErrUnknownConnectorType = 'Unknown connector type';
+  SErrAmountStrings        = 'Amount of search and replace strings don''t match';
   SErrCircularDataSourceReferenceNotAllowed = 'Circular datasource references are not allowed.';
   
 

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -402,14 +402,24 @@ procedure TConnectionName.Execute(cursor: TSQLCursor;
 Var
   C : TCursorName;
   i : integer;
+  ParamNames,ParamValues : array of string;
 
 begin
   C:=Cursor as TCursorName;
   If (C.FRes=Nil) then
     begin
     if Assigned(AParams) and (AParams.count > 0) then
+      begin
+      setlength(ParamNames,AParams.Count);
+      setlength(ParamValues,AParams.Count);
       for i := 0 to AParams.count -1 do
-        C.FStatement := stringreplace(C.FStatement,C.ParamReplaceString+inttostr(AParams[i].Index+1),GetAsSQLText(AParams[i]),[rfReplaceAll,rfIgnoreCase]);
+        begin
+        ParamNames[AParams.count-i-1] := C.ParamReplaceString+inttostr(AParams[i].Index+1);
+        ParamValues[AParams.count-i-1] := GetAsSQLText(AParams[i]);
+        end;
+      // paramreplacestring kan een probleem geven bij postgres als hij niet meer gewoon $ is?
+      C.FStatement := stringsreplace(C.FStatement,ParamNames,ParamValues,[rfReplaceAll]);
+      end;
     if mysql_query(FMySQL,Pchar(C.FStatement))<>0 then
       MySQLError(FMYSQL,Format(SErrExecuting,[StrPas(mysql_error(FMySQL))]),Self)
     else

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -532,6 +532,7 @@ procedure TPQConnection.Execute(cursor: TSQLCursor;atransaction:tSQLtransaction;
 var ar  : array of pchar;
     i   : integer;
     s   : string;
+    ParamNames,ParamValues : array of string;
 
 begin
   with cursor as TPQCursor do
@@ -565,10 +566,19 @@ begin
       begin
       tr := TPQTrans(aTransaction.Handle);
 
-      s := statement;
-      //Should be altered, just like in TSQLQuery.ApplyRecUpdate
-      if assigned(AParams) then for i := 0 to AParams.count-1 do
-        s := stringreplace(s,':'+AParams[i].Name,AParams[i].asstring,[rfReplaceAll,rfIgnoreCase]);
+      if Assigned(AParams) and (AParams.count > 0) then
+        begin
+        setlength(ParamNames,AParams.Count);
+        setlength(ParamValues,AParams.Count);
+        for i := 0 to AParams.count -1 do
+          begin
+          ParamNames[AParams.count-i-1] := '$'+inttostr(AParams[i].index+1);
+          ParamValues[AParams.count-i-1] := GetAsSQLText(AParams[i]);
+          end;
+        s := stringsreplace(statement,ParamNames,ParamValues,[rfReplaceAll]);
+        end
+      else
+        s := Statement;
       res := pqexec(tr.PGConn,pchar(s));
       end;
     if not (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then

packages/fcl-db/src/sqldb/sqldb.pp

@@ -425,6 +425,7 @@ Procedure UnRegisterConnection(Def : TConnectionDefClass);
 Procedure UnRegisterConnection(ConnectionName : String);
 Function GetConnectionDef(ConnectorName : String) : TConnectionDef;
 Procedure GetConnectionList(List : TSTrings);
+function StringsReplace(const S: string; OldPattern, NewPattern: array of string;  Flags: TReplaceFlags): string;
 
 implementation
 
@@ -1636,6 +1637,67 @@ begin
   List.Text:=ConnDefs.Text;
 end;
 
+function StringsReplace(const S: string; OldPattern, NewPattern: array of string;  Flags: TReplaceFlags): string;
+
+var pc,pcc,lastpc : pchar;
+    strcount      : integer;
+    ResStr,
+    CompStr       : string;
+    Found         : Boolean;
+    sc            : integer;
+
+
+begin
+  sc := length(OldPattern);
+  if sc <> length(NewPattern) then
+    raise exception.Create(SErrAmountStrings);
+
+  dec(sc);
+
+  if rfIgnoreCase in Flags then
+    begin
+    CompStr:=AnsiUpperCase(S);
+    for strcount := 0 to sc do
+      OldPattern[strcount] := AnsiUpperCase(OldPattern[strcount]);
+    end
+  else
+    CompStr := s;
+
+  ResStr := '';
+  pc := @CompStr[1];
+  pcc := @s[1];
+  lastpc := pc+Length(S);
+
+  while pc < lastpc do
+    begin
+    Found := False;
+    for strcount := 0 to sc do
+      begin
+      if (OldPattern[strcount][1]=pc^) and
+         (Length(OldPattern[strcount]) <= (lastpc-pc)) and
+         (CompareByte(OldPattern[strcount][1],pc^,Length(OldPattern[strcount]))=0) then
+        begin
+        ResStr := ResStr + NewPattern[strcount];
+        pc := pc+Length(OldPattern[strcount]);
+        pcc := pcc+Length(OldPattern[strcount]);
+        Found := true;
+        end
+      end;
+    if not found then
+      begin
+      ResStr := ResStr + pcc^;
+      inc(pc);
+      inc(pcc);
+      end
+    else if not (rfReplaceAll in Flags) then
+      begin
+      ResStr := ResStr + StrPas(pcc);
+      break;
+      end;
+    end;
+  Result := ResStr;
+end;
+
 { TSQLConnector }
 
 procedure TSQLConnector.SetConnectorType(const AValue: String);

packages/fcl-db/tests/testsqlfieldtypes.pas

@@ -26,6 +26,9 @@ type
     procedure TearDown; override;
     procedure RunTest; override;
   published
+    procedure TestStringsReplace;
+    procedure TestCircularParams;
+    procedure Test11Params;
     procedure TestBug9744;
     procedure TestCrossStringDateParam;
     procedure TestGetFieldNames;
@@ -867,6 +870,75 @@ begin
     inherited RunTest;
 end;
 
+procedure TTestFieldTypes.TestStringsReplace;
+begin
+  AssertEquals('dit is een string',StringsReplace('dit was een string',['was'],['is'],[]));
+  AssertEquals('dit is een string was een string',StringsReplace('dit was een string was een string',['was'],['is'],[]));
+  AssertEquals('dit is een string is een string',StringsReplace('dit was een string was een string',['was'],['is'],[rfReplaceAll]));
+
+  AssertEquals('dit is een char is een char',StringsReplace('dit was een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
+  AssertEquals('dit is een string was een string',StringsReplace('dit was een string was een string',['string','was'],['char','is'],[]));
+
+  AssertEquals('dit is een char is een strin',StringsReplace('dit was een string was een strin',['string','was'],['char','is'],[rfReplaceAll]));
+
+  AssertEquals('dit Was een char is een char',StringsReplace('dit Was een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
+  AssertEquals('dit wAs een char is een char',StringsReplace('dit wAs een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
+  AssertEquals('dit is een char is een char',StringsReplace('dit Was een sTring was een string',['was','string'],['is','char'],[rfReplaceAll,rfIgnoreCase]));
+  AssertEquals('dit is een char is een char',StringsReplace('dit wAs een STRING was een string',['was','string'],['is','char'],[rfReplaceAll,rfIgnoreCase]));
+
+  AssertEquals('dit was een si was een sa',StringsReplace('dit was een string was een straat',['straat','string'],['sa','si'],[rfReplaceAll]));
+  AssertEquals('dit was een si was een sa',StringsReplace('dit was een string was een straat',['string','straat'],['si','sa'],[rfReplaceAll]));
+
+  AssertEquals('dit was een sing was een saat',StringsReplace('dit was een string was een straat',['str','string'],['s','si'],[rfReplaceAll]));
+  AssertEquals('dit was een si was een saat',StringsReplace('dit was een string was een straat',['string','str'],['si','s'],[rfReplaceAll]));
+
+  AssertEquals('dit was een string was een string',StringsReplace('dit was een string was een string',[''],['is'],[rfReplaceAll]));
+  AssertEquals('dit  een string  een string',StringsReplace('dit was een string was een string',['was'],[''],[rfReplaceAll]));
+end;
+
+procedure TTestFieldTypes.TestCircularParams;
+begin
+  with TSQLDBConnector(dbconnector) do
+    begin
+    Connection.ExecuteDirect('create table FPDEV2 (id1 int, id2 int,vchar varchar(10))');
+    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+    TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+
+    Query.sql.Text := 'insert into FPDEV2 values(:id1,:id2,:vchar)';
+    query.params[0].asinteger := 1;
+    query.params[1].asinteger := 1;
+    query.params[2].asstring := '$1 :id2 $';
+    query.ExecSQL;
+    query.sql.text := 'select * from FPDEV2';
+    query.open;
+    AssertEquals(1,query.fields[0].asinteger);
+    AssertEquals(1,query.fields[1].asinteger);
+    AssertEquals('$1 :id2 $',query.fields[2].AsString);
+    query.close;
+    end;
+end;
+
+procedure TTestFieldTypes.Test11Params;
+var i : integer;
+begin
+  with TSQLDBConnector(dbconnector) do
+    begin
+    Connection.ExecuteDirect('create table FPDEV2 (id1 int, id2 int, id3 int, id4 int,id5 int,id6 int,id7 int,id8 int, id9 int, id10 int, id11 int)');
+    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+    TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+
+    Query.sql.Text := 'insert into FPDEV2 values(:id1,:id2,:id3,:id4,:id5,:id6,:id7,:id8,:id9,:id10,:id11)';
+    for i := 0 to 10 do
+      query.params[i].asinteger := 1;
+    query.ExecSQL;
+    query.sql.text := 'select * from FPDEV2';
+    query.open;
+    for i := 0 to 10 do
+      AssertEquals(1,query.fields[i].asinteger);
+    query.close;
+    end;
+end;
+
 procedure TTestFieldTypes.TestBug9744;
 var i : integer;
 begin