Merged revisions 3772-3773,3779,3793,3804,3826,3829 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r3772 | joost | 2006-06-03 14:13:09 +0200 (Sat, 03 Jun 2006) | 3 lines

  + Added simulation of parameters for MySQL
 + Fixed problems with EDatabaseError 
 + Fixed a problem with parameters that are used more then once
........
r3773 | joost | 2006-06-03 14:21:08 +0200 (Sat, 03 Jun 2006) | 1 line

 + tablename must be in capitals
........
r3779 | joost | 2006-06-03 23:43:13 +0200 (Sat, 03 Jun 2006) | 1 line

 + Implemented Null-values for MySQL-fields
........
r3793 | joost | 2006-06-04 19:09:42 +0200 (Sun, 04 Jun 2006) | 1 line

 + some fixes for ParseSQL
........
r3804 | joost | 2006-06-05 01:12:34 +0200 (Mon, 05 Jun 2006) | 2 lines

 + Updates should be cancelled in reverse order
 + Fix for bug #6938
........
r3826 | joost | 2006-06-08 22:57:40 +0200 (Thu, 08 Jun 2006) | 2 lines

 + fix for TBCD.GetDataSize
 + Improved error-message on unknown-parameters
........
r3829 | joost | 2006-06-09 20:54:12 +0200 (Fri, 09 Jun 2006) | 1 line

 + Fixed a crash when connecting to a database fails when using execsql on a query
........

git-svn-id: branches/fixes_2_0@3831 -

fcl/db/bufdataset.inc

@@ -432,14 +432,14 @@ begin
 
   if Length(FUpdateBuffer) > 0 then
     begin
-    r := 0;
-    while r < Length(FUpdateBuffer) do with FUpdateBuffer[r] do
+    r := Length(FUpdateBuffer) -1;
+    while r > -1 do with FUpdateBuffer[r] do
       begin
       if assigned(FUpdateBuffer[r].BookmarkData) then
         begin
         if UpdateKind = ukModify then
           begin
-          move(FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer^,BookmarkData^,RecordSize+sizeof(TBufRecLinkItem));
+          move(pchar(OldValuesBuffer+sizeof(TBufRecLinkItem))^,pchar(BookmarkData+sizeof(TBufRecLinkItem))^,RecordSize);
           FreeRecordBuffer(OldValuesBuffer);
           end
         else if UpdateKind = ukDelete then
@@ -464,7 +464,7 @@ begin
           dec(FBRecordCount);
           end;
         end;
-      inc(r);
+      dec(r)
       end;
 
     SetLength(FUpdateBuffer,0);

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,31 @@ 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 rs : string;
+
+begin
+  Result := ParseSQL(SQL,DoCreate,ParameterStyle,ParamBinding, 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,7 +198,9 @@ 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
+  b:integer;
+  tmpParam:TParam;
 
 begin
   if DoCreate then Clear;
@@ -200,6 +211,10 @@ begin
   SetLength(Parambinding,ParamAllocStepSize);
   QuestionMarkParamCount:=0; // number of ? params found in query so far
 
+  ReplaceString := '$';
+  if ParameterStyle = psSimulated then
+    while pos(ReplaceString,SQL) > 0 do ReplaceString := ReplaceString+'$';
+
   p:=PChar(SQL);
   BufStart:=p; // used to calculate ParamPart.Start values
   repeat
@@ -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;
@@ -321,12 +350,10 @@ 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)
-      else
-        inc(NewQueryLength,(paramcount-9)*2+9);
+    // replace :ParamName by ? for interbase and by $x for postgresql/psSimulated
+    // (using ParamPart array and NewQueryLength)
+    if (ParameterStyle = psSimulated) and (length(ReplaceString) > 1) then
+      inc(NewQueryLength,(paramcount)*(length(ReplaceString)-1));
 
     SetLength(NewQuery,NewQueryLength);
     NewQueryIndex:=1;
@@ -338,12 +365,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 length(ReplaceString) 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 +389,7 @@ begin
   end
   else
     NewQuery:=SQL;
+    
   Result := NewQuery;
 end;
 

fcl/db/fields.inc

@@ -2077,7 +2077,7 @@ end;
 function TBCDField.GetDataSize: Word;
 
 begin
-  result := sizeof(currency);
+  result := sizeof(system.currency);
 end;
 
 function TBCDField.GetDefaultWidth: Longint;

fcl/db/sqldb/examples/gfiltertable.pp

@@ -31,7 +31,7 @@ begin
     ReadOnly := True;
 
     SQL.Clear;
-    SQL.Add('select * from fpdev');
+    SQL.Add('select * from FPDEV');
 
     Writeln('Id;Name;Email;birthdate');
 

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)
@@ -63,7 +65,7 @@ Type
     Procedure ConnectToServer; virtual;
     Procedure SelectDatabase; virtual;
     function MySQLDataType(AType: enum_field_types; ASize: Integer; var NewType: TFieldType; var NewSize: Integer): Boolean;
-    function MySQLWriteData(AType: enum_field_types; ASize: Integer; Source, Dest: PChar): Integer;
+    function MySQLWriteData(AType: enum_field_types; ASize: Integer; Source, Dest: PChar): Boolean;
     // SQLConnection methods
     procedure DoInternalConnect; override;
     procedure DoInternalDisconnect; override;
