paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-07 20:31:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Added simulation of parameters for MySQL

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

git-svn-id: trunk@3772 -
This commit is contained in:
joost 2006-06-03 12:13:09 +00:00
parent 06be3aba7d
commit f36010fc31
4 changed files with 107 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
fcl/db/db.pp
View File

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

86
fcl/db/dsparams.inc
View File

@ -153,21 +153,32 @@ 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): String;
Function TParams.ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding; var ReplaceString : string): String;
type
// used for ParamPart
@ -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;

12
fcl/db/sqldb/mysql/mysqlconn.inc
View File

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

19
fcl/db/sqldb/sqldb.pp
View File

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