+ Added simulation of parameters for MySQL

 + Fixed problems with EDatabaseError 
 + Fixed a problem with parameters that are used more then once

git-svn-id: trunk@3772 -

fcl/db/db.pp

@@ -1576,7 +1576,7 @@ type
   TParamType = (ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult);
   TParamTypes = set of TParamType;
 
-  TParamStyle = (psInterbase,psPostgreSQL);
+  TParamStyle = (psInterbase,psPostgreSQL,psSimulated);
 
   TParams = class;
 
@@ -1694,6 +1694,7 @@ type
     Function  ParseSQL(SQL: String; DoCreate: Boolean): String;
     Function  ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle): String; overload;
     Function  ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding): String; overload;
+    Function  ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding; var ReplaceString : string): String;
     Procedure RemoveParam(Value: TParam);
     Procedure CopyParamValuesFromDataset(ADataset : TDataset; CopyBound : Boolean);
     Property Dataset : TDataset Read GetDataset;
@@ -1868,7 +1869,10 @@ end;
 Procedure DatabaseError (Const Msg : String; Comp : TComponent);
 
 begin
-  Raise EDatabaseError.CreateFmt('%s : %s',[Comp.Name,Msg]);
+  if assigned(Comp) then
+    Raise EDatabaseError.CreateFmt('%s : %s',[Comp.Name,Msg])
+  else
+    DatabaseError(Msg);
 end;
 
 Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
@@ -1880,7 +1884,10 @@ end;
 Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
                             Comp : TComponent);
 begin
-  Raise EDatabaseError.CreateFmt(Format('%s : %s',[Comp.Name,Fmt]),Args);
+  if assigned(comp) then
+    Raise EDatabaseError.CreateFmt(Format('%s : %s',[Comp.Name,Fmt]),Args)
+  else
+    DatabaseErrorFmt(Fmt, Args);
 end;
 
 Function ExtractFieldName(Const Fields: String; var Pos: Integer): String;

fcl/db/dsparams.inc

@@ -153,22 +153,33 @@ end;
 Function TParams.ParseSQL(SQL: String; DoCreate: Boolean): String;
 
 var pb : TParamBinding;
+    rs : string;
 
 begin
-  Result := ParseSQL(SQL,DoCreate,psInterbase, pb);
+  Result := ParseSQL(SQL,DoCreate,psInterbase, pb, rs);
 end;
 
 Function TParams.ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle): String;
 
 var pb : TParamBinding;
+    rs : string;
 
 begin
-  Result := ParseSQL(SQL,DoCreate,ParameterStyle,pb);
+  Result := ParseSQL(SQL,DoCreate,ParameterStyle,pb, rs);
 end;
 
-
 Function TParams.ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding): String;
 
+var pb : TParamBinding;
+    rs : string;
+
+begin
+  Result := ParseSQL(SQL,DoCreate,ParameterStyle,pb, rs);
+end;
+
+
+Function TParams.ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding; var ReplaceString : string): String;
+
 type
   // used for ParamPart
   TStringPart = record
@@ -189,12 +200,16 @@ var
   ParamPart:array of TStringPart; // describe which parts of buf are parameters
   NewQueryLength:integer;
   NewQuery:string;
-  NewQueryIndex,BufIndex,CopyLen,i:integer;                     // Parambinding will have length ParamCount in the end
+  NewQueryIndex,BufIndex,CopyLen,i:integer;    // Parambinding will have length ParamCount in the end
+  SimStrCount,b:integer;                         // in psSimulated mode this is the counter with the amount of repeating '$' signs
+  tmpParam:TParam;
 
 begin
   if DoCreate then Clear;
   // Parse the SQL and build ParamBinding
   ParamCount:=0;
+  SimStrCount := 1;
+  ReplaceString := '';
   NewQueryLength:=Length(SQL);
   SetLength(ParamPart,ParamAllocStepSize);
   SetLength(Parambinding,ParamAllocStepSize);
@@ -286,9 +301,16 @@ begin
               SetLength(ParamBinding,NewLength);
             end;
 
-            // create Parameter and assign ParameterIndex
             if DoCreate then
-              ParameterIndex := CreateParam(ftUnknown, ParamName, ptInput).Index
+              begin
+              // Check if this is the first occurance of the parameter
+              tmpParam := FindParam(ParamName);
+              // If so, create the parameter and assign the Parameterindex
+              if not assigned(tmpParam) then
+                ParameterIndex := CreateParam(ftUnknown, ParamName, ptInput).Index
+              else  // else only assign the ParameterIndex
+                ParameterIndex := tmpParam.Index;
+              end
             // else find ParameterIndex
             else
               begin
@@ -300,6 +322,13 @@ begin
                   Inc(QuestionMarkParamCount);
                 end;
               end;
+            if ParameterStyle in [psPostgreSQL,psSimulated] then
+              begin
+              if ParameterIndex > 8 then
+                inc(NewQueryLength,2)
+              else
+                inc(NewQueryLength,1)
+              end;
 
             // store ParameterIndex in FParamIndex, ParamPart data
             ParamBinding[ParamCount-1]:=ParameterIndex;
@@ -310,6 +339,20 @@ begin
             Dec(NewQueryLength,p-ParamNameStart);
           end;
         end;
+      '$':
+        if ParameterStyle = psSimulated then
+          begin
+          b := 1;
+          while p^='$' do
+            begin
+            inc(p);
+            inc(b);
+            end;
+          if b > SimStrCount then SimStrCount := b;
+          end
+        else
+          Inc(p);
+        
       #0:Break;
     else
       Inc(p);
@@ -321,12 +364,18 @@ begin
 
   if ParamCount>0 then
   begin