@@ -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
@@ -413,7 +421,7 @@ function TConnectionName.LoadField(cursor : TSQLCursor;
   FieldDef : TfieldDef;buffer : pointer) : boolean;
 
 var
-  I, FC, CT: Integer;
+  I, FC: Integer;
   field: PMYSQL_FIELD;
   row : MYSQL_ROW;
   C : TCursorName;
@@ -435,9 +443,8 @@ begin
     if field^.name=FieldDef.name then break;
     Inc(Row);
     end;
-
-  CT := MySQLWriteData(field^.ftype, field^.length, Row^, Buffer);
-  result := true;
+    
+  Result := MySQLWriteData(field^.ftype, field^.length, Row^, Buffer);
 end;
 
 function InternalStrToFloat(S: string): Extended;
@@ -534,7 +541,7 @@ begin
   Result := Result + EncodeTime(EH, EN, ES, 0);;
 end;
 
-function TConnectionName.MySQLWriteData(AType: enum_field_types;ASize: Integer; Source, Dest: PChar): Integer;
+function TConnectionName.MySQLWriteData(AType: enum_field_types;ASize: Integer; Source, Dest: PChar): Boolean;
 
 var
   VI: Integer;
@@ -543,73 +550,65 @@ var
   Src : String;
 
 begin
-  Result := 0;
-  If (Source<>Nil) Then
-    Src:=StrPas(Source)
-  else
-    Src:='';
+  Result := False;
+  if Source = Nil then
+    exit;
+  Src:=StrPas(Source);
   case AType of
     FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG,
     FIELD_TYPE_INT24:
       begin
-      Result:=SizeOf(Integer);
       if (Src<>'') then
         VI := StrToInt(Src)
       else
         VI := 0;
-      Move(VI, Dest^, Result);
+      Move(VI, Dest^, SizeOf(Integer));
       end;
 {$ifdef mysql50}
     FIELD_TYPE_NEWDECIMAL,
 {$endif}      
     FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
       begin
-      Result := SizeOf(Double);
       if Src <> '' then
         VF := InternalStrToFloat(Src)
       else
         VF := 0;
-      Move(VF, Dest^, Result);
+      Move(VF, Dest^, SizeOf(Double));
       end;
     FIELD_TYPE_TIMESTAMP:
       begin
-      Result := SizeOf(TDateTime);
       if Src <> '' then
         VD := InternalStrToTimeStamp(Src)
       else
         VD := 0;
-      Move(VD, Dest^, Result);
+      Move(VD, Dest^, SizeOf(TDateTime));
       end;
     FIELD_TYPE_DATETIME:
       begin
-      Result := SizeOf(TDateTime);
       if Src <> '' then
         VD := InternalStrToDateTime(Src)
       else
         VD := 0;
-      Move(VD, Dest^, Result);
+      Move(VD, Dest^, SizeOf(TDateTime));
       end;
     FIELD_TYPE_DATE:
       begin
-      Result := SizeOf(TDateTime);
       if Src <> '' then
         VD := InternalStrToDate(Src)
       else
         VD := 0;
-      Move(VD, Dest^, Result);
+      Move(VD, Dest^, SizeOf(TDateTime));
       end;
     FIELD_TYPE_TIME:
       begin
-      Result := SizeOf(TDateTime);
       if Src <> '' then
         VD := InternalStrToTime(Src)
       else
         VD := 0;
-      Move(VD, Dest^, Result);
+      Move(VD, Dest^, SizeOf(TDateTime));
       end;
     FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
       begin
-      Result := ASize;
 {      Write('Moving string of size ',asize,' : ');
       P:=Source;
       If (P<>nil) then
@@ -620,11 +619,12 @@ begin
           end;
       Writeln;
 }      if Src<> '' then
-        Move(Source^, Dest^, Result)
+        Move(Source^, Dest^, ASize)
       else
         Dest^ := #0;
       end;
   end;
+  Result := True;
 end;
 
 procedure TConnectionName.UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string);

fcl/db/sqldb/postgres/pqconnection.pp

@@ -403,7 +403,11 @@ begin
         s := s + '(';
         for i := 0 to AParams.count-1 do if TypeStrings[AParams[i].DataType] <> 'Unknown' then
           s := s + TypeStrings[AParams[i].DataType] + ','
-        else DatabaseErrorFmt(SUnsupportedParameter,[Fieldtypenames[AParams[i].DataType]],self);
+        else
+          begin
+          if AParams[i].DataType = ftUnknown then DatabaseErrorFmt(SUnknownParamFieldType,[AParams[i].Name],self)
+            else DatabaseErrorFmt(SUnsupportedParameter,[Fieldtypenames[AParams[i].DataType]],self);
+          end;
         s[length(s)] := ')';
         buf := AParams.ParseSQL(buf,false,psPostgreSQL);
         end;

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;
@@ -958,7 +973,9 @@ begin
     Prepare;
     Execute;
   finally
-    if (not IsPrepared) and (assigned(database)) then (database as TSQLConnection).UnPrepareStatement(Fcursor);
+    // FCursor has to be assigned, or else the prepare went wrong before PrepareStatment was
+    // called, so UnPrepareStatement shoudn't be called either
+    if (not IsPrepared) and (assigned(database)) and (assigned(FCursor)) then (database as TSQLConnection).UnPrepareStatement(Fcursor);
   end;
 end;