-    // replace :ParamName by ? (using ParamPart array and NewQueryLength)
-    if ParameterStyle = psPostgreSQL then
-      if paramcount < 10 then
-        inc(NewQueryLength,paramcount)
+    // replace :ParamName by ? for interbase and by $x for postgresql/psSimulated
+    // (using ParamPart array and NewQueryLength)
+    if (ParameterStyle = psSimulated) then
+      begin
+      if (SimStrCount > 1) then
+        begin
+        inc(NewQueryLength,(paramcount)*(SimStrCount-1));
+        for b := 1 to SimStrCount do ReplaceString := ReplaceString+'$';
+        end
       else
-        inc(NewQueryLength,(paramcount-9)*2+9);
+        ReplaceString := '$';
+      end;
 
     SetLength(NewQuery,NewQueryLength);
     NewQueryIndex:=1;
@@ -338,12 +387,16 @@ begin
       Inc(NewQueryIndex,CopyLen);
       case ParameterStyle of
         psInterbase : NewQuery[NewQueryIndex]:='?';
-        psPostgreSQL: begin
-                        ParamName := IntToStr(i+1);
-                        NewQuery[NewQueryIndex]:='$';
-                        Inc(NewQueryIndex);
+        psPostgreSQL,
+        psSimulated : begin
+                        ParamName := IntToStr(ParamBinding[i]+1);
+                        for b := 1 to SimStrCount do
+                          begin
+                          NewQuery[NewQueryIndex]:='$';
+                          Inc(NewQueryIndex);
+                          end;
                         NewQuery[NewQueryIndex]:= paramname[1];
-                        if i>10 then
+                        if length(paramname)>1 then
                           begin
                           Inc(NewQueryIndex);
                           NewQuery[NewQueryIndex]:= paramname[2]
@@ -358,6 +411,7 @@ begin
   end
   else
     NewQuery:=SQL;
+    
   Result := NewQuery;
 end;
 

fcl/db/sqldb/mysql/mysqlconn.inc

@@ -46,6 +46,8 @@ Type
     Row : MYSQL_ROW;
     RowsAffected : QWord;
     LastInsertID : QWord;
+    ParamBinding : TParamBinding;
+    ParamReplaceString : String;
   end;
 
   TConnectionName = class (TSQLConnection)
@@ -258,11 +260,13 @@ end;
 procedure TConnectionName.PrepareStatement(cursor: TSQLCursor;
   ATransaction: TSQLTransaction; buf: string;AParams : TParams);
 begin
-  if assigned(AParams) and (AParams.count > 0) then
-    DatabaseError('Parameters (not) yet supported for the MySQL SqlDB connection.',self);
+//  if assigned(AParams) and (AParams.count > 0) then
+//    DatabaseError('Parameters (not) yet supported for the MySQL SqlDB connection.',self);
   With Cursor as TCursorName do
     begin
     FStatement:=Buf;
+    if assigned(AParams) and (AParams.count > 0) then
+      FStatement := AParams.ParseSQL(FStatement,false,psSimulated,paramBinding,ParamReplaceString);
     if FStatementType=stSelect then
       FNeedData:=True;
     ConnectMySQL(FQMySQL,FMySQL^.host,FMySQL^.user,FMySQL^.passwd);
@@ -306,11 +310,15 @@ procedure TConnectionName.Execute(cursor: TSQLCursor;
 
 Var
   C : TCursorName;
+  i : integer;
 
 begin
   C:=Cursor as TCursorName;
   If (C.FRes=Nil) then
     begin
+    if Assigned(AParams) and (AParams.count > 0) then
+      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]);
     if mysql_query(c.FQMySQL,Pchar(C.FStatement))<>0 then
       MySQLError(c.FQMYSQL,Format(SErrExecuting,[StrPas(mysql_error(c.FQMySQL))]),Self)
     else

fcl/db/sqldb/sqldb.pp

@@ -76,7 +76,8 @@ type
     function StrToStatementType(s : string) : TStatementType; virtual;
     procedure DoInternalConnect; override;
     procedure DoInternalDisconnect; override;
-    function GetAsSQLText(Field : TField) : string; virtual;
+    function GetAsSQLText(Field : TField) : string; overload; virtual;
+    function GetAsSQLText(Param : TParam) : string; overload; virtual;
     function GetHandle : pointer; virtual; virtual;
 
     Function AllocateCursorHandle : TSQLCursor; virtual; abstract;
@@ -425,7 +426,7 @@ end;
 function TSQLConnection.GetAsSQLText(Field : TField) : string;
 
 begin
-  if not assigned(field) then Result := 'Null'
+  if (not assigned(field)) or field.IsNull then Result := 'Null'
   else case field.DataType of
     ftString   : Result := '''' + field.asstring + '''';
     ftDate     : Result := '''' + FormatDateTime('yyyy-mm-dd',Field.AsDateTime) + '''';
@@ -435,6 +436,20 @@ begin
   end; {case}
 end;
 
+function TSQLConnection.GetAsSQLText(Param: TParam) : string;
+
+begin
+  if (not assigned(param)) or param.IsNull then Result := 'Null'
+  else case param.DataType of
+    ftString   : Result := '''' + param.asstring + '''';
+    ftDate     : Result := '''' + FormatDateTime('yyyy-mm-dd',Param.AsDateTime) + '''';
+    ftDateTime : Result := '''' + FormatDateTime('yyyy-mm-dd hh:mm:ss',Param.AsDateTime) + ''''
+  else
+    Result := Param.asstring;
+  end; {case}
+end;
+
+
 function TSQLConnection.GetHandle: pointer;
 begin
   Result := nil